lcvectorialfillinterface.pas 47 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390
  1. // SPDX-License-Identifier: GPL-3.0-only
  2. unit LCVectorialFillInterface;
  3. {$mode objfpc}{$H+}
  4. interface
  5. uses
  6. Classes, SysUtils, Types,
  7. Controls, ComCtrls, Menus, Dialogs, ExtDlgs, ExtCtrls,
  8. BGRAImageList, BCTrackbarUpdown,
  9. BGRABitmap, BGRABitmapTypes, LCVectorialFill, LCVectorOriginal,
  10. BGRAGradientScanner, Graphics, BGRAGraphics;
  11. function GradRepetitionToStr(AValue: TBGRAGradientRepetition): string;
  12. function ColorInterpToStr(AValue: TBGRAColorInterpolation): string;
  13. function TextureRepetitionToStr(AValue: TTextureRepetition): string;
  14. type
  15. TLCFillTarget = (ftPen, ftBack, ftOutline);
  16. TChooseColorEvent = procedure(ASender: TObject; AButton: TMouseButton; AColorIndex: integer;
  17. var AColorValue: TBGRAPixel; out AHandled: boolean) of object;
  18. { TVectorialFillInterface }
  19. TVectorialFillInterface = class(TComponent)
  20. private
  21. FCanEditGradTexPoints: boolean;
  22. FIsTarget: boolean;
  23. FOnMouseDown: TMouseEvent;
  24. FOnMouseEnter: TNotifyEvent;
  25. FOnMouseLeave: TNotifyEvent;
  26. FOnMouseMove: TMouseMoveEvent;
  27. FOnMouseUp: TMouseEvent;
  28. procedure EditGradTextPointsClick(Sender: TObject);
  29. function GetEditingGradTexPoints: boolean;
  30. procedure Preview_MouseUp(Sender: TObject; Button: TMouseButton;
  31. {%H-}Shift: TShiftState; X, {%H-}Y: Integer);
  32. procedure SetCanEditGradTexPoints(AValue: boolean);
  33. procedure SetEditingGradTexPoints(AValue: boolean);
  34. procedure SetIsTarget(AValue: boolean);
  35. procedure SetVerticalPadding(AValue: integer);
  36. procedure ToolbarMouseDown(Sender: TObject; Button: TMouseButton;
  37. Shift: TShiftState; X, Y: Integer);
  38. procedure ToolbarMouseEnter(Sender: TObject);
  39. procedure ToolbarMouseLeave(Sender: TObject);
  40. procedure ToolbarMouseMove(Sender: TObject; Shift: TShiftState; X,
  41. Y: Integer);
  42. procedure ToolbarMouseUp(Sender: TObject; Button: TMouseButton;
  43. Shift: TShiftState; X, Y: Integer);
  44. procedure AnyButtonMouseDown(Sender: TObject; Button: TMouseButton;
  45. Shift: TShiftState; X, Y: Integer);
  46. procedure AnyButtonMouseEnter(Sender: TObject);
  47. procedure AnyButtonMouseLeave(Sender: TObject);
  48. procedure AnyButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
  49. Y: Integer);
  50. procedure AnyButtonMouseUp(Sender: TObject; Button: TMouseButton;
  51. Shift: TShiftState; X, Y: Integer);
  52. protected
  53. FFillType: TVectorialFillType;
  54. FAllowedFillTypes: TVectorialFillTypes;
  55. FSolidColor: TBGRAPixel;
  56. FOnChooseColor: TChooseColorEvent;
  57. FGradStartColor, FGradEndColor: TBGRAPixel;
  58. FGradType: TGradientType;
  59. FGradRepetition: TBGRAGradientRepetition;
  60. FGradInterp: TBGRAColorInterpolation;
  61. FTexRepetition: TTextureRepetition;
  62. FTexture: TBGRABitmap;
  63. FTexOpacity: byte;
  64. FTextureAverageColor: TBGRAPixel;
  65. FTextureAverageColorComputed: boolean;
  66. //interface
  67. FContainer: TWinControl;
  68. FVerticalPadding: integer;
  69. FPreview: TImage;
  70. FButtonFillNone, FButtonFillSolid,
  71. FButtonFillGradient, FButtonFillTexture: TToolButton;
  72. FOnFillChange, FOnFillTypeChange, FOnOpacityChange: TNotifyEvent;
  73. FButtonEditGradTexPoints, FButtonAdjustToShape: TToolButton;
  74. FOnEditGradTexPoints, FOnAdjustToShape: TNotifyEvent;
  75. FSolidColorInterfaceCreated: boolean;
  76. FShapeSolidColor: TShape;
  77. FUpDownSolidAlpha: TBCTrackbarUpdown;
  78. FSolidColorChange: TNotifyEvent;
  79. FTextureInterfaceCreated: boolean;
  80. FCanAdjustToShape: boolean;
  81. FButtonTexRepeat, FButtonLoadTexture: TToolButton;
  82. FUpDownTexAlpha: TBCTrackbarUpdown;
  83. FOnTextureClick: TNotifyEvent;
  84. FOnTextureChange: TNotifyEvent;
  85. FGradientInterfaceCreated: boolean;
  86. //FShapeStartColor, FShapeEndColor: TShape;
  87. FUpDownStartAlpha, FUpDownEndAlpha: TBCTrackbarUpdown;
  88. FButtonSwapColor, FButtonGradRepetition, FButtonGradInterp: TToolButton;
  89. FGradTypeMenu, FGradRepetitionMenu, FGradInterpMenu: TPopupMenu;
  90. FColorDlg: TColorDialog;
  91. FOpenPictureDlg: TOpenPictureDialog;
  92. FTexRepetitionMenu: TPopupMenu;
  93. FToolbar: TToolBar;
  94. FImageList: TBGRAImageList;
  95. FImageListLoaded: boolean;
  96. FImageListSize: TSize;
  97. procedure AdjustToShapeClick(Sender: TObject);
  98. procedure ButtonFillChange(Sender: TObject);
  99. procedure ButtonFillGradClick(Sender: TObject);
  100. procedure ButtonFillTexClick(Sender: TObject);
  101. procedure ButtonGradInterpClick(Sender: TObject);
  102. procedure ButtonGradRepetitionClick(Sender: TObject);
  103. procedure ButtonLoadTextureClick(Sender: TObject);
  104. procedure ButtonSwapColorClick(Sender: TObject);
  105. procedure ButtonTexRepeatClick(Sender: TObject);
  106. procedure Changed(AUpdatePreview: boolean = True);
  107. procedure OnClickBackGradType(ASender: TObject);
  108. procedure OnClickBackTexRepeat(ASender: TObject);
  109. procedure OnClickGradInterp(ASender: TObject);
  110. procedure OnClickGradRepeat(ASender: TObject);
  111. function GetPreferredSize: TSize;
  112. function GetAverageColor: TBGRAPixel;
  113. procedure SetCanAdjustToShape(AValue: boolean);
  114. procedure SetContainer(AValue: TWinControl);
  115. procedure SetFillType(AValue: TVectorialFillType);
  116. procedure SetAllowedFillTypes(AValue: TVectorialFillTypes);
  117. procedure SetSolidColor(AValue: TBGRAPixel);
  118. procedure SetGradientType(AValue: TGradientType);
  119. procedure SetGradEndColor(AValue: TBGRAPixel);
  120. procedure SetGradStartColor(AValue: TBGRAPixel);
  121. procedure SetGradRepetition(AValue: TBGRAGradientRepetition);
  122. procedure SetGradInterpolation(AValue: TBGRAColorInterpolation);
  123. procedure SetImageListSize(AValue: TSize);
  124. procedure SetTexture(AValue: TBGRABitmap);
  125. procedure SetTextureRepetition(AValue: TTextureRepetition);
  126. procedure SetTextureOpacity(AValue: byte);
  127. procedure SetOnTextureClick(AValue: TNotifyEvent);
  128. // procedure ShapeEndColorMouseUp({%H-}Sender: TObject; {%H-}Button: TMouseButton;
  129. // {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
  130. procedure ShapeSolidColorMouseUp({%H-}Sender: TObject; {%H-}Button: TMouseButton;
  131. {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
  132. // procedure ShapeStartColorMouseUp({%H-}Sender: TObject; {%H-}Button: TMouseButton;
  133. // {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
  134. procedure UpdateAccordingToFillType;
  135. procedure UpdateTopToolbar;
  136. procedure UpdatePreview;
  137. procedure UpdateShapeSolidColor;
  138. procedure UpdateTextureParams;
  139. procedure UpdateGradientParams;
  140. procedure UpdateButtonAdjustToShape;
  141. procedure UpDownEndAlphaChange(Sender: TObject; AByUser: boolean);
  142. procedure UpDownSolidAlphaChange(Sender: TObject; AByUser: boolean);
  143. procedure UpDownStartAlphaChange(Sender: TObject; AByUser: boolean);
  144. procedure UpDownTexAlphaChange(Sender: TObject; AByUser: boolean);
  145. procedure ChooseColor(AColorIndex: integer; AButton: TMouseButton);
  146. procedure CreateSolidColorInterface;
  147. procedure CreateGradientInterface;
  148. procedure CreateTextureInterface;
  149. procedure HideSolidColorInterface;
  150. procedure HideGradientInterface;
  151. procedure HideTextureInterface;
  152. procedure Init(AImageListWidth,AImageListHeight: Integer);
  153. procedure AttachMouseEvent(AControl: TToolBar); overload;
  154. procedure AttachMouseEvent(AControl: TToolButton); overload;
  155. procedure AttachMouseEvent(AControl: TBCTrackbarUpdown); overload;
  156. procedure AttachMouseEvent(AControl: TImage); overload;
  157. public
  158. constructor Create(AOwner: TComponent); override;
  159. constructor Create(AOwner: TComponent; AImageListWidth,AImageListHeight: Integer);
  160. destructor Destroy; override;
  161. procedure LoadTexture;
  162. procedure LoadImageList;
  163. procedure ContainerSizeChanged;
  164. function GetTextureThumbnail(AWidth, AHeight: integer; ABackColor: TColor): TBitmap;
  165. procedure AssignFill(AFill: TVectorialFill);
  166. procedure UpdateFillExceptGeometry(ATargetFill: TVectorialFill);
  167. function CreateShapeFill(AShape: TVectorShape): TVectorialFill;
  168. procedure UpdateShapeFill(AShape: TVectorShape; ATarget: TLCFillTarget);
  169. property FillType: TVectorialFillType read FFillType write SetFillType;
  170. property IsTarget: boolean read FIsTarget write SetIsTarget;
  171. property SolidColor: TBGRAPixel read FSolidColor write SetSolidColor;
  172. property AverageColor: TBGRAPixel read GetAverageColor;
  173. property GradientType: TGradientType read FGradType write SetGradientType;
  174. property GradStartColor: TBGRAPixel read FGradStartColor write SetGradStartColor;
  175. property GradEndColor: TBGRAPixel read FGradEndColor write SetGradEndColor;
  176. property GradRepetition: TBGRAGradientRepetition read FGradRepetition write SetGradRepetition;
  177. property GradInterpolation: TBGRAColorInterpolation read FGradInterp write SetGradInterpolation;
  178. property Texture: TBGRABitmap read FTexture write SetTexture;
  179. property TextureRepetition: TTextureRepetition read FTexRepetition write SetTextureRepetition;
  180. property TextureOpacity: byte read FTexOpacity write SetTextureOpacity;
  181. property CanAdjustToShape: boolean read FCanAdjustToShape write SetCanAdjustToShape;
  182. property CanEditGradTexPoints: boolean read FCanEditGradTexPoints write SetCanEditGradTexPoints;
  183. property EditingGradTexPoints: boolean read GetEditingGradTexPoints write SetEditingGradTexPoints;
  184. property OnFillChange: TNotifyEvent read FOnFillChange write FOnFillChange;
  185. property OnTextureChange: TNotifyEvent read FOnTextureChange write FOnTextureChange;
  186. property OnTextureClick: TNotifyEvent read FOnTextureClick write SetOnTextureClick;
  187. property OnAdjustToShape: TNotifyEvent read FOnAdjustToShape write FOnAdjustToShape;
  188. property OnEditGradTexPoints: TNotifyEvent read FOnEditGradTexPoints write FOnEditGradTexPoints;
  189. property OnFillTypeChange: TNotifyEvent read FOnFillTypeChange write FOnFillTypeChange;
  190. property OnOpacityChange: TNotifyEvent read FOnOpacityChange write FOnOpacityChange;
  191. property OnChooseColor: TChooseColorEvent read FOnChooseColor write FOnChooseColor;
  192. property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  193. property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  194. property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  195. property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  196. property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  197. property Container: TWinControl read FContainer write SetContainer;
  198. property ImageListSize: TSize read FImageListSize write SetImageListSize;
  199. property VerticalPadding: integer read FVerticalPadding write SetVerticalPadding;
  200. property PreferredSize: TSize read GetPreferredSize;
  201. property AllowedFillTypes: TVectorialFillTypes read FAllowedFillTypes write SetAllowedFillTypes;
  202. end;
  203. implementation
  204. uses LCToolbars, BGRAThumbnail, LResources,
  205. LCVectorShapes, BGRAGradientOriginal, BGRATransform, math,
  206. LCResourceString;
  207. function GradRepetitionToStr(AValue: TBGRAGradientRepetition): string;
  208. begin
  209. case AValue of
  210. grPad: result := rsGrPad;
  211. grRepeat: result := rsGrRepeat;
  212. grReflect: result := rsGrReflect;
  213. grSine: result := rsGrSine;
  214. else result := '';
  215. end;
  216. end;
  217. function ColorInterpToStr(AValue: TBGRAColorInterpolation): string;
  218. begin
  219. case AValue of
  220. ciStdRGB: result := rsCiStdRGB;
  221. ciLinearRGB: result := rsCiLinearRGB;
  222. ciLinearHSLPositive: result := rsCiLinearHSLPositive;
  223. ciLinearHSLNegative: result := rsCiLinearHSLNegative;
  224. ciGSBPositive: result := rsCiGSBPositive;
  225. ciGSBNegative: result := rsCiGSBNegative;
  226. else result := '';
  227. end;
  228. end;
  229. function TextureRepetitionToStr(AValue: TTextureRepetition): string;
  230. begin
  231. case AValue of
  232. trNone: result := rsTrNone;
  233. trRepeatX: result := rsTrRepeatX;
  234. trRepeatY: result := rsTrRepeatY;
  235. trRepeatBoth: result := rsTrRepeatBoth;
  236. else result := '';
  237. end;
  238. end;
  239. { TVectorialFillInterface }
  240. procedure TVectorialFillInterface.LoadImageList;
  241. var
  242. i: Integer;
  243. lst: TStringList;
  244. begin
  245. if FImageList = nil then FImageList := TBGRAImageList.Create(self);
  246. if FImageListLoaded and (FImageList.Width=FImageListSize.cx) and (FImageList.Height=FImageListSize.cy) then exit;
  247. FImageList.Clear;
  248. FImageList.Width := FImageListSize.cx;
  249. FImageList.Height := FImageListSize.cy;
  250. {$IFDEF DARWIN}
  251. FImageList.Scaled := true;
  252. FImageList.RegisterResolutions([FImageListSize.cx, FImageListSize.cx*2]);
  253. {$ENDIF}
  254. lst := TStringList.Create;
  255. lst.CommaText := GetResourceString('fillimages.lst');
  256. for i := 0 to lst.Count-1 do
  257. LoadToolbarImage(FImageList, i, lst[i]);
  258. lst.Free;
  259. FImageListLoaded := true;
  260. if Assigned(FToolbar) then
  261. begin
  262. SetToolbarImages(FToolbar, FImageList, 5, VerticalPadding);
  263. for i := 0 to FToolbar.ControlCount-1 do
  264. if FToolbar.Controls[i] is TBCTrackbarUpdown then
  265. FToolbar.Controls[i].Width := FToolbar.ButtonWidth*2
  266. else if FToolbar.Controls[i] is TShape then
  267. FToolbar.Controls[i].Width := FToolbar.ButtonWidth;
  268. end;
  269. UpdatePreview;
  270. end;
  271. procedure TVectorialFillInterface.Changed(AUpdatePreview: boolean);
  272. begin
  273. if AUpdatePreview then UpdatePreview;
  274. if Assigned(FOnFillChange) then
  275. FOnFillChange(self);
  276. end;
  277. procedure TVectorialFillInterface.OnClickBackGradType(ASender: TObject);
  278. begin
  279. GradientType:= TGradientType((ASender as TMenuItem).Tag);
  280. FillType := vftGradient;
  281. end;
  282. procedure TVectorialFillInterface.OnClickBackTexRepeat(ASender: TObject);
  283. begin
  284. TextureRepetition := TTextureRepetition((ASender as TMenuItem).Tag);
  285. end;
  286. procedure TVectorialFillInterface.OnClickGradInterp(ASender: TObject);
  287. begin
  288. GradInterpolation:= TBGRAColorInterpolation((ASender as TMenuItem).Tag);
  289. end;
  290. procedure TVectorialFillInterface.OnClickGradRepeat(ASender: TObject);
  291. begin
  292. GradRepetition:= TBGRAGradientRepetition((ASender as TMenuItem).Tag);
  293. end;
  294. procedure TVectorialFillInterface.SetTexture(AValue: TBGRABitmap);
  295. begin
  296. if FTexture=AValue then Exit;
  297. if Assigned(FTexture) then
  298. begin
  299. FTexture.FreeReference;
  300. FTexture := nil;
  301. end;
  302. if Assigned(AValue) then
  303. FTexture := AValue.NewReference as TBGRABitmap;
  304. FTextureAverageColorComputed := false;
  305. if Assigned(FOnTextureChange) then FOnTextureChange(self);
  306. if FFillType = vftTexture then Changed;
  307. end;
  308. procedure TVectorialFillInterface.LoadTexture;
  309. var
  310. newTex: TBGRABitmap;
  311. begin
  312. if FOpenPictureDlg.Execute then
  313. begin
  314. try
  315. newTex := TBGRABitmap.Create(FOpenPictureDlg.FileName, true);
  316. Texture := newTex;
  317. newTex.FreeReference;
  318. FillType:= vftTexture;
  319. except
  320. on ex: exception do
  321. ShowMessage(ex.Message);
  322. end;
  323. end;
  324. end;
  325. procedure TVectorialFillInterface.ContainerSizeChanged;
  326. begin
  327. FToolbar.Align:= alTop;
  328. FToolbar.Height := FContainer.Height;
  329. end;
  330. procedure TVectorialFillInterface.SetFillType(AValue: TVectorialFillType);
  331. begin
  332. if FFillType=AValue then Exit;
  333. FFillType:=AValue;
  334. UpdateAccordingToFillType;
  335. UpdatePreview;
  336. if Assigned(FOnFillTypeChange) then FOnFillTypeChange(self);
  337. Changed(False);
  338. end;
  339. procedure TVectorialFillInterface.ShapeSolidColorMouseUp(Sender: TObject;
  340. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  341. begin
  342. ChooseColor(-1, Button);
  343. end;
  344. {procedure TVectorialFillInterface.ShapeStartColorMouseUp(Sender: TObject;
  345. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  346. begin
  347. ChooseColor(0, Button);
  348. end;}
  349. procedure TVectorialFillInterface.UpdateAccordingToFillType;
  350. begin
  351. FButtonFillNone.Down := FillType = vftNone;
  352. FButtonFillSolid.Down := FillType = vftSolid;
  353. FButtonFillGradient.Down := FillType = vftGradient;
  354. FButtonFillTexture.Down := FillType = vftTexture;
  355. UpdateButtonAdjustToShape;
  356. if FillType <> vftSolid then HideSolidColorInterface;
  357. if FillType <> vftGradient then HideGradientInterface;
  358. if FillType <> vftTexture then HideTextureInterface;
  359. case FillType of
  360. vftSolid: begin
  361. CreateSolidColorInterface;
  362. UpdateShapeSolidColor;
  363. ShowAppendToolButtons([FShapeSolidColor,FUpDownSolidAlpha]);
  364. end;
  365. vftGradient: begin
  366. CreateGradientInterface;
  367. UpdateGradientParams;
  368. ShowAppendToolButtons([FButtonGradRepetition,FButtonGradInterp,
  369. {FShapeStartColor,}FUpDownStartAlpha,FButtonSwapColor,
  370. {FShapeEndColor,}FUpDownEndAlpha]);
  371. end;
  372. vftTexture: begin
  373. CreateTextureInterface;
  374. UpdateTextureParams;
  375. ShowAppendToolButtons([FButtonTexRepeat,FUpDownTexAlpha,FButtonLoadTexture]);
  376. end;
  377. end;
  378. end;
  379. procedure TVectorialFillInterface.UpdateTopToolbar;
  380. var
  381. x: Integer;
  382. begin
  383. FToolbar.BeginUpdate;
  384. x := FToolbar.Indent;
  385. FButtonFillNone.Left := x;
  386. //FButtonFillNone.Wrap := [vftSolid,vftGradient,vftTexture]*FAllowedFillTypes = [];
  387. FButtonFillNone.Visible:= vftNone in FAllowedFillTypes;
  388. if vftNone in FAllowedFillTypes then inc(x, FButtonFillNone.Width);
  389. FButtonFillSolid.Left := x;
  390. //FButtonFillSolid.Wrap := [vftGradient,vftTexture]*FAllowedFillTypes = [];
  391. FButtonFillSolid.Visible:= vftSolid in FAllowedFillTypes;
  392. if vftSolid in FAllowedFillTypes then inc(x, FButtonFillSolid.Width);
  393. FButtonFillGradient.Left := x;
  394. //FButtonFillGradient.Wrap := [vftTexture]*FAllowedFillTypes = [];
  395. FButtonFillGradient.Visible:= vftGradient in FAllowedFillTypes;
  396. if vftGradient in FAllowedFillTypes then inc(x, FButtonFillGradient.Width);
  397. FButtonFillTexture.Left := x;
  398. FButtonFillTexture.Visible:= vftTexture in FAllowedFillTypes;
  399. if vftTexture in FAllowedFillTypes then inc(x, FButtonFillTexture.Width);
  400. FPreview.Left := x;
  401. inc(x, FPreview.Width);
  402. FButtonEditGradTexPoints.Left := x;
  403. inc(x, FButtonEditGradTexPoints.Width);
  404. FButtonAdjustToShape.Left := x;
  405. FToolbar.EndUpdate;
  406. end;
  407. procedure TVectorialFillInterface.UpdatePreview;
  408. var
  409. bmp, thumb: TBGRABitmap;
  410. grad: TBGRALayerGradientOriginal;
  411. bmpCopy: TBitmap;
  412. ratio: single;
  413. previewWidth: Integer;
  414. begin
  415. if FillType = vftGradient then
  416. previewWidth := round(FToolbar.ButtonWidth*1.5)
  417. else previewWidth := FToolbar.ButtonWidth;
  418. FPreview.Width:= previewWidth + round(FToolbar.ButtonWidth*0.2);
  419. FPreview.Height:= FToolbar.ButtonHeight;
  420. if not FImageListLoaded then exit;
  421. bmp := TBGRABitmap.Create(previewWidth, FPreview.Height - VerticalPadding);
  422. bmp.DrawCheckers(bmp.ClipRect, CSSWhite, CSSSilver);
  423. case FillType of
  424. vftSolid: bmp.Fill(SolidColor, dmDrawWithTransparency);
  425. vftTexture:
  426. if Assigned(FTexture) and (FTexture.Width > 0) and (FTexture.Height > 0) then
  427. begin
  428. ratio := min(bmp.Width/FTexture.Width, bmp.Height/FTexture.Height);
  429. if ratio > 1 then ratio := 1;
  430. thumb := TBGRABitmap.Create(max(round(FTexture.Width*ratio),1),
  431. max(round(FTexture.Height*ratio),1));
  432. thumb.StretchPutImage(thumb.ClipRect, FTexture, dmSet);
  433. bmp.Fill(thumb, dmDrawWithTransparency, TextureOpacity*$0101);
  434. thumb.Free;
  435. end;
  436. vftGradient:
  437. begin
  438. grad := TBGRALayerGradientOriginal.Create;
  439. grad.StartColor := GradStartColor;
  440. grad.EndColor := GradEndColor;
  441. grad.Origin := PointF(0,0);
  442. grad.XAxis := PointF(bmp.Width, 0);
  443. grad.ColorInterpolation:= GradInterpolation;
  444. grad.Render(bmp, AffineMatrixIdentity, false, dmDrawWithTransparency);
  445. grad.Free;
  446. end;
  447. end;
  448. if IsTarget then
  449. begin
  450. if bmp.GetPixel(bmp.Width/2,bmp.Height/2).Lightness > 20000 then
  451. bmp.Rectangle(bmp.ClipRect, BGRABlack, dmDrawWithTransparency)
  452. else bmp.Rectangle(bmp.ClipRect, CSSSilver, dmDrawWithTransparency);
  453. end
  454. else bmp.Rectangle(bmp.ClipRect, BGRA(0,0,0,128), dmDrawWithTransparency);
  455. bmpCopy := bmp.MakeBitmapCopy(clBtnFace);
  456. bmp.Free;
  457. FPreview.Picture.Assign(bmpCopy);
  458. bmpCopy.Free;
  459. if (FillType = vftTexture) and Assigned(Texture) and Assigned(FOnTextureClick) then
  460. FPreview.Cursor := crHandPoint
  461. else
  462. FPreview.Cursor := crDefault;
  463. end;
  464. procedure TVectorialFillInterface.UpdateShapeSolidColor;
  465. var
  466. c: TBGRAPixel;
  467. begin
  468. c := SolidColor;
  469. c.alpha := 255;
  470. if Assigned(FShapeSolidColor) then FShapeSolidColor.Brush.Color := c;
  471. if Assigned(FUpDownSolidAlpha) then FUpDownSolidAlpha.Value := SolidColor.alpha;
  472. end;
  473. procedure TVectorialFillInterface.UpdateTextureParams;
  474. begin
  475. if Assigned(FButtonTexRepeat) then FButtonTexRepeat.ImageIndex := 17 + ord(TextureRepetition);
  476. if Assigned(FUpDownTexAlpha) then FUpDownTexAlpha.Value := TextureOpacity;
  477. end;
  478. procedure TVectorialFillInterface.UpdateGradientParams;
  479. {var
  480. c: TBGRAPixel;}
  481. begin
  482. { c := GradStartColor;
  483. c.alpha := 255;
  484. if Assigned(FShapeStartColor) then FShapeStartColor.Brush.Color := c;}
  485. if Assigned(FUpDownStartAlpha) then FUpDownStartAlpha.Value := GradStartColor.alpha;
  486. { c := GradEndColor;
  487. c.alpha := 255;
  488. if Assigned(FShapeEndColor) then FShapeEndColor.Brush.Color := c;}
  489. if Assigned(FUpDownEndAlpha) then FUpDownEndAlpha.Value := GradEndColor.alpha;
  490. if Assigned(FButtonGradRepetition) then FButtonGradRepetition.ImageIndex := 7+ord(FGradRepetition);
  491. if Assigned(FButtonGradInterp) then FButtonGradInterp.ImageIndex := 11+ord(FGradInterp);
  492. end;
  493. procedure TVectorialFillInterface.UpdateButtonAdjustToShape;
  494. begin
  495. if Assigned(FButtonAdjustToShape) then
  496. begin
  497. FButtonAdjustToShape.Enabled := FCanAdjustToShape and (FillType in[vftGradient,vftTexture]);
  498. if FillType in[vftGradient,vftTexture] then
  499. FButtonAdjustToShape.Style := tbsButton
  500. else
  501. FButtonAdjustToShape.Style := tbsDivider;
  502. end;
  503. if Assigned(FButtonEditGradTexPoints) then
  504. begin
  505. FButtonEditGradTexPoints.Enabled := FCanEditGradTexPoints and (FillType in [vftGradient,vftTexture]);
  506. if FillType in [vftGradient,vftTexture] then
  507. FButtonEditGradTexPoints.Style := tbsCheck
  508. else
  509. FButtonEditGradTexPoints.Style := tbsDivider;
  510. end;
  511. end;
  512. procedure TVectorialFillInterface.UpDownEndAlphaChange(Sender: TObject;
  513. AByUser: boolean);
  514. var
  515. c: TBGRAPixel;
  516. begin
  517. if AByUser then
  518. begin
  519. c := GradEndColor;
  520. c.alpha := FUpDownEndAlpha.Value;
  521. GradEndColor:= c;
  522. if assigned(FOnOpacityChange) then FOnOpacityChange(self);
  523. end;
  524. end;
  525. procedure TVectorialFillInterface.UpDownSolidAlphaChange(Sender: TObject;
  526. AByUser: boolean);
  527. begin
  528. if AByUser then
  529. begin
  530. SolidColor:= ColorToBGRA(FShapeSolidColor.Brush.Color, FUpDownSolidAlpha.Value);
  531. if assigned(FOnOpacityChange) then FOnOpacityChange(self);
  532. end;
  533. end;
  534. procedure TVectorialFillInterface.UpDownStartAlphaChange(Sender: TObject;
  535. AByUser: boolean);
  536. var
  537. c: TBGRAPixel;
  538. begin
  539. if AByUser then
  540. begin
  541. c := GradStartColor;
  542. c.alpha := FUpDownStartAlpha.Value;
  543. GradStartColor:= c;
  544. if assigned(FOnOpacityChange) then FOnOpacityChange(self);
  545. end;
  546. end;
  547. procedure TVectorialFillInterface.UpDownTexAlphaChange(Sender: TObject;
  548. AByUser: boolean);
  549. begin
  550. if AByUser then
  551. begin
  552. FTexOpacity:= FUpDownTexAlpha.Value;
  553. if FillType = vftTexture then Changed;
  554. end;
  555. end;
  556. procedure TVectorialFillInterface.ChooseColor(AColorIndex: integer; AButton: TMouseButton);
  557. procedure AssignNewColor(AColor: TBGRAPixel);
  558. begin
  559. case AColorIndex of
  560. -1: SolidColor := AColor;
  561. 0: GradStartColor := AColor;
  562. 1: GradEndColor := AColor;
  563. end;
  564. end;
  565. var
  566. curColorBGRA: TBGRAPixel;
  567. curColor: TColor;
  568. handled: boolean;
  569. begin
  570. case AColorIndex of
  571. -1: curColorBGRA := SolidColor;
  572. 0: curColorBGRA := GradStartColor;
  573. 1: curColorBGRA := GradEndColor;
  574. else exit;
  575. end;
  576. if Assigned(FOnChooseColor) then
  577. begin
  578. FOnChooseColor(self, AButton, AColorIndex, curColorBGRA, handled);
  579. if handled then
  580. begin
  581. AssignNewColor( curColorBGRA );
  582. exit;
  583. end;
  584. end;
  585. curColor := RGBToColor(curColorBGRA.red, curColorBGRA.green, curColorBGRA.blue);
  586. FColorDlg.Color := curColor;
  587. if FColorDlg.Execute then
  588. begin
  589. if curColorBGRA.alpha = 0 then
  590. AssignNewColor( ColorToBGRA(FColorDlg.Color) )
  591. else
  592. AssignNewColor( ColorToBGRA(FColorDlg.Color, curColorBGRA.alpha) );
  593. end;
  594. end;
  595. procedure TVectorialFillInterface.CreateSolidColorInterface;
  596. begin
  597. if FSolidColorInterfaceCreated then exit;
  598. FSolidColorInterfaceCreated := true;
  599. //solid color interface
  600. FShapeSolidColor := TShape.Create(FToolbar);
  601. FShapeSolidColor.Width := FToolbar.ButtonWidth;
  602. FShapeSolidColor.Height := FToolbar.ButtonHeight;
  603. FShapeSolidColor.OnMouseUp:= @ShapeSolidColorMouseUp;
  604. FShapeSolidColor.Hint := rsColor;
  605. AddToolbarControl(FToolbar, FShapeSolidColor);
  606. FUpDownSolidAlpha := TBCTrackbarUpdown.Create(FToolbar);
  607. FUpDownSolidAlpha.Width := FToolbar.ButtonWidth*2;
  608. FUpDownSolidAlpha.Height := FToolbar.ButtonHeight;
  609. FUpDownSolidAlpha.MinValue := 0;
  610. FUpDownSolidAlpha.MaxValue := 255;
  611. FUpDownSolidAlpha.Increment:= 15;
  612. FUpDownSolidAlpha.OnChange:=@UpDownSolidAlphaChange;
  613. FUpDownSolidAlpha.Hint := rsOpacity;
  614. AddToolbarControl(FToolbar, FUpDownSolidAlpha);
  615. AttachMouseEvent(FUpDownSolidAlpha);
  616. end;
  617. procedure TVectorialFillInterface.CreateGradientInterface;
  618. var
  619. gr: TBGRAGradientRepetition;
  620. ci: TBGRAColorInterpolation;
  621. item: TMenuItem;
  622. begin
  623. if FGradientInterfaceCreated then exit;
  624. FGradientInterfaceCreated := true;
  625. FButtonGradRepetition := AddToolbarButton(FToolbar, rsGradientRepetition+'...', 7+ord(FGradRepetition), @ButtonGradRepetitionClick);
  626. AttachMouseEvent(FButtonGradRepetition);
  627. FButtonGradInterp := AddToolbarButton(FToolbar, rsColorInterpolation+'...', 11+ord(FGradInterp), @ButtonGradInterpClick);
  628. AttachMouseEvent(FButtonGradInterp);
  629. { FShapeStartColor := TShape.Create(FToolbar);
  630. FShapeStartColor.Width := FToolbar.ButtonWidth*3 div 4;
  631. FShapeStartColor.Height := FToolbar.ButtonHeight;
  632. FShapeStartColor.OnMouseUp:=@ShapeStartColorMouseUp;
  633. FShapeStartColor.Hint := 'Start color';
  634. AddToolbarControl(FToolbar, FShapeStartColor);}
  635. FUpDownStartAlpha := TBCTrackbarUpdown.Create(FToolbar);
  636. FUpDownStartAlpha.Width := FToolbar.ButtonWidth*2;
  637. FUpDownStartAlpha.Height := FToolbar.ButtonHeight;
  638. FUpDownStartAlpha.MinValue := 0;
  639. FUpDownStartAlpha.MaxValue := 255;
  640. FUpDownStartAlpha.Increment:= 15;
  641. FUpDownStartAlpha.OnChange:=@UpDownStartAlphaChange;
  642. FUpDownStartAlpha.Hint := rsStartOpacity;
  643. AddToolbarControl(FToolbar, FUpDownStartAlpha);
  644. AttachMouseEvent(FUpDownStartAlpha);
  645. FButtonSwapColor := AddToolbarButton(FToolbar, rsSwapColors, 23, @ButtonSwapColorClick);
  646. AttachMouseEvent(FButtonSwapColor);
  647. { FShapeEndColor := TShape.Create(FToolbar);
  648. FShapeEndColor.Width := FToolbar.ButtonWidth*3 div 4;
  649. FShapeEndColor.Height := FToolbar.ButtonHeight;
  650. FShapeEndColor.OnMouseUp:=@ShapeEndColorMouseUp;
  651. FShapeEndColor.Hint := 'End color';
  652. AddToolbarControl(FToolbar, FShapeEndColor);}
  653. FUpDownEndAlpha := TBCTrackbarUpdown.Create(FToolbar);
  654. FUpDownEndAlpha.Width := FToolbar.ButtonWidth*2;
  655. FUpDownEndAlpha.Height := FToolbar.ButtonHeight;
  656. FUpDownEndAlpha.MinValue := 0;
  657. FUpDownEndAlpha.MaxValue := 255;
  658. FUpDownEndAlpha.Increment:= 15;
  659. FUpDownEndAlpha.OnChange:=@UpDownEndAlphaChange;
  660. FUpDownEndAlpha.Hint := rsEndOpacity;
  661. AddToolbarControl(FToolbar, FUpDownEndAlpha);
  662. AttachMouseEvent(FUpDownEndAlpha);
  663. FGradRepetitionMenu := TPopupMenu.Create(self);
  664. FGradRepetitionMenu.Images := FImageList;
  665. for gr := low(TBGRAGradientRepetition) to high(TBGRAGradientRepetition) do
  666. begin
  667. item := TMenuItem.Create(FGradRepetitionMenu); item.Caption := GradRepetitionToStr(gr);
  668. item.OnClick:=@OnClickGradRepeat; item.Tag := ord(gr);
  669. item.ImageIndex:= 7+ord(gr);
  670. FGradRepetitionMenu.Items.Add(item);
  671. end;
  672. FGradInterpMenu := TPopupMenu.Create(self);
  673. FGradInterpMenu.Images := FImageList;
  674. for ci := low(TBGRAColorInterpolation) to high(TBGRAColorInterpolation) do
  675. begin
  676. item := TMenuItem.Create(FGradInterpMenu); item.Caption := ColorInterpToStr(ci);
  677. item.OnClick:=@OnClickGradInterp; item.Tag := ord(ci);
  678. item.ImageIndex:= 11+ord(ci);
  679. FGradInterpMenu.Items.Add(item);
  680. end;
  681. end;
  682. procedure TVectorialFillInterface.CreateTextureInterface;
  683. var
  684. tr: TTextureRepetition;
  685. item: TMenuItem;
  686. begin
  687. if FTextureInterfaceCreated then exit;
  688. FTextureInterfaceCreated := true;
  689. FButtonTexRepeat := AddToolbarButton(FToolbar, rsTextureRepetition+'...', -1, @ButtonTexRepeatClick);
  690. AttachMouseEvent(FButtonTexRepeat);
  691. FUpDownTexAlpha := TBCTrackbarUpdown.Create(FToolbar);
  692. FUpDownTexAlpha.Width := FToolbar.ButtonWidth*2;
  693. FUpDownTexAlpha.Height := FToolbar.ButtonHeight;
  694. FUpDownTexAlpha.MinValue := 0;
  695. FUpDownTexAlpha.MaxValue := 255;
  696. FUpDownTexAlpha.Increment:= 15;
  697. FUpDownTexAlpha.OnChange:=@UpDownTexAlphaChange;
  698. FUpDownTexAlpha.Hint := rsOpacity;
  699. AddToolbarControl(FToolbar, FUpDownTexAlpha);
  700. AttachMouseEvent(FUpDownTexAlpha);
  701. FButtonLoadTexture := AddToolbarButton(FToolbar, rsLoadTexture+'...', 22, @ButtonLoadTextureClick);
  702. AttachMouseEvent(FButtonLoadTexture);
  703. FTextureAverageColorComputed := false;
  704. FTexRepetitionMenu := TPopupMenu.Create(self);
  705. FTexRepetitionMenu.Images := FImageList;
  706. for tr := low(TTextureRepetition) to high(TTextureRepetition) do
  707. begin
  708. item := TMenuItem.Create(FTexRepetitionMenu); item.Caption := TextureRepetitionToStr(tr);
  709. item.OnClick:=@OnClickBackTexRepeat; item.Tag := ord(tr);
  710. item.ImageIndex:= 17+ord(tr);
  711. FTexRepetitionMenu.Items.Add(item);
  712. end;
  713. end;
  714. procedure TVectorialFillInterface.HideSolidColorInterface;
  715. begin
  716. if not FSolidColorInterfaceCreated then exit;
  717. FShapeSolidColor.Visible := false;
  718. FUpDownSolidAlpha.Visible := false;
  719. end;
  720. procedure TVectorialFillInterface.HideGradientInterface;
  721. begin
  722. if not FGradientInterfaceCreated then exit;
  723. FButtonGradRepetition.Visible := false;
  724. FButtonGradInterp.Visible := false;
  725. //FShapeStartColor.Visible := false;
  726. FUpDownStartAlpha.Visible := false;
  727. FButtonSwapColor.Visible := false;
  728. //FShapeEndColor.Visible := false;
  729. FUpDownEndAlpha.Visible := false;
  730. end;
  731. procedure TVectorialFillInterface.HideTextureInterface;
  732. begin
  733. if not FTextureInterfaceCreated then exit;
  734. FButtonTexRepeat.Visible := false;
  735. FUpDownTexAlpha.Visible := false;
  736. FButtonLoadTexture.Visible := false;
  737. end;
  738. procedure TVectorialFillInterface.Init(AImageListWidth,
  739. AImageListHeight: Integer);
  740. var
  741. gt: TGradientType;
  742. item: TMenuItem;
  743. begin
  744. FContainer := nil;
  745. FAllowedFillTypes := [vftNone, vftSolid, vftGradient, vftTexture];
  746. FFillType:= vftSolid;
  747. FSolidColor:= BGRAWhite;
  748. FGradStartColor:= CSSRed;
  749. FGradEndColor:= CSSYellow;
  750. FGradType:= gtLinear;
  751. FGradRepetition:= grPad;
  752. FGradInterp:= ciLinearRGB;
  753. FTexture:= nil;
  754. FTexRepetition:= trRepeatBoth;
  755. FTexOpacity:= 255;
  756. FCanAdjustToShape:= true;
  757. FVerticalPadding:= 4;
  758. FImageList := TBGRAImageList.Create(self);
  759. FImageListLoaded:= false;
  760. FImageListSize := Size(AImageListWidth,AImageListHeight);
  761. FOpenPictureDlg := TOpenPictureDialog.Create(self);
  762. FColorDlg:= TColorDialog.Create(self);
  763. FOnFillChange:= nil;
  764. FOnTextureChange:= nil;
  765. FToolbar := CreateToolBar(FImageList);
  766. FToolbar.Wrapable := false;
  767. AttachMouseEvent(FToolbar);
  768. FButtonFillNone := AddToolbarCheckButton(FToolbar, rsNoFill, 0, @ButtonFillChange, False, False);
  769. AttachMouseEvent(FButtonFillNone);
  770. FButtonFillSolid := AddToolbarCheckButton(FToolbar, rsSolidColor, 1, @ButtonFillChange, False, False);
  771. AttachMouseEvent(FButtonFillSolid);
  772. FButtonFillGradient := AddToolbarButton(FToolbar, rsGradientFill, 2+ord(FGradType), @ButtonFillGradClick);
  773. AttachMouseEvent(FButtonFillGradient);
  774. FButtonFillTexture := AddToolbarButton(FToolbar, rsTextureFill, 24, @ButtonFillTexClick);
  775. AttachMouseEvent(FButtonFillTexture);
  776. FPreview := TImage.Create(FToolbar);
  777. FPreview.Center:= true;
  778. FPreview.OnMouseUp:=@Preview_MouseUp;
  779. FPreview.Hint := rsPreview;
  780. UpdatePreview;
  781. AddToolbarControl(FToolbar, FPreview);
  782. AttachMouseEvent(FPreview);
  783. FButtonEditGradTexPoints := AddToolbarCheckButton(FToolbar, rsEditGradTexPoints, 25, @EditGradTextPointsClick, false, false);
  784. AttachMouseEvent(FButtonEditGradTexPoints);
  785. FButtonAdjustToShape := AddToolbarButton(FToolbar, rsAdjustToShape, 21, @AdjustToShapeClick);
  786. AttachMouseEvent(FButtonAdjustToShape);
  787. FButtonAdjustToShape.Wrap := true;
  788. UpdateButtonAdjustToShape;
  789. //menu to access gradient interface
  790. FGradTypeMenu := TPopupMenu.Create(self);
  791. FGradTypeMenu.Images := FImageList;
  792. for gt := low(TGradientType) to high(TGradientType) do
  793. begin
  794. item := TMenuItem.Create(FGradTypeMenu); item.Caption := GradientTypeToTranslatedStr(gt);
  795. item.OnClick:=@OnClickBackGradType; item.Tag := ord(gt);
  796. item.ImageIndex:= 2+ord(gt);
  797. FGradTypeMenu.Items.Add(item);
  798. end;
  799. FSolidColorInterfaceCreated := false;
  800. FGradientInterfaceCreated:= false;
  801. FTextureInterfaceCreated:= false;
  802. UpdateAccordingToFillType;
  803. end;
  804. procedure TVectorialFillInterface.AttachMouseEvent(AControl: TToolBar);
  805. begin
  806. AControl.OnMouseMove:=@ToolbarMouseMove;
  807. AControl.OnMouseDown:=@ToolbarMouseDown;
  808. AControl.OnMouseUp:=@ToolbarMouseUp;
  809. AControl.OnMouseEnter:=@ToolbarMouseEnter;
  810. AControl.OnMouseLeave:=@ToolbarMouseLeave;
  811. end;
  812. procedure TVectorialFillInterface.AttachMouseEvent(AControl: TToolButton);
  813. begin
  814. AControl.OnMouseMove:=@AnyButtonMouseMove;
  815. AControl.OnMouseDown:=@AnyButtonMouseDown;
  816. AControl.OnMouseUp:=@AnyButtonMouseUp;
  817. AControl.OnMouseEnter:=@AnyButtonMouseEnter;
  818. AControl.OnMouseLeave:=@AnyButtonMouseLeave;
  819. end;
  820. procedure TVectorialFillInterface.AttachMouseEvent(AControl: TBCTrackbarUpdown);
  821. begin
  822. AControl.OnMouseMove:=@AnyButtonMouseMove;
  823. AControl.OnMouseDown:=@AnyButtonMouseDown;
  824. AControl.OnMouseUp:=@AnyButtonMouseUp;
  825. AControl.OnMouseEnter:=@AnyButtonMouseEnter;
  826. AControl.OnMouseLeave:=@AnyButtonMouseLeave;
  827. end;
  828. procedure TVectorialFillInterface.AttachMouseEvent(AControl: TImage);
  829. begin
  830. AControl.OnMouseMove:=@AnyButtonMouseMove;
  831. AControl.OnMouseEnter:=@AnyButtonMouseEnter;
  832. AControl.OnMouseLeave:=@AnyButtonMouseLeave;
  833. end;
  834. procedure TVectorialFillInterface.SetSolidColor(AValue: TBGRAPixel);
  835. begin
  836. if FSolidColor.EqualsExactly(AValue) then Exit;
  837. FSolidColor:=AValue;
  838. UpdateShapeSolidColor;
  839. If FillType = vftSolid then Changed;
  840. end;
  841. procedure TVectorialFillInterface.ButtonFillChange(Sender: TObject);
  842. begin
  843. if Sender = FButtonFillNone then
  844. begin
  845. FillType:= vftNone;
  846. FButtonFillNone.Down := true;
  847. end
  848. else if Sender = FButtonFillSolid then
  849. begin
  850. FillType:= vftSolid;
  851. FButtonFillSolid.Down := true;
  852. end;
  853. end;
  854. procedure TVectorialFillInterface.SetTextureRepetition(
  855. AValue: TTextureRepetition);
  856. begin
  857. if FTexRepetition=AValue then Exit;
  858. FTexRepetition:=AValue;
  859. UpdateTextureParams;
  860. If FillType = vftTexture then Changed;
  861. end;
  862. procedure TVectorialFillInterface.SetTextureOpacity(AValue: byte);
  863. begin
  864. if FTexOpacity=AValue then Exit;
  865. FTexOpacity:=AValue;
  866. FUpDownTexAlpha.Value := AValue;
  867. If FillType = vftTexture then Changed;
  868. end;
  869. {procedure TVectorialFillInterface.ShapeEndColorMouseUp(Sender: TObject;
  870. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  871. begin
  872. ChooseColor(1, Button);
  873. end;}
  874. procedure TVectorialFillInterface.SetGradientType(AValue: TGradientType);
  875. begin
  876. if FGradType=AValue then Exit;
  877. FGradType:=AValue;
  878. FButtonFillGradient.ImageIndex := 2+ord(GradientType);
  879. if FillType = vftGradient then Changed;
  880. end;
  881. procedure TVectorialFillInterface.SetGradEndColor(AValue: TBGRAPixel);
  882. begin
  883. if FGradEndColor.EqualsExactly(AValue) then Exit;
  884. FGradEndColor:=AValue;
  885. UpdateGradientParams;
  886. if FillType = vftGradient then Changed;
  887. end;
  888. procedure TVectorialFillInterface.SetGradStartColor(AValue: TBGRAPixel);
  889. begin
  890. if FGradStartColor.EqualsExactly(AValue) then Exit;
  891. FGradStartColor:=AValue;
  892. UpdateGradientParams;
  893. if FillType = vftGradient then Changed;
  894. end;
  895. procedure TVectorialFillInterface.SetGradRepetition(AValue: TBGRAGradientRepetition);
  896. begin
  897. if FGradRepetition=AValue then Exit;
  898. FGradRepetition:=AValue;
  899. UpdateGradientParams;
  900. if FillType = vftGradient then Changed;
  901. end;
  902. procedure TVectorialFillInterface.SetGradInterpolation(
  903. AValue: TBGRAColorInterpolation);
  904. begin
  905. if FGradInterp=AValue then Exit;
  906. FGradInterp:=AValue;
  907. UpdateGradientParams;
  908. if FillType = vftGradient then Changed;
  909. end;
  910. procedure TVectorialFillInterface.SetContainer(AValue: TWinControl);
  911. begin
  912. if FContainer=AValue then Exit;
  913. if Assigned(FContainer) then FContainer.RemoveControl(FToolbar);
  914. FContainer:=AValue;
  915. if Assigned(FContainer) then
  916. begin
  917. FContainer.InsertControl(FToolBar);
  918. ContainerSizeChanged;
  919. end;
  920. end;
  921. function TVectorialFillInterface.GetPreferredSize: TSize;
  922. begin
  923. result := GetToolbarSize(FToolbar,0);
  924. end;
  925. procedure TVectorialFillInterface.SetCanAdjustToShape(AValue: boolean);
  926. begin
  927. if FCanAdjustToShape=AValue then Exit;
  928. FCanAdjustToShape:=AValue;
  929. UpdateButtonAdjustToShape;
  930. end;
  931. procedure TVectorialFillInterface.SetImageListSize(AValue: TSize);
  932. begin
  933. if (FImageListSize.cx=AValue.cx) and (FImageListSize.cy=AValue.cy) then Exit;
  934. FImageListSize:=AValue;
  935. if FImageListLoaded then LoadImageList;
  936. end;
  937. procedure TVectorialFillInterface.SetAllowedFillTypes(
  938. AValue: TVectorialFillTypes);
  939. begin
  940. Include(AValue, FFillType); //cannot exclude current type
  941. if FAllowedFillTypes=AValue then Exit;
  942. FAllowedFillTypes:=AValue;
  943. UpdateTopToolbar;
  944. end;
  945. procedure TVectorialFillInterface.SetOnTextureClick(AValue: TNotifyEvent);
  946. begin
  947. if FOnTextureClick=AValue then Exit;
  948. FOnTextureClick:=AValue;
  949. UpdatePreview;
  950. end;
  951. function TVectorialFillInterface.GetAverageColor: TBGRAPixel;
  952. begin
  953. case FillType of
  954. vftNone: result := BGRAPixelTransparent;
  955. vftGradient: result := MergeBGRAWithGammaCorrection(GradStartColor, 1, GradEndColor, 1);
  956. vftTexture: begin
  957. if not FTextureAverageColorComputed then
  958. begin
  959. if Assigned(FTexture) then
  960. FTextureAverageColor := FTexture.AverageColor
  961. else
  962. FTextureAverageColor := BGRAPixelTransparent;
  963. FTextureAverageColorComputed := true;
  964. end;
  965. result := FTextureAverageColor;
  966. end
  967. else {vftSolid} result := SolidColor;
  968. end;
  969. end;
  970. procedure TVectorialFillInterface.ToolbarMouseMove(Sender: TObject;
  971. Shift: TShiftState; X, Y: Integer);
  972. begin
  973. if Assigned(FOnMouseMove) then FOnMouseMove(self, Shift, X+FToolbar.Left,Y+FToolbar.Top);
  974. end;
  975. procedure TVectorialFillInterface.ToolbarMouseUp(Sender: TObject;
  976. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  977. begin
  978. if Assigned(FOnMouseUp) then FOnMouseUp(self, Button, Shift, X+FToolbar.Left,Y+FToolbar.Top);
  979. end;
  980. procedure TVectorialFillInterface.AnyButtonMouseDown(Sender: TObject;
  981. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  982. begin
  983. if Assigned(FOnMouseDown) then FOnMouseDown(self, Button, Shift,
  984. X+FToolbar.Left+TControl(Sender).Left,Y+FToolbar.Top+TControl(Sender).Top);
  985. end;
  986. procedure TVectorialFillInterface.AnyButtonMouseEnter(Sender: TObject);
  987. begin
  988. If Assigned(FOnMouseEnter) then FOnMouseEnter(self);
  989. end;
  990. procedure TVectorialFillInterface.AnyButtonMouseLeave(Sender: TObject);
  991. begin
  992. If Assigned(FOnMouseLeave) then FOnMouseLeave(self);
  993. end;
  994. procedure TVectorialFillInterface.AnyButtonMouseMove(Sender: TObject;
  995. Shift: TShiftState; X, Y: Integer);
  996. begin
  997. if Assigned(FOnMouseMove) then FOnMouseMove(self, Shift,
  998. X+FToolbar.Left+TControl(Sender).Left,Y+FToolbar.Top+TControl(Sender).Top);
  999. end;
  1000. procedure TVectorialFillInterface.AnyButtonMouseUp(Sender: TObject;
  1001. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1002. begin
  1003. if Assigned(FOnMouseUp) then FOnMouseUp(self, Button, Shift,
  1004. X+FToolbar.Left+TControl(Sender).Left,Y+FToolbar.Top+TControl(Sender).Top);
  1005. end;
  1006. procedure TVectorialFillInterface.ToolbarMouseDown(Sender: TObject;
  1007. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1008. begin
  1009. if Assigned(FOnMouseDown) then FOnMouseDown(self, Button, Shift, X+FToolbar.Left,Y+FToolbar.Top);
  1010. end;
  1011. procedure TVectorialFillInterface.SetVerticalPadding(AValue: integer);
  1012. begin
  1013. if FVerticalPadding=AValue then Exit;
  1014. FVerticalPadding:=AValue;
  1015. if Assigned(FToolbar) and Assigned(FImageList) then
  1016. begin
  1017. FToolbar.ButtonHeight:= FImageList.Height+AValue;
  1018. UpdatePreview;
  1019. end;
  1020. end;
  1021. procedure TVectorialFillInterface.Preview_MouseUp(Sender: TObject;
  1022. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1023. begin
  1024. case FillType of
  1025. vftSolid: ChooseColor(-1, Button);
  1026. vftGradient: if X < FPreview.Width div 2 then ChooseColor(0, Button) else ChooseColor(1, Button);
  1027. vftTexture: if Assigned(Texture) and Assigned(FOnTextureClick) then
  1028. FOnTextureClick(self);
  1029. end;
  1030. end;
  1031. procedure TVectorialFillInterface.EditGradTextPointsClick(Sender: TObject);
  1032. begin
  1033. if Assigned(FOnEditGradTexPoints) then FOnEditGradTexPoints(self);
  1034. end;
  1035. function TVectorialFillInterface.GetEditingGradTexPoints: boolean;
  1036. begin
  1037. if Assigned(FButtonEditGradTexPoints) then
  1038. result := FButtonEditGradTexPoints.Down
  1039. else result := false;
  1040. end;
  1041. procedure TVectorialFillInterface.SetCanEditGradTexPoints(AValue: boolean);
  1042. begin
  1043. if FCanEditGradTexPoints=AValue then Exit;
  1044. FCanEditGradTexPoints:=AValue;
  1045. UpdateButtonAdjustToShape;
  1046. end;
  1047. procedure TVectorialFillInterface.SetEditingGradTexPoints(AValue: boolean);
  1048. begin
  1049. if Assigned(FButtonEditGradTexPoints) then
  1050. FButtonEditGradTexPoints.Down := AValue;
  1051. end;
  1052. procedure TVectorialFillInterface.SetIsTarget(AValue: boolean);
  1053. begin
  1054. if FIsTarget=AValue then Exit;
  1055. FIsTarget:=AValue;
  1056. UpdatePreview;
  1057. end;
  1058. procedure TVectorialFillInterface.ToolbarMouseEnter(Sender: TObject);
  1059. begin
  1060. If Assigned(FOnMouseEnter) then FOnMouseEnter(self);
  1061. end;
  1062. procedure TVectorialFillInterface.ToolbarMouseLeave(Sender: TObject);
  1063. begin
  1064. If Assigned(FOnMouseLeave) then FOnMouseLeave(self);
  1065. end;
  1066. procedure TVectorialFillInterface.AdjustToShapeClick(Sender: TObject);
  1067. begin
  1068. if Assigned(FOnAdjustToShape) then FOnAdjustToShape(self);
  1069. end;
  1070. procedure TVectorialFillInterface.ButtonFillGradClick(Sender: TObject);
  1071. begin
  1072. if Assigned(FGradTypeMenu) then
  1073. with FButtonFillGradient.ClientToScreen(Point(0,FButtonFillGradient.Height)) do
  1074. FGradTypeMenu.PopUp(X,Y);
  1075. FButtonFillGradient.Down := (FillType = vftGradient);
  1076. end;
  1077. procedure TVectorialFillInterface.ButtonFillTexClick(Sender: TObject);
  1078. begin
  1079. if FFillType = vftTexture then
  1080. begin
  1081. FButtonFillTexture.Down := true;
  1082. exit;
  1083. end;
  1084. if Assigned(FTexture) then FillType := vftTexture
  1085. else LoadTexture;
  1086. end;
  1087. procedure TVectorialFillInterface.ButtonGradInterpClick(Sender: TObject);
  1088. begin
  1089. if Assigned(FGradInterpMenu) then
  1090. with FButtonGradInterp.ClientToScreen(Point(0,FButtonGradInterp.Height)) do
  1091. FGradInterpMenu.PopUp(X,Y);
  1092. end;
  1093. procedure TVectorialFillInterface.ButtonGradRepetitionClick(Sender: TObject);
  1094. begin
  1095. if Assigned(FGradRepetitionMenu) then
  1096. with FButtonGradRepetition.ClientToScreen(Point(0,FButtonGradRepetition.Height)) do
  1097. FGradRepetitionMenu.PopUp(X,Y);
  1098. end;
  1099. procedure TVectorialFillInterface.ButtonLoadTextureClick(Sender: TObject);
  1100. begin
  1101. LoadTexture;
  1102. end;
  1103. procedure TVectorialFillInterface.ButtonSwapColorClick(Sender: TObject);
  1104. var
  1105. temp: TBGRAPixel;
  1106. begin
  1107. temp := GradStartColor;
  1108. FGradStartColor := GradEndColor;
  1109. FGradEndColor := temp;
  1110. UpdateGradientParams;
  1111. if FillType = vftGradient then Changed;
  1112. end;
  1113. procedure TVectorialFillInterface.ButtonTexRepeatClick(Sender: TObject);
  1114. begin
  1115. if Assigned(FTexRepetitionMenu) then
  1116. with FButtonTexRepeat.ClientToScreen(Point(0,FButtonTexRepeat.Height)) do
  1117. FTexRepetitionMenu.PopUp(X,Y);
  1118. end;
  1119. constructor TVectorialFillInterface.Create(AOwner: TComponent);
  1120. begin
  1121. inherited Create(AOwner);
  1122. Init(16,16);
  1123. end;
  1124. constructor TVectorialFillInterface.Create(AOwner: TComponent; AImageListWidth,
  1125. AImageListHeight: Integer);
  1126. begin
  1127. inherited Create(AOwner);
  1128. Init(AImageListWidth,AImageListHeight);
  1129. end;
  1130. destructor TVectorialFillInterface.Destroy;
  1131. begin
  1132. FTexture.FreeReference;
  1133. if Assigned(FContainer) then
  1134. begin
  1135. FContainer.RemoveControl(FToolbar);
  1136. FContainer := nil;
  1137. end;
  1138. FToolbar.Free;
  1139. inherited Destroy;
  1140. end;
  1141. function TVectorialFillInterface.GetTextureThumbnail(AWidth, AHeight: integer; ABackColor: TColor): TBitmap;
  1142. var
  1143. thumb: TBGRABitmap;
  1144. begin
  1145. if FTexture = nil then exit(nil);
  1146. thumb := GetBitmapThumbnail(FTexture, AWidth,AHeight,BGRAPixelTransparent,true);
  1147. try
  1148. result := thumb.MakeBitmapCopy(ABackColor);
  1149. finally
  1150. thumb.Free;
  1151. end;
  1152. end;
  1153. procedure TVectorialFillInterface.AssignFill(AFill: TVectorialFill);
  1154. begin
  1155. FillType := AFill.FillType;
  1156. case FillType of
  1157. vftTexture:
  1158. begin
  1159. Texture := AFill.Texture;
  1160. TextureOpacity:= AFill.TextureOpacity;
  1161. TextureRepetition:= AFill.TextureRepetition;
  1162. end;
  1163. vftSolid: SolidColor := AFill.SolidColor;
  1164. vftGradient:
  1165. begin
  1166. GradStartColor := AFill.Gradient.StartColor;
  1167. GradEndColor := AFill.Gradient.EndColor;
  1168. GradientType:= AFill.Gradient.GradientType;
  1169. GradRepetition:= AFill.Gradient.Repetition;
  1170. GradInterpolation := AFill.Gradient.ColorInterpolation;
  1171. end;
  1172. end;
  1173. end;
  1174. procedure TVectorialFillInterface.UpdateFillExceptGeometry(ATargetFill: TVectorialFill);
  1175. var
  1176. f: TVectorialFill;
  1177. begin
  1178. f := CreateShapeFill(nil);
  1179. if Assigned(ATargetFill) then
  1180. ATargetFill.AssignExceptGeometry(f);
  1181. f.Free;
  1182. end;
  1183. function TVectorialFillInterface.CreateShapeFill(AShape: TVectorShape): TVectorialFill;
  1184. var
  1185. grad: TBGRALayerGradientOriginal;
  1186. begin
  1187. if FillType = vftSolid then
  1188. exit(TVectorialFill.CreateAsSolid(SolidColor))
  1189. else if (FillType = vftTexture) and Assigned(Texture) then
  1190. result := TVectorialFill.CreateAsTexture(Texture, AffineMatrixIdentity,
  1191. TextureOpacity, TextureRepetition)
  1192. else if FillType = vftGradient then
  1193. begin
  1194. grad := TBGRALayerGradientOriginal.Create;
  1195. grad.StartColor := GradStartColor;
  1196. grad.EndColor := GradEndColor;
  1197. grad.GradientType:= GradientType;
  1198. grad.Repetition := GradRepetition;
  1199. grad.ColorInterpolation:= GradInterpolation;
  1200. result := TVectorialFill.CreateAsGradient(grad, true);
  1201. end
  1202. else exit(nil); //none
  1203. if Assigned(AShape) then
  1204. result.FitGeometry(AShape.SuggestGradientBox(AffineMatrixIdentity));
  1205. end;
  1206. procedure TVectorialFillInterface.UpdateShapeFill(AShape: TVectorShape;
  1207. ATarget: TLCFillTarget);
  1208. var
  1209. vectorFill: TVectorialFill;
  1210. curFill: TVectorialFill;
  1211. begin
  1212. case ATarget of
  1213. ftPen: curFill:= AShape.PenFill;
  1214. ftBack: curFill := AShape.BackFill;
  1215. ftOutline: curFill := AShape.OutlineFill;
  1216. else exit;
  1217. end;
  1218. if (FillType = vftTexture) and (TextureOpacity = 0) then
  1219. vectorFill := nil else
  1220. if (FillType = vftTexture) and (curFill.FillType = vftTexture) then
  1221. begin
  1222. vectorFill := TVectorialFill.CreateAsTexture(Texture, curFill.TextureMatrix,
  1223. TextureOpacity, TextureRepetition);
  1224. end
  1225. else if (FillType = vftGradient) and (curFill.FillType = vftGradient) then
  1226. begin
  1227. vectorFill := curFill.Duplicate;
  1228. vectorFill.Gradient.StartColor := GradStartColor;
  1229. vectorFill.Gradient.EndColor := GradEndColor;
  1230. vectorFill.Gradient.GradientType := GradientType;
  1231. vectorFill.Gradient.Repetition := GradRepetition;
  1232. vectorFill.Gradient.ColorInterpolation:= GradInterpolation;
  1233. end else
  1234. vectorFill := CreateShapeFill(AShape);
  1235. case ATarget of
  1236. ftPen: AShape.PenFill:= vectorFill;
  1237. ftBack: AShape.BackFill:= vectorFill;
  1238. ftOutline: AShape.OutlineFill:= vectorFill;
  1239. end;
  1240. vectorFill.Free;
  1241. end;
  1242. begin
  1243. {$i fillimages.lrs}
  1244. end.