1 // SPDX-License-Identifier: GPL-3.0-only
2 unit LCToolbars;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 uses
9   Classes, SysUtils, Controls, ComCtrls, Types, LResources, StdCtrls, BCTrackbarUpdown;
10 
CreateToolBarnull11 function CreateToolBar(AImages: TImageList; AOwner: TComponent = nil): TToolbar;
12 procedure ReorderToolbarContent(AToolbar: TToolbar);
GetToolbarSizenull13 function GetToolbarSize(AToolbar: TToolbar; APadding: integer = 1): TSize;
14 procedure SetToolbarImages(AToolbar: TToolbar; AImages: TImageList; HorizPadding: integer = 5; VertPadding: integer = 4);
15 procedure EnableDisableToolButtons(AButtons: array of TToolButton; AEnabled: boolean);
16 procedure ShowAppendToolButtons(AButtons: array of TControl);
AddToolbarLabelnull17 function AddToolbarLabel(AToolbar: TToolbar; ACaption: string; AExistingContainer: TCustomControl): TLabel;
AddToolbarCheckButtonnull18 function AddToolbarCheckButton(AToolbar: TToolbar; ACaption: string; AImageIndex: integer;
19           AOnClick: TNotifyEvent; ADown: boolean; AGrouped: boolean = true; ATag: PtrInt = 0): TToolButton;
AddToolbarButtonnull20 function AddToolbarButton(AToolbar: TToolbar; ACaption: string; AImageIndex: integer;
21           AOnClick: TNotifyEvent; ATag: PtrInt = 0): TToolButton;
AddToolbarUpDownnull22 function AddToolbarUpDown(AToolbar: TToolbar; ACaption: string; AMin,AMax,AValue: Integer; AOnChange: TTrackBarUpDownChangeEvent): TBCTrackbarUpdown;
AddToolbarTextBoxnull23 function AddToolbarTextBox(AToolbar: TToolbar; ACaption: string; AText: string; AOnChange: TNotifyEvent): TEdit;
24 procedure AddToolbarControl(AToolbar: TToolbar; AControl: TControl);
GetResourceStringnull25 function GetResourceString(AFilename: string): string;
26 procedure LoadToolbarImage(AImages: TImageList; AIndex: integer; AFilename: string);
27 
28 implementation
29 
30 uses BGRALazPaint, Graphics, BGRABitmap, BGRABitmapTypes, math, Toolwin;
31 
CreateToolBarnull32 function CreateToolBar(AImages: TImageList; AOwner: TComponent): TToolbar;
33 begin
34   result := TToolBar.Create(AOwner);
35   result.Align := alNone;
36   result.Height := AImages.Height+4;
37   result.ShowHint:= true;
38   result.ShowCaptions:= false;
39   result.Images := AImages;
40   result.ButtonWidth := AImages.Width+5;
41   result.ButtonHeight := AImages.Height+4;
42   result.ParentColor := false;
43   result.EdgeBorders:= [];
44   result.EdgeInner:= esNone;
45   result.EdgeOuter:= esNone;
46 end;
47 
48 procedure ReorderToolbarContent(AToolbar: TToolbar);
49 var
50   i,x,y: Integer;
51 begin
52   AToolbar.BeginUpdate;
53   x := AToolbar.Indent;
54   y := 0;
55   for i := 0 to AToolbar.ControlCount-1 do
56   begin
57     with AToolbar.Controls[i] do
58     begin
59       if (x+Width > AToolbar.Width) and AToolbar.Wrapable then
60       begin
61         x := AToolbar.Indent;
62         y += AToolbar.ButtonHeight;
63       end;
64       Left := x;
65       Top := y;
66       x += Width;
67     end;
68     if (AToolbar.Controls[i] is TToolButton) and
69       TToolButton(AToolbar.Controls[i]).Wrap then
70     begin
71       x := AToolbar.Indent;
72       y += AToolbar.ButtonHeight;
73     end;
74   end;
75   AToolbar.EndUpdate;
76 end;
77 
GetToolbarSizenull78 function GetToolbarSize(AToolbar: TToolbar; APadding: integer = 1): TSize;
79 var
80   i: Integer;
81   r: TRect;
82 begin
83   result := Size(APadding,APadding);
84   for i := 0 to AToolbar.ControlCount-1 do
85   if AToolbar.Controls[i].Visible then
86   begin
87     r := AToolbar.Controls[i].BoundsRect;
88     if r.Right > result.cx then result.cx := r.Right;
89     if r.Bottom > result.cy then result.cy := r.Bottom;
90   end;
91   result.cx += APadding;
92   result.cy += APadding;
93 end;
94 
95 procedure SetToolbarImages(AToolbar: TToolbar; AImages: TImageList; HorizPadding: integer; VertPadding: integer);
96 begin
97   AToolbar.Images := AImages;
98   AToolbar.ButtonWidth:= AImages.Width+HorizPadding;
99   AToolbar.ButtonHeight:= AImages.Height+VertPadding;
100 end;
101 
GetResourceStringnull102 function GetResourceString(AFilename: string): string;
103 var
104   strStream: TStringStream;
105   resStream: TStream;
106 begin
107   resStream := BGRAResource.GetResourceStream(AFilename);
108   strStream := TStringStream.Create('');
109   strStream.CopyFrom(resStream, resStream.Size);
110   resStream.Free;
111   result:= strStream.DataString;
112   strStream.Free;
113 end;
114 
115 procedure LoadToolbarImage(AImages: TImageList; AIndex: integer; AFilename: string);
116 var
117   iconImg: TBGRALazPaintImage;
118   iconFlat: array of TBGRABitmap;
119   bmpArray: array of TCustomBitmap;
120   i: Integer;
121 begin
122   iconImg := TBGRALazPaintImage.Create;
123   iconImg.LoadFromResource(AFilename);
124   if AImages.ResolutionCount = 0 then
125     AImages.RegisterResolutions([AImages.Width]);
126   setlength(iconFlat, AImages.ResolutionCount);
127   setlength(bmpArray, length(iconFlat));
128   for i := 0 to high(iconFlat) do
129   begin
130     iconImg.Resample(AImages.ResolutionByIndex[i].Width,
131                       AImages.ResolutionByIndex[i].Height,
132                       rmFineResample,rfBestQuality);
133     iconFlat[i] := TBGRABitmap.Create(iconImg.Width, iconImg.Height);
134     iconImg.Draw(iconFlat[i],0,0);
135     bmpArray[i] := iconFlat[i].Bitmap;
136   end;
137   iconImg.Free;
138   if AImages.Count < AIndex then
139   begin
140     for i := 0 to high(iconFlat) do
141       AImages.Replace(AIndex, bmpArray[i],nil, false);
142   end
143   else
144     AImages.AddMultipleResolutions(bmpArray);
145   for i := 0 to high(iconFlat) do
146     iconFlat[i].Free;
147 end;
148 
AddToolbarLabelnull149 function AddToolbarLabel(AToolbar: TToolbar; ACaption: string;
150   AExistingContainer: TCustomControl): TLabel;
151 var
152   lbl: TLabel;
153 begin
154   lbl := TLabel.Create(AToolbar);
155   lbl.AutoSize:= false;
156   lbl.Alignment:= taCenter;
157   lbl.Layout := tlCenter;
158   lbl.Caption := ACaption;
159   lbl.Width := AExistingContainer.Canvas.TextWidth(lbl.Caption)+(AToolbar.ButtonHeight div 4);
160   lbl.Height := AToolbar.ButtonHeight;
161   AddToolbarControl(AToolbar, lbl);
162   result := lbl;
163 end;
164 
AddToolbarCheckButtonnull165 function AddToolbarCheckButton(AToolbar: TToolbar; ACaption: string; AImageIndex: integer;
166           AOnClick: TNotifyEvent; ADown: boolean; AGrouped: boolean = true; ATag: PtrInt = 0): TToolButton;
167 var
168   btn: TToolButton;
169 begin
170   btn := TToolButton.Create(AToolbar);
171   btn.Style := tbsCheck;
172   btn.Caption := ACaption;
173   btn.Hint := ACaption;
174   btn.ImageIndex := AImageIndex;
175   btn.Down:= ADown;
176   btn.Grouped := AGrouped;
177   btn.OnClick:= AOnClick;
178   btn.Tag:= ATag;
179   AddToolbarControl(AToolbar, btn);
180   result := btn;
181 end;
182 
AddToolbarButtonnull183 function AddToolbarButton(AToolbar: TToolbar; ACaption: string;
184   AImageIndex: integer; AOnClick: TNotifyEvent; ATag: PtrInt): TToolButton;
185 var
186   btn: TToolButton;
187 begin
188   btn := TToolButton.Create(AToolbar);
189   btn.Style := tbsButton;
190   btn.Caption := ACaption;
191   btn.Hint := ACaption;
192   btn.ImageIndex := AImageIndex;
193   btn.OnClick:= AOnClick;
194   btn.Tag:= ATag;
195   AddToolbarControl(AToolbar, btn);
196   result := btn;
197 end;
198 
AddToolbarUpDownnull199 function AddToolbarUpDown(AToolbar: TToolbar; ACaption: string; AMin,
200   AMax, AValue: Integer; AOnChange: TTrackBarUpDownChangeEvent): TBCTrackbarUpdown;
201 begin
202   result := TBCTrackbarUpdown.Create(AToolbar);
203   result.Width := AToolbar.ButtonWidth*2;
204   result.Height:= AToolbar.ButtonHeight;
205   result.MinValue := AMin;
206   result.MaxValue := AMax;
207   result.Value := AValue;
208   result.Hint := ACaption;
209   result.ShowHint:= true;
210   result.OnChange:= AOnChange;
211   AddToolbarControl(AToolbar, result);
212 end;
213 
AddToolbarTextBoxnull214 function AddToolbarTextBox(AToolbar: TToolbar; ACaption: string; AText: string;
215   AOnChange: TNotifyEvent): TEdit;
216 begin
217   result := TEdit.Create(AToolbar);
218   result.Width := AToolbar.ButtonWidth*5;
219   result.Font.Height := round(AToolbar.Height*0.5);
220   result.Hint := ACaption;
221   result.ShowHint:= true;
222   result.Text := AText;
223   result.OnChange:= AOnChange;
224   AddToolbarControl(AToolbar, result);
225 end;
226 
227 procedure AddToolbarControl(AToolbar: TToolbar; AControl: TControl);
228 var
229   x,y, i: Integer;
230 begin
231   x := AToolbar.Indent;
232   y := 0;
233   for i := 0 to AToolbar.ControlCount-1 do
234   begin
235     if AToolbar.Controls[i] is TToolButton then
236     begin
237       inc(x, AToolbar.ButtonWidth);
238       if TToolButton(AToolbar.Controls[i]).Wrap then
239       begin
240         x := 0;
241         inc(y, AToolbar.ButtonHeight);
242       end;
243     end
244     else inc(x, AToolbar.Controls[i].Width);
245   end;
246   AControl.Left := x;
247   AControl.Top := y;
248   AControl.Parent := AToolbar;
249 end;
250 
251 procedure EnableDisableToolButtons(AButtons: array of TToolButton; AEnabled: boolean);
252 var
253   i: Integer;
254 begin
255   for i := 0 to high(AButtons) do
256     AButtons[i].Enabled:= AEnabled;
257 end;
258 
259 procedure ShowAppendToolButtons(AButtons: array of TControl);
260 var btnCount,x,y, i: integer;
261   toolbar: TToolBar;
262 begin
263   if length(AButtons) = 0 then exit;
264   toolbar := AButtons[0].Parent as TToolBar;
265   x := 0;
266   y := 0;
267   btnCount := 0;
268   for i := 0 to toolbar.ControlCount-1 do
269     if toolbar.Controls[i].Visible then
270     begin
271       x := max(toolbar.Controls[i].Left+toolbar.Controls[i].Width,x);
272       y := max(toolbar.Controls[i].Top+toolbar.Controls[i].Height,y);
273       inc(btnCount);
274     end;
275 
276   toolbar.BeginUpdate;
277   x:= max(btnCount * toolbar.ButtonWidth,x);
278   for i := 0 to high(AButtons) do
279   begin
280     AButtons[i].Left := x;
281     AButtons[i].Visible:= true;
282     x += toolbar.ButtonWidth;
283   end;
284   toolbar.EndUpdate;
285 end;
286 
287 end.
288 
289