lctoolbars.pas 8.0 KB

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