lcvectorialfillinterface.pas 46 KB

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