utool.pas 147 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807
  1. // SPDX-License-Identifier: GPL-3.0-only
  2. unit UTool;
  3. {$mode objfpc}{$H+}
  4. interface
  5. uses
  6. Classes, Types, SysUtils, Graphics, BGRABitmap, BGRABitmapTypes, uimage, UImageType,
  7. ULayerAction, LCLType, Controls, UBrushType, UConfig, LCVectorPolyShapes,
  8. BGRAGradientScanner, BGRALayerOriginal, LCVectorRectShapes, UScripting,
  9. LCVectorialFill, BGRAGradientOriginal;
  10. const
  11. VK_SNAP = {$IFDEF DARWIN}VK_LWIN{$ELSE}VK_CONTROL{$ENDIF};
  12. VK_SNAP2 = {$IFDEF DARWIN}VK_RWIN{$ELSE}VK_CONTROL{$ENDIF};
  13. ssSnap = {$IFDEF DARWIN}ssMeta{$ELSE}ssCtrl{$ENDIF};
  14. type TPaintToolType = (ptHand,ptHotSpot, ptMoveLayer,ptRotateLayer,ptZoomLayer,
  15. ptPen, ptBrush, ptClone, ptColorPicker, ptEraser,
  16. ptEditShape, ptRect, ptEllipse, ptPolygon, ptSpline, ptPolyline, ptOpenedCurve,
  17. ptFloodFill, ptGradient, ptPhong,
  18. ptSelectPen, ptSelectRect, ptSelectEllipse, ptSelectPoly, ptSelectSpline,
  19. ptMoveSelection, ptRotateSelection, ptMagicWand, ptDeformation, ptTextureMapping, ptLayerMapping,
  20. ptText);
  21. const
  22. PaintToolTypeStr : array[TPaintToolType] of string = ('Hand','HotSpot', 'MoveLayer','RotateLayer','ZoomLayer',
  23. 'Pen', 'Brush', 'Clone', 'ColorPicker', 'Eraser',
  24. 'EditShape', 'Rect', 'Ellipse', 'Polygon', 'Spline', 'Polyline', 'OpenedCurve',
  25. 'FloodFill', 'Gradient', 'Phong',
  26. 'SelectPen', 'SelectRect', 'SelectEllipse', 'SelectPoly', 'SelectSpline',
  27. 'MoveSelection', 'RotateSelection', 'MagicWand', 'Deformation', 'TextureMapping', 'LayerMapping',
  28. 'Text');
  29. function StrToPaintToolType(const s: ansistring): TPaintToolType;
  30. type
  31. TContextualToolbar = (ctPenFill, ctPenWidth, ctPenStyle, ctJoinStyle, ctLineCap,
  32. ctCloseShape, ctSplineStyle, ctShape, ctRatio, ctBackFill,
  33. ctBrush, ctEraserOption, ctAliasing, ctTolerance, ctDeformation, ctPerspective,
  34. ctText, ctOutlineWidth, ctOutlineFill, ctTextShadow, ctPhong, ctAltitude);
  35. TContextualToolbars = set of TContextualToolbar;
  36. type
  37. TToolManager = class;
  38. TBitmapToVirtualScreenFunction = function(PtF: TPointF): TPointF of object;
  39. TEraserMode = (emEraseAlpha, emSharpen, emSoften, emLighten, emDarken);
  40. TToolCommand = (tcCut, tcCopy, tcPaste, tcDelete, tcFinish, tcMoveUp, tcMoveDown, tcMoveToFront, tcMoveToBack,
  41. tcAlignLeft, tcCenterHorizontally, tcAlignRight, tcAlignTop, tcCenterVertically, tcAlignBottom,
  42. tcShapeToSpline, tcForeAdjustToShape, tcBackAdjustToShape, tcOutlineAdjustToShape,
  43. tcForeEditGradTexPoints, tcBackEditGradTexPoints, tcOutlineEditGradTexPoints);
  44. TDeformationGridMode = (gmDeform, gmMovePointWithoutDeformation);
  45. const
  46. MaxPenWidth = 999.9;
  47. MinPenWidth = 1;
  48. MaxArrowSize = 9.9;
  49. MinArrowSize = 1;
  50. MaxBrushSpacing = 99;
  51. MinPhongShapeAltitude = 1;
  52. MaxPhongShapeAltitude = 100;
  53. MinPhongBorderSize = 1;
  54. MaxPhongBorderSize = 100;
  55. MinDeformationGridSize = 3;
  56. function GradientInterpolationToDisplay(AValue: TBGRAColorInterpolation): string;
  57. function DisplayToGradientInterpolation(AValue: string): TBGRAColorInterpolation;
  58. type
  59. TLayerKind = (lkUnknown, lkEmpty, lkBitmap, lkTransformedBitmap, lkGradient, lkVectorial, lkSVG, lkOther);
  60. { TGenericTool }
  61. TGenericTool = class
  62. private
  63. FShiftState: TShiftState;
  64. FAction: TLayerAction;
  65. FForeFill, FBackFill: TVectorialFill;
  66. FBackFillScan, FForeFillScan: TBGRACustomScanner;
  67. function GetUniversalBrush(ASource: TVectorialFill; var ADest: TVectorialFill; var AScan: TBGRACustomScanner): TUniversalBrush;
  68. function GetLayerOffset: TPoint;
  69. protected
  70. FManager: TToolManager;
  71. FLastToolDrawingLayer: TBGRABitmap;
  72. FValidating, FCanceling: boolean;
  73. function GetAction: TLayerAction; virtual;
  74. function GetIdleAction: TLayerAction; virtual;
  75. function GetIsSelectingTool: boolean; virtual; abstract;
  76. function FixSelectionTransform: boolean; virtual;
  77. function FixLayerOffset: boolean; virtual;
  78. function DoToolDown(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF; rightBtn: boolean): TRect; virtual;
  79. function DoToolMove(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF): TRect; virtual;
  80. function DoToolKeyDown(var key: Word): TRect; virtual;
  81. function DoToolKeyUp(var key: Word): TRect; virtual;
  82. function DoToolUpdate({%H-}toolDest: TBGRABitmap): TRect; virtual;
  83. procedure OnTryStop({%H-}sender: TCustomLayerAction); virtual;
  84. function SelectionMaxPointDistance: single;
  85. function GetStatusText: string; virtual;
  86. function DoGetToolDrawingLayer: TBGRABitmap; virtual;
  87. function GetCurrentLayerKind: TLayerKind;
  88. function GetIsForeEditGradTexPoints: boolean; virtual;
  89. function GetIsBackEditGradTexPoints: boolean; virtual;
  90. function GetIsOutlineEditGradTexPoints: boolean; virtual;
  91. function GetAllowedBackFillTypes: TVectorialFillTypes; virtual;
  92. function GetAllowedForeFillTypes: TVectorialFillTypes; virtual;
  93. function GetAllowedOutlineFillTypes: TVectorialFillTypes; virtual;
  94. property ShiftState: TShiftState read FShiftState;
  95. public
  96. ToolUpdateNeeded: boolean;
  97. Cursor: TCursor;
  98. constructor Create(AManager: TToolManager); virtual;
  99. destructor Destroy; override;
  100. function GetForeUniversalBrush: TUniversalBrush;
  101. function GetBackUniversalBrush: TUniversalBrush;
  102. procedure ReleaseUniversalBrushes; virtual;
  103. procedure ValidateAction;
  104. procedure ValidateActionPartially;
  105. procedure CancelAction;
  106. procedure CancelActionPartially;
  107. function HasPen: boolean; virtual;
  108. function ToolUpdate: TRect;
  109. function ToolDown(X,Y: single; rightBtn: boolean): TRect;
  110. function ToolMove(X,Y: single): TRect;
  111. function ToolKeyDown(var key: Word): TRect;
  112. function ToolKeyUp(var key: Word): TRect;
  113. function ToolKeyPress(var key: TUTF8Char): TRect; virtual;
  114. function ToolUp: TRect; virtual;
  115. function ToolCommand({%H-}ACommand: TToolCommand): boolean; virtual;
  116. function ToolProvideCommand({%H-}ACommand: TToolCommand): boolean; virtual;
  117. function SuggestGradientBox: TAffineBox; virtual;
  118. function GetContextualToolbars: TContextualToolbars; virtual;
  119. function GetToolDrawingLayer: TBGRABitmap;
  120. procedure RestoreBackupDrawingLayer;
  121. function GetBackupLayerIfExists: TBGRABitmap;
  122. function Render(VirtualScreen: TBGRABitmap; VirtualScreenWidth, VirtualScreenHeight: integer; BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect; virtual;
  123. property Manager : TToolManager read FManager;
  124. property IsSelectingTool: boolean read GetIsSelectingTool;
  125. property Action : TLayerAction read GetAction;
  126. property LayerOffset : TPoint read GetLayerOffset;
  127. property LastToolDrawingLayer: TBGRABitmap read FLastToolDrawingLayer;
  128. property StatusText: string read GetStatusText;
  129. property Validating: boolean read FValidating;
  130. property Canceling: boolean read FCanceling;
  131. property ForeUniversalBrush: TUniversalBrush read GetForeUniversalBrush;
  132. property IsForeEditGradTexPoints: boolean read GetIsForeEditGradTexPoints;
  133. property IsBackEditGradTexPoints: boolean read GetIsBackEditGradTexPoints;
  134. property IsOutlineEditGradTexPoints: boolean read GetIsOutlineEditGradTexPoints;
  135. property AllowedForeFillTypes: TVectorialFillTypes read GetAllowedForeFillTypes;
  136. property AllowedBackFillTypes: TVectorialFillTypes read GetAllowedBackFillTypes;
  137. property AllowedOutlineFillTypes: TVectorialFillTypes read GetAllowedOutlineFillTypes;
  138. end;
  139. { TReadonlyTool }
  140. TReadonlyTool = class(TGenericTool)
  141. protected
  142. function GetAction: TLayerAction; override;
  143. function GetIsSelectingTool: boolean; override;
  144. function DoGetToolDrawingLayer: TBGRABitmap; override;
  145. end;
  146. TToolClass = class of TGenericTool;
  147. TToolPopupMessage= (tpmNone, tpmHoldKeyForSquare, tpmHoldKeySnapToPixel,
  148. tpmReturnValides, tpmBackspaceRemoveLastPoint, tpmHoldKeyRestrictRotation,
  149. tpmHoldKeysScaleMode, tpmCurveModeHint, tpmBlendOpBackground,
  150. tpmRightClickForSource, tpmNothingToBeDeformed);
  151. TOnToolChangedHandler = procedure(sender: TToolManager; ANewToolType: TPaintToolType) of object;
  152. TOnPopupToolHandler = procedure(sender: TToolManager; APopupMessage: TToolPopupMessage; AKey: Word) of object;
  153. TShapeOption = (toAliasing, toDrawShape, toFillShape, toCloseShape);
  154. TShapeOptions = set of TShapeOption;
  155. TFloodFillOption = (ffProgressive, ffFillAll);
  156. TFloodFillOptions = set of TFloodFillOption;
  157. TPerspectiveOption = (poRepeat, poTwoPlanes);
  158. TPerspectiveOptions = set of TPerspectiveOption;
  159. { TToolManager }
  160. TToolManager = class
  161. private
  162. FConfigProvider: IConfigProvider;
  163. FShouldExitTool: boolean;
  164. FImage: TLazPaintImage;
  165. FBlackAndWhite: boolean;
  166. FScriptContext: TScriptContext;
  167. FToolPressure: single;
  168. FInTool, FInToolUpdate, FInSwapFill: boolean;
  169. FCurrentTool : TGenericTool;
  170. FCurrentToolType : TPaintToolType;
  171. FToolCurrentCursorPos: TPointF;
  172. FSleepingTool: TGenericTool;
  173. FSleepingToolType: TPaintToolType;
  174. FReturnValidatesHintShown: boolean;
  175. FOnToolChangedHandler: TOnToolChangedHandler;
  176. FOnToolRenderChanged: TNotifyEvent;
  177. FOnToolbarChanged: TNotifyEvent;
  178. FOnPopupToolHandler: TOnPopupToolHandler;
  179. FForeFill, FBackFill, FOutlineFill: TVectorialFill;
  180. FForeLastGradient, FBackLastGradient, FOutlineLastGradient: TBGRALayerGradientOriginal;
  181. FEraserMode: TEraserMode;
  182. FEraserAlpha: byte;
  183. FBrushInfoList: TList;
  184. FBrushInfoListChanged: boolean;
  185. FBrushIndex: integer;
  186. FBrushSpacing: integer;
  187. FPenStyle: TPenStyle;
  188. FJoinStyle: TPenJoinStyle;
  189. FNormalPenWidth, FEraserWidth: Single;
  190. FShapeOptions: TShapeOptions;
  191. FTextFontName: string;
  192. FTextFontSize: single;
  193. FTextFontStyle: TFontStyles;
  194. FTextAlign: TAlignment;
  195. FTextOutline: boolean;
  196. FTextOutlineWidth: single;
  197. FTextPhong: boolean;
  198. FLightPosition: TPointF;
  199. FLightAltitude: integer;
  200. FTextShadow: boolean;
  201. FTextShadowBlurRadius: single;
  202. FTextShadowOffset: TPoint;
  203. FLineCap: TPenEndCap;
  204. FArrowStart,FArrowEnd: TArrowKind;
  205. FArrowSize: TPointF;
  206. FSplineStyle: TSplineStyle;
  207. FPhongShapeAltitude: integer;
  208. FPhongShapeBorderSize: integer;
  209. FPhongShapeKind: TPhongShapeKind;
  210. FDeformationGridNbX,FDeformationGridNbY: integer;
  211. FDeformationGridMode: TDeformationGridMode;
  212. FTolerance: byte;
  213. FFloodFillOptions: TFloodFillOptions;
  214. FPerspectiveOptions: TPerspectiveOptions;
  215. FShapeRatio: Single;
  216. FOnFillChanged: TNotifyEvent;
  217. FOnEraserChanged: TNotifyEvent;
  218. FOnJoinStyleChanged: TNotifyEvent;
  219. FOnLineCapChanged: TNotifyEvent;
  220. FOnPenStyleChanged: TNotifyEvent;
  221. FOnPenWidthChanged: TNotifyEvent;
  222. FOnBrushChanged, FOnBrushListChanged: TNotifyEvent;
  223. FOnPhongShapeChanged: TNotifyEvent;
  224. FOnSplineStyleChanged: TNotifyEvent;
  225. FOnTextFontChanged, FOnTextAlignChanged: TNotifyEvent;
  226. FOnTextOutlineChanged: TNotifyEvent;
  227. FOnTextPhongChanged, FOnLightChanged: TNotifyEvent;
  228. FOnTextShadowChanged: TNotifyEvent;
  229. FOnShapeOptionChanged, FOnShapeRatioChanged: TNotifyEvent;
  230. FOnDeformationGridChanged: TNotifyEvent;
  231. FOnToleranceChanged: TNotifyEvent;
  232. FOnFloodFillOptionChanged: TNotifyEvent;
  233. FOnPerspectiveOptionChanged: TNotifyEvent;
  234. procedure FillChange(ASender: TObject;
  235. var {%H-}ADiff: TCustomVectorialFillDiff);
  236. function GetAllowedBackFillTypes: TVectorialFillTypes;
  237. function GetAllowedForeFillTypes: TVectorialFillTypes;
  238. function GetAllowedOutlineFillTypes: TVectorialFillTypes;
  239. function GetCursor: TCursor;
  240. function GetBackColor: TBGRAPixel;
  241. function GetBrushAt(AIndex: integer): TLazPaintBrush;
  242. function GetBrushCount: integer;
  243. function GetBrushInfo: TLazPaintBrush;
  244. function GetForeColor: TBGRAPixel;
  245. function GetMaxDeformationGridSize: TSize;
  246. function GetOutlineColor: TBGRAPixel;
  247. function GetShapeOptionAliasing: boolean;
  248. function GetPenWidth: single;
  249. function GetToolSleeping: boolean;
  250. function GetTextFontName: string;
  251. function GetTextFontSize: single;
  252. function GetTextFontStyle: TFontStyles;
  253. function ScriptGetAliasing(AVars: TVariableSet): TScriptResult;
  254. function ScriptGetArrowEnd(AVars: TVariableSet): TScriptResult;
  255. function ScriptGetArrowSize(AVars: TVariableSet): TScriptResult;
  256. function ScriptGetArrowStart(AVars: TVariableSet): TScriptResult;
  257. function ScriptGetBackColor(AVars: TVariableSet): TScriptResult;
  258. function ScriptGetOutlineColor(AVars: TVariableSet): TScriptResult;
  259. function ScriptGetBrushCount(AVars: TVariableSet): TScriptResult;
  260. function ScriptGetBrushIndex(AVars: TVariableSet): TScriptResult;
  261. function ScriptGetBrushSpacing(AVars: TVariableSet): TScriptResult;
  262. function ScriptGetDeformationGridMode(AVars: TVariableSet): TScriptResult;
  263. function ScriptGetDeformationGridSize(AVars: TVariableSet): TScriptResult;
  264. function ScriptGetEraserAlpha(AVars: TVariableSet): TScriptResult;
  265. function ScriptGetEraserMode(AVars: TVariableSet): TScriptResult;
  266. function ScriptGetFloodFillOptions(AVars: TVariableSet): TScriptResult;
  267. function ScriptGetFontName(AVars: TVariableSet): TScriptResult;
  268. function ScriptGetFontSize(AVars: TVariableSet): TScriptResult;
  269. function ScriptGetFontStyle(AVars: TVariableSet): TScriptResult;
  270. function ScriptGetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  271. function ScriptGetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  272. function ScriptGetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  273. function ScriptGetGradientColors(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  274. function ScriptGetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
  275. function ScriptGetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
  276. function ScriptGetBackGradientType(AVars: TVariableSet): TScriptResult;
  277. function ScriptGetBackGradientColors(AVars: TVariableSet): TScriptResult;
  278. function ScriptGetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
  279. function ScriptGetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
  280. function ScriptGetForeGradientType(AVars: TVariableSet): TScriptResult;
  281. function ScriptGetForeGradientColors(AVars: TVariableSet): TScriptResult;
  282. function ScriptGetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
  283. function ScriptGetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
  284. function ScriptGetOutlineGradientType(AVars: TVariableSet): TScriptResult;
  285. function ScriptGetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
  286. function ScriptGetTextureRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  287. function ScriptGetTextureOpacity(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  288. function ScriptGetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
  289. function ScriptGetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
  290. function ScriptGetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
  291. function ScriptGetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
  292. function ScriptGetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
  293. function ScriptGetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
  294. function ScriptGetJoinStyle(AVars: TVariableSet): TScriptResult;
  295. function ScriptGetLightPosition(AVars: TVariableSet): TScriptResult;
  296. function ScriptGetLineCap(AVars: TVariableSet): TScriptResult;
  297. function ScriptGetForeColor(AVars: TVariableSet): TScriptResult;
  298. function ScriptGetPenStyle(AVars: TVariableSet): TScriptResult;
  299. function ScriptGetPenWidth(AVars: TVariableSet): TScriptResult;
  300. function ScriptGetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
  301. function ScriptGetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
  302. function ScriptGetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
  303. function ScriptGetPhongShapeKind(AVars: TVariableSet): TScriptResult;
  304. function ScriptGetShapeOptions(AVars: TVariableSet): TScriptResult;
  305. function ScriptGetShapeRatio(AVars: TVariableSet): TScriptResult;
  306. function ScriptGetSplineStyle(AVars: TVariableSet): TScriptResult;
  307. function ScriptGetTextAlign(AVars: TVariableSet): TScriptResult;
  308. function ScriptGetTextOutline(AVars: TVariableSet): TScriptResult;
  309. function ScriptGetTextPhong(AVars: TVariableSet): TScriptResult;
  310. function ScriptGetTolerance(AVars: TVariableSet): TScriptResult;
  311. function ScriptSetAliasing(AVars: TVariableSet): TScriptResult;
  312. function ScriptSetArrowEnd(AVars: TVariableSet): TScriptResult;
  313. function ScriptSetArrowSize(AVars: TVariableSet): TScriptResult;
  314. function ScriptSetArrowStart(AVars: TVariableSet): TScriptResult;
  315. function ScriptSetBackColor(AVars: TVariableSet): TScriptResult;
  316. function ScriptSetOutlineColor(AVars: TVariableSet): TScriptResult;
  317. function ScriptSetBrushIndex(AVars: TVariableSet): TScriptResult;
  318. function ScriptSetBrushSpacing(AVars: TVariableSet): TScriptResult;
  319. function ScriptSetDeformationGridMode(AVars: TVariableSet): TScriptResult;
  320. function ScriptSetDeformationGridSize(AVars: TVariableSet): TScriptResult;
  321. function ScriptSetEraserAlpha(AVars: TVariableSet): TScriptResult;
  322. function ScriptSetEraserMode(AVars: TVariableSet): TScriptResult;
  323. function ScriptSetFloodFillOptions(AVars: TVariableSet): TScriptResult;
  324. function ScriptSetFontName(AVars: TVariableSet): TScriptResult;
  325. function ScriptSetFontSize(AVars: TVariableSet): TScriptResult;
  326. function ScriptSetFontStyle(AVars: TVariableSet): TScriptResult;
  327. function ScriptSetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  328. function ScriptSetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  329. function ScriptSetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  330. function ScriptSetGradientColors(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  331. function ScriptSetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
  332. function ScriptSetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
  333. function ScriptSetBackGradientType(AVars: TVariableSet): TScriptResult;
  334. function ScriptSetBackGradientColors(AVars: TVariableSet): TScriptResult;
  335. function ScriptSetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
  336. function ScriptSetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
  337. function ScriptSetOutlineGradientType(AVars: TVariableSet): TScriptResult;
  338. function ScriptSetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
  339. function ScriptSetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
  340. function ScriptSetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
  341. function ScriptSetForeGradientType(AVars: TVariableSet): TScriptResult;
  342. function ScriptSetForeGradientColors(AVars: TVariableSet): TScriptResult;
  343. function ScriptSetTexture(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  344. function ScriptSetTextureRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  345. function ScriptSetTextureOpacity(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  346. function ScriptSetBackTexture(AVars: TVariableSet): TScriptResult;
  347. function ScriptSetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
  348. function ScriptSetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
  349. function ScriptSetForeTexture(AVars: TVariableSet): TScriptResult;
  350. function ScriptSetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
  351. function ScriptSetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
  352. function ScriptSetOutlineTexture(AVars: TVariableSet): TScriptResult;
  353. function ScriptSetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
  354. function ScriptSetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
  355. function ScriptSetJoinStyle(AVars: TVariableSet): TScriptResult;
  356. function ScriptSetLightPosition(AVars: TVariableSet): TScriptResult;
  357. function ScriptSetLineCap(AVars: TVariableSet): TScriptResult;
  358. function ScriptSetForeColor(AVars: TVariableSet): TScriptResult;
  359. function ScriptSetPenStyle(AVars: TVariableSet): TScriptResult;
  360. function ScriptSetPenWidth(AVars: TVariableSet): TScriptResult;
  361. function ScriptSetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
  362. function ScriptSetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
  363. function ScriptSetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
  364. function ScriptSetPhongShapeKind(AVars: TVariableSet): TScriptResult;
  365. function ScriptSetShapeOptions(AVars: TVariableSet): TScriptResult;
  366. function ScriptSetShapeRatio(AVars: TVariableSet): TScriptResult;
  367. function ScriptSetSplineStyle(AVars: TVariableSet): TScriptResult;
  368. function ScriptSetTextAlign(AVars: TVariableSet): TScriptResult;
  369. function ScriptSetTextOutline(AVars: TVariableSet): TScriptResult;
  370. function ScriptSetTextPhong(AVars: TVariableSet): TScriptResult;
  371. function ScriptSetTolerance(AVars: TVariableSet): TScriptResult;
  372. procedure SetBrushIndex(AValue: integer);
  373. procedure SetBrushSpacing(AValue: integer);
  374. function SetControlsVisible(AControls: TList; AVisible: Boolean; AName: string = ''): boolean;
  375. procedure SetArrowEnd(AValue: TArrowKind);
  376. procedure SetArrowSize(AValue: TPointF);
  377. procedure SetArrowStart(AValue: TArrowKind);
  378. procedure SetBackColor(AValue: TBGRAPixel);
  379. procedure SetDeformationGridMode(AValue: TDeformationGridMode);
  380. procedure SetEraserAlpha(AValue: byte);
  381. procedure SetEraserMode(AValue: TEraserMode);
  382. procedure SetFloodFillOptions(AValue: TFloodFillOptions);
  383. procedure SetForeColor(AValue: TBGRAPixel);
  384. procedure SetJoinStyle(AValue: TPenJoinStyle);
  385. procedure SetLightAltitude(AValue: integer);
  386. procedure SetLightPosition(AValue: TPointF);
  387. procedure SetLineCap(AValue: TPenEndCap);
  388. procedure SetOutlineColor(AValue: TBGRAPixel);
  389. procedure SetPerspectiveOptions(AValue: TPerspectiveOptions);
  390. procedure SetPhongShapeAltitude(AValue: integer);
  391. procedure SetPhongShapeBorderSize(AValue: integer);
  392. procedure SetPhongShapeKind(AValue: TPhongShapeKind);
  393. procedure SetShapeOptions(AValue: TShapeOptions);
  394. procedure SetPenStyle(AValue: TPenStyle);
  395. procedure SetPenWidth(AValue: single);
  396. procedure SetShapeRatio(AValue: Single);
  397. procedure SetSplineStyle(AValue: TSplineStyle);
  398. procedure SetTextAlign(AValue: TAlignment);
  399. procedure SetTextPhong(AValue: boolean);
  400. procedure SetTextShadow(AValue: boolean);
  401. procedure SetTextShadowBlurRadius(AValue: single);
  402. procedure SetTextShadowOffset(AValue: TPoint);
  403. procedure SetTolerance(AValue: byte);
  404. procedure ToolCloseAndReopenImmediatly;
  405. protected
  406. function CheckExitTool: boolean;
  407. procedure NotifyImageOrSelectionChanged(ALayer: TBGRABitmap; ARect: TRect);
  408. procedure InternalSetCurrentToolType(tool: TPaintToolType);
  409. function InternalBitmapToVirtualScreen(PtF: TPointF): TPointF;
  410. function AddLayerOffset(ARect: TRect) : TRect;
  411. procedure RegisterScriptFunctions(ARegister: boolean);
  412. public
  413. BitmapToVirtualScreen: TBitmapToVirtualScreenFunction;
  414. PenWidthControls, AliasingControls, EraserControls, ToleranceControls,
  415. ShapeControls, PenStyleControls, JoinStyleControls, SplineStyleControls,
  416. CloseShapeControls, LineCapControls, DeformationControls,
  417. TextControls, TextShadowControls, PhongControls, AltitudeControls,
  418. PerspectiveControls,FillControls,OutlineFillControls,
  419. BrushControls, RatioControls, DonateControls: TList;
  420. constructor Create(AImage: TLazPaintImage; AConfigProvider: IConfigProvider;
  421. ABitmapToVirtualScreen: TBitmapToVirtualScreenFunction = nil;
  422. ABlackAndWhite : boolean = false;
  423. AScriptContext: TScriptContext = nil);
  424. destructor Destroy; override;
  425. procedure LoadFromConfig;
  426. procedure SaveToConfig;
  427. procedure ReloadBrushes;
  428. procedure SaveBrushes;
  429. function ApplyPressure(AColor: TBGRAPixel): TBGRAPixel;
  430. function ApplyPressure(AOpacity: byte): byte;
  431. procedure SetPressure(APressure: single);
  432. function GetPressureB: Byte;
  433. function GetCurrentToolType: TPaintToolType;
  434. function SetCurrentToolType(tool: TPaintToolType): boolean;
  435. function UpdateContextualToolbars: boolean;
  436. function ToolCanBeUsed: boolean;
  437. function ToolHasLineCap: boolean;
  438. procedure ToolWakeUp;
  439. procedure ToolSleep;
  440. function ToolDown(X,Y: single; ARightBtn: boolean; APressure: single): boolean; overload;
  441. function ToolMove(X,Y: single; APressure: single): boolean; overload;
  442. function ToolDown(ACoord: TPointF; ARightBtn: boolean; APressure: single): boolean; overload;
  443. function ToolMove(ACoord: TPointF; APressure: single): boolean; overload;
  444. function ToolKeyDown(var key: Word): boolean;
  445. function ToolKeyUp(var key: Word): boolean;
  446. function ToolKeyPress(var key: TUTF8Char): boolean;
  447. function ToolCommand(ACommand: TToolCommand): boolean; virtual;
  448. function ToolProvideCommand(ACommand: TToolCommand): boolean; virtual;
  449. function ToolUp: boolean;
  450. procedure ToolCloseDontReopen;
  451. procedure ToolOpen;
  452. function ToolUpdate: boolean;
  453. function ToolUpdateNeeded: boolean;
  454. procedure ToolPopup(AMessage: TToolPopupMessage; AKey: Word = 0);
  455. procedure HintReturnValidates;
  456. function IsSelectingTool: boolean;
  457. function DisplayFilledSelection: boolean;
  458. function IsForeEditGradTexPoints: boolean;
  459. function IsBackEditGradTexPoints: boolean;
  460. function IsOutlineEditGradTexPoints: boolean;
  461. procedure QueryExitTool;
  462. function RenderTool(formBitmap: TBGRABitmap): TRect;
  463. function GetRenderBounds(VirtualScreenWidth, VirtualScreenHeight: integer): TRect;
  464. function SuggestGradientBox: TAffineBox;
  465. function SwapToolColors: boolean;
  466. procedure NeedBackGradient;
  467. procedure NeedForeGradient;
  468. procedure AddBrush(brush: TLazPaintBrush);
  469. procedure RemoveBrushAt(index: integer);
  470. procedure SetTextFont(AName: string; ASize: single; AStyle: TFontStyles);
  471. procedure SetTextFont(AFont: TFont);
  472. procedure SetTextOutline(AEnabled: boolean; AWidth: single);
  473. function GetDeformationGridSize: TSize;
  474. procedure SetDeformationGridSize(ASize: TSize);
  475. property Image: TLazPaintImage read FImage;
  476. property Scripting: TScriptContext read FScriptContext;
  477. property BlackAndWhite: boolean read FBlackAndWhite write FBlackAndWhite;
  478. property CurrentTool: TGenericTool read FCurrentTool;
  479. property ToolCurrentCursorPos: TPointF read FToolCurrentCursorPos;
  480. property ToolSleeping: boolean read GetToolSleeping;
  481. property Cursor: TCursor read GetCursor;
  482. property ForeFill: TVectorialFill read FForeFill;
  483. property AllowedForeFillTypes: TVectorialFillTypes read GetAllowedForeFillTypes;
  484. property BackFill: TVectorialFill read FBackFill;
  485. property AllowedBackFillTypes: TVectorialFillTypes read GetAllowedBackFillTypes;
  486. property OutlineFill: TVectorialFill read FOutlineFill;
  487. property AllowedOutlineFillTypes: TVectorialFillTypes read GetAllowedOutlineFillTypes;
  488. property ForeColor: TBGRAPixel read GetForeColor write SetForeColor;
  489. property BackColor: TBGRAPixel read GetBackColor write SetBackColor;
  490. property OutlineColor: TBGRAPixel read GetOutlineColor write SetOutlineColor;
  491. property ForeLastGradient: TBGRALayerGradientOriginal read FForeLastGradient;
  492. property BackLastGradient: TBGRALayerGradientOriginal read FBackLastGradient;
  493. property OutlineLastGradient: TBGRALayerGradientOriginal read FOutlineLastGradient;
  494. property EraserMode: TEraserMode read FEraserMode write SetEraserMode;
  495. property EraserAlpha: byte read FEraserAlpha write SetEraserAlpha;
  496. property PenWidth: single read GetPenWidth write SetPenWidth;
  497. property PenStyle: TPenStyle read FPenStyle write SetPenStyle;
  498. property JoinStyle: TPenJoinStyle read FJoinStyle write SetJoinStyle;
  499. property ShapeOptions: TShapeOptions read FShapeOptions write SetShapeOptions;
  500. property ShapeOptionAliasing: boolean read GetShapeOptionAliasing;
  501. property ShapeRatio: Single read FShapeRatio write SetShapeRatio;
  502. property BrushInfo: TLazPaintBrush read GetBrushInfo;
  503. property BrushAt[AIndex: integer]: TLazPaintBrush read GetBrushAt;
  504. property BrushCount: integer read GetBrushCount;
  505. property BrushIndex: integer read FBrushIndex write SetBrushIndex;
  506. property BrushSpacing: integer read FBrushSpacing write SetBrushSpacing;
  507. property TextFontName: string read GetTextFontName;
  508. property TextFontSize: single read GetTextFontSize;
  509. property TextFontStyle: TFontStyles read GetTextFontStyle;
  510. property TextAlign: TAlignment read FTextAlign write SetTextAlign;
  511. property TextOutline: boolean read FTextOutline;
  512. property TextOutlineWidth: single read FTextOutlineWidth;
  513. property TextPhong: boolean read FTextPhong write SetTextPhong;
  514. property LightPosition: TPointF read FLightPosition write SetLightPosition;
  515. property LightAltitude: integer read FLightAltitude write SetLightAltitude;
  516. property TextShadow: boolean read FTextShadow write SetTextShadow;
  517. property TextShadowBlurRadius: single read FTextShadowBlurRadius write SetTextShadowBlurRadius;
  518. property TextShadowOffset: TPoint read FTextShadowOffset write SetTextShadowOffset;
  519. property LineCap: TPenEndCap read FLineCap write SetLineCap;
  520. property ArrowStart: TArrowKind read FArrowStart write SetArrowStart;
  521. property ArrowEnd: TArrowKind read FArrowEnd write SetArrowEnd;
  522. property ArrowSize: TPointF read FArrowSize write SetArrowSize;
  523. property SplineStyle: TSplineStyle read FSplineStyle write SetSplineStyle;
  524. property PhongShapeAltitude: integer read FPhongShapeAltitude write SetPhongShapeAltitude;
  525. property PhongShapeBorderSize: integer read FPhongShapeBorderSize write SetPhongShapeBorderSize;
  526. property PhongShapeKind: TPhongShapeKind read FPhongShapeKind write SetPhongShapeKind;
  527. property DeformationGridNbX: integer read FDeformationGridNbX;
  528. property DeformationGridNbY: integer read FDeformationGridNbY;
  529. property DeformationGridSize: TSize read GetDeformationGridSize write SetDeformationGridSize;
  530. property MaxDeformationGridSize: TSize read GetMaxDeformationGridSize;
  531. property DeformationGridMode: TDeformationGridMode read FDeformationGridMode write SetDeformationGridMode;
  532. property Tolerance: byte read FTolerance write SetTolerance;
  533. property FloodFillOptions: TFloodFillOptions read FFloodFillOptions write SetFloodFillOptions;
  534. property PerspectiveOptions: TPerspectiveOptions read FPerspectiveOptions write SetPerspectiveOptions;
  535. property OnToolChanged: TOnToolChangedHandler read FOnToolChangedHandler write FOnToolChangedHandler;
  536. property OnToolRenderChanged: TNotifyEvent read FOnToolRenderChanged write FOnToolRenderChanged;
  537. property OnToolbarChanged: TNotifyEvent read FOnToolbarChanged write FOnToolbarChanged;
  538. property OnPopup: TOnPopupToolHandler read FOnPopupToolHandler write FOnPopupToolHandler;
  539. property OnEraserChanged: TNotifyEvent read FOnEraserChanged write FOnEraserChanged;
  540. property OnFillChanged: TNotifyEvent read FOnFillChanged write FOnFillChanged;
  541. property OnPenWidthChanged: TNotifyEvent read FOnPenWidthChanged write FOnPenWidthChanged;
  542. property OnBrushChanged: TNotifyEvent read FOnBrushChanged write FOnBrushChanged;
  543. property OnBrushListChanged: TNotifyEvent read FOnBrushListChanged write FOnBrushListChanged;
  544. property OnPenStyleChanged: TNotifyEvent read FOnPenStyleChanged write FOnPenStyleChanged;
  545. property OnJoinStyleChanged: TNotifyEvent read FOnJoinStyleChanged write FOnJoinStyleChanged;
  546. property OnShapeOptionChanged: TNotifyEvent read FOnShapeOptionChanged write FOnShapeOptionChanged;
  547. property OnShapeRatioChanged: TNotifyEvent read FOnShapeRatioChanged write FOnShapeRatioChanged;
  548. property OnTextFontChanged: TNotifyEvent read FOnTextFontChanged write FOnTextFontChanged;
  549. property OnTextAlignChanged: TNotifyEvent read FOnTextAlignChanged write FOnTextAlignChanged;
  550. property OnTextOutlineChanged: TNotifyEvent read FOnTextOutlineChanged write FOnTextOutlineChanged;
  551. property OnTextPhongChanged: TNotifyEvent read FOnTextPhongChanged write FOnTextPhongChanged;
  552. property OnLightChanged: TNotifyEvent read FOnLightChanged write FOnLightChanged;
  553. property OnTextShadowChanged: TNotifyEvent read FOnTextShadowChanged write FOnTextShadowChanged;
  554. property OnLineCapChanged: TNotifyEvent read FOnLineCapChanged write FOnLineCapChanged;
  555. property OnSplineStyleChanged: TNotifyEvent read FOnSplineStyleChanged write FOnSplineStyleChanged;
  556. property OnPhongShapeChanged: TNotifyEvent read FOnPhongShapeChanged write FOnPhongShapeChanged;
  557. property OnDeformationGridChanged: TNotifyEvent read FOnDeformationGridChanged write FOnDeformationGridChanged;
  558. property OnToleranceChanged: TNotifyEvent read FOnToleranceChanged write FOnToleranceChanged;
  559. property OnFloodFillOptionChanged: TNotifyEvent read FOnFloodFillOptionChanged write FOnFloodFillOptionChanged;
  560. property OnPerspectiveOptionChanged: TNotifyEvent read FOnPerspectiveOptionChanged write FOnPerspectiveOptionChanged;
  561. end;
  562. procedure RegisterTool(ATool: TPaintToolType; AClass: TToolClass);
  563. function ToolPopupMessageToStr(AMessage :TToolPopupMessage; AKey: Word = 0): string;
  564. implementation
  565. uses UGraph, LCScaleDPI, LazPaintType, UCursors, BGRATextFX, ULoading, UResourceStrings,
  566. BGRATransform, LCVectorOriginal, BGRASVGOriginal, math, ULoadImage, LCVectorTextShapes;
  567. function StrToPaintToolType(const s: ansistring): TPaintToolType;
  568. var pt: TPaintToolType;
  569. ls: ansistring;
  570. begin
  571. result := ptHand;
  572. ls:= LowerCase(s);
  573. for pt := low(TPaintToolType) to high(TPaintToolType) do
  574. if ls = LowerCase(PaintToolTypeStr[pt]) then
  575. begin
  576. result := pt;
  577. break;
  578. end;
  579. end;
  580. function GradientInterpolationToDisplay(AValue: TBGRAColorInterpolation): string;
  581. begin
  582. case AValue of
  583. ciLinearRGB: result := rsLinearRGB;
  584. ciLinearHSLPositive: result := rsHueCW;
  585. ciLinearHSLNegative: result := rsHueCCW;
  586. ciGSBPositive: result := rsCorrectedHueCW;
  587. ciGSBNegative: result := rsCorrectedHueCCW;
  588. else
  589. result := rsRGB;
  590. end;
  591. end;
  592. function DisplayToGradientInterpolation(AValue: string): TBGRAColorInterpolation;
  593. begin
  594. if AValue=rsLinearRGB then result := ciLinearRGB else
  595. if AValue=rsHueCW then result := ciLinearHSLPositive else
  596. if AValue=rsHueCCW then result := ciLinearHSLNegative else
  597. if AValue=rsCorrectedHueCW then result := ciGSBPositive else
  598. if AValue=rsCorrectedHueCCW then result := ciGSBNegative
  599. else
  600. result := ciStdRGB;
  601. end;
  602. function GradientInterpolationToStr(AValue: TBGRAColorInterpolation): string;
  603. begin
  604. case AValue of
  605. ciStdRGB: result := 'StdRGB';
  606. ciLinearHSLPositive: result := 'LinearHSLPositive';
  607. ciLinearHSLNegative: result := 'LinearHSLNegative';
  608. ciGSBPositive: result := 'GSBPositive';
  609. ciGSBNegative: result := 'GSBNegative';
  610. else
  611. result := 'LinearRGB';
  612. end;
  613. end;
  614. function StrToGradientInterpolation(AValue: string): TBGRAColorInterpolation;
  615. begin
  616. if AValue='StdRGB' then result := ciStdRGB else
  617. if AValue='LinearHSLPositive' then result := ciLinearHSLPositive else
  618. if AValue='LinearHSLNegative' then result := ciLinearHSLNegative else
  619. if AValue='GSBPositive' then result := ciGSBPositive else
  620. if AValue='GSBNegative' then result := ciGSBNegative
  621. else
  622. result := ciLinearRGB;
  623. end;
  624. function GradientRepetitionToStr(AValue: TBGRAGradientRepetition): string;
  625. begin
  626. case AValue of
  627. grRepeat: result:= 'Repeat';
  628. grReflect: result:= 'Reflect';
  629. grSine: result:= 'Sine';
  630. else result := 'Pad';
  631. end;
  632. end;
  633. function StrToGradientRepetition(AValue: string): TBGRAGradientRepetition;
  634. begin
  635. case AValue of
  636. 'Repeat': result:= grRepeat;
  637. 'Reflect': result:= grReflect;
  638. 'Sine': result:= grSine;
  639. else result := grPad;
  640. end;
  641. end;
  642. function GradientToConfigStr(AGradient: TBGRALayerGradientOriginal): string;
  643. var
  644. vars: TVariableSet;
  645. begin
  646. vars := TVariableSet.Create('');
  647. vars.Pixels['StartColor'] := AGradient.StartColor;
  648. vars.Pixels['EndColor'] := AGradient.EndColor;
  649. vars.Strings['GradientType'] := GradientTypeStr[AGradient.GradientType];
  650. vars.Strings['ColorInterpolation'] := GradientInterpolationToStr(AGradient.ColorInterpolation);
  651. vars.Strings['Repetition'] := GradientRepetitionToStr(AGradient.Repetition);
  652. result := vars.VariablesAsString;
  653. vars.Free;
  654. end;
  655. procedure AssignGradientFromConfigStr(AGradient: TBGRALayerGradientOriginal; AValue: string);
  656. var
  657. vars: TVariableSet;
  658. begin
  659. vars := TVariableSet.Create('', AValue);
  660. if vars.IsDefined('StartColor') then AGradient.StartColor := vars.Pixels['StartColor'];
  661. if vars.IsDefined('EndColor') then AGradient.EndColor := vars.Pixels['EndColor'];
  662. if vars.IsDefined('GradientType') then AGradient.GradientType := StrToGradientType(vars.Strings['GradientType']);
  663. if vars.IsDefined('ColorInterpolation') then AGradient.ColorInterpolation := StrToGradientInterpolation(vars.Strings['ColorInterpolation']);
  664. if vars.IsDefined('Repetition') then AGradient.Repetition := StrToGradientRepetition(vars.Strings['Repetition']);
  665. vars.Free;
  666. end;
  667. var
  668. PaintTools: array[TPaintToolType] of TToolClass;
  669. procedure RegisterTool(ATool: TPaintToolType; AClass: TToolClass);
  670. begin
  671. PaintTools[ATool] := AClass;
  672. end;
  673. function ReplaceKey(AText: string; AKey: Word; AParam: integer = 1): string;
  674. begin
  675. if AKey = VK_SHIFT then result := StringReplace(AText, '%'+inttostr(AParam), rsShift, []) else
  676. if AKey = VK_CONTROL then result := StringReplace(AText, '%'+inttostr(AParam), {$IFDEF DARWIN}rsCmd{$ELSE}rsCtrl{$ENDIF}, []) else
  677. if AKey = VK_MENU then result := StringReplace(AText, '%'+inttostr(AParam), rsAlt, []) else
  678. result := AText;
  679. end;
  680. function ToolPopupMessageToStr(AMessage: TToolPopupMessage; AKey: Word = 0): string;
  681. begin
  682. case AMessage of
  683. tpmHoldKeyForSquare: result := ReplaceKey(rsHoldKeyForSquare, AKey);
  684. tpmHoldKeySnapToPixel: result := ReplaceKey(rsHoldKeySnapToPixel, AKey);
  685. tpmReturnValides: result := rsReturnValides;
  686. tpmBackspaceRemoveLastPoint: result := rsBackspaceRemoveLastPoint;
  687. tpmHoldKeyRestrictRotation: result := ReplaceKey(rsHoldKeyRestrictRotation, AKey);
  688. tpmHoldKeysScaleMode: result := ReplaceKey(ReplaceKey(rsHoldKeysScaleMode, AKey, 2), VK_MENU);
  689. tpmCurveModeHint: result := rsCurveModeHint;
  690. tpmBlendOpBackground: result := rsBlendOpNotUsedForBackground;
  691. tpmRightClickForSource: result := rsRightClickForSource;
  692. tpmNothingToBeDeformed: result := rsNothingToBeDeformed;
  693. else
  694. result := '';
  695. end;
  696. end;
  697. { TReadonlyTool }
  698. function TReadonlyTool.GetAction: TLayerAction;
  699. begin
  700. Result:= nil;
  701. end;
  702. function TReadonlyTool.GetIsSelectingTool: boolean;
  703. begin
  704. result := false;
  705. end;
  706. function TReadonlyTool.DoGetToolDrawingLayer: TBGRABitmap;
  707. begin
  708. if Manager.Image.SelectionMaskEmpty or not assigned(Manager.Image.SelectionLayerReadonly) then
  709. Result:= Manager.Image.CurrentLayerReadOnly
  710. else
  711. Result:= Manager.Image.SelectionLayerReadonly;
  712. end;
  713. procedure TToolManager.HintReturnValidates;
  714. begin
  715. if not FReturnValidatesHintShown then
  716. begin
  717. ToolPopup(tpmReturnValides);
  718. FReturnValidatesHintShown:= true;
  719. end;
  720. end;
  721. { TGenericTool }
  722. {$hints off}
  723. function TGenericTool.GetLayerOffset: TPoint;
  724. begin
  725. if IsSelectingTool or not Assigned(Manager.Image) then
  726. result := Point(0,0)
  727. else
  728. if GetToolDrawingLayer = Manager.Image.CurrentLayerReadOnly then
  729. result := Manager.Image.LayerOffset[Manager.Image.CurrentLayerIndex]
  730. else
  731. result := Point(0,0);
  732. end;
  733. function TGenericTool.GetUniversalBrush(ASource: TVectorialFill;
  734. var ADest: TVectorialFill; var AScan: TBGRACustomScanner): TUniversalBrush;
  735. begin
  736. FreeAndNil(AScan);
  737. FreeAndNil(ADest);
  738. case ASource.FillType of
  739. vftNone: TBGRABitmap.IdleBrush(result);
  740. vftSolid: TBGRABitmap.SolidBrush(result, Manager.ApplyPressure(ASource.SolidColor));
  741. else
  742. begin
  743. ADest := ASource.Duplicate;
  744. ADest.FitGeometry(TAffineBox.AffineBox(RectF(0,0,Manager.Image.Width,Manager.Image.Height)));
  745. ADest.ApplyOpacity(Manager.GetPressureB);
  746. AScan := ADest.CreateScanner(AffineMatrixIdentity, false);
  747. TBGRABitmap.ScannerBrush(result, AScan);
  748. end;
  749. end;
  750. end;
  751. function TGenericTool.GetAllowedBackFillTypes: TVectorialFillTypes;
  752. begin
  753. result := [vftSolid,vftGradient,vftTexture];
  754. end;
  755. function TGenericTool.GetAllowedForeFillTypes: TVectorialFillTypes;
  756. begin
  757. result := [vftSolid,vftGradient,vftTexture];
  758. end;
  759. function TGenericTool.GetAllowedOutlineFillTypes: TVectorialFillTypes;
  760. begin
  761. result := [vftSolid,vftGradient,vftTexture];
  762. end;
  763. function TGenericTool.GetIsBackEditGradTexPoints: boolean;
  764. begin
  765. result := false;
  766. end;
  767. function TGenericTool.GetIsOutlineEditGradTexPoints: boolean;
  768. begin
  769. result := false;
  770. end;
  771. function TGenericTool.GetIsForeEditGradTexPoints: boolean;
  772. begin
  773. result := false;
  774. end;
  775. function TGenericTool.GetForeUniversalBrush: TUniversalBrush;
  776. begin
  777. result := GetUniversalBrush(Manager.ForeFill, FForeFill, FForeFillScan);
  778. end;
  779. function TGenericTool.GetBackUniversalBrush: TUniversalBrush;
  780. begin
  781. result := GetUniversalBrush(Manager.BackFill, FBackFill, FBackFillScan);
  782. end;
  783. function TGenericTool.GetStatusText: string;
  784. begin
  785. result := '';
  786. end;
  787. function TGenericTool.DoGetToolDrawingLayer: TBGRABitmap;
  788. begin
  789. if Action = nil then
  790. result := nil
  791. else if IsSelectingTool then
  792. begin
  793. Action.QuerySelection;
  794. result := Action.CurrentSelection;
  795. if result = nil then
  796. raise exception.Create('Selection not created');
  797. end
  798. else
  799. result := Action.DrawingLayer;
  800. end;
  801. function TGenericTool.GetCurrentLayerKind: TLayerKind;
  802. var
  803. c: TBGRALayerOriginalAny;
  804. begin
  805. if not Manager.Image.LayerOriginalDefined[Manager.Image.CurrentLayerIndex] then
  806. begin
  807. if Manager.Image.CurrentLayerEmpty then exit(lkEmpty)
  808. else exit(lkBitmap);
  809. end else
  810. if not Manager.Image.LayerOriginalKnown[Manager.Image.CurrentLayerIndex] then
  811. exit(lkUnknown)
  812. else
  813. begin
  814. c := Manager.Image.LayerOriginalClass[Manager.Image.CurrentLayerIndex];
  815. if c = TVectorOriginal then exit(lkVectorial) else
  816. if c = TBGRALayerImageOriginal then exit(lkTransformedBitmap) else
  817. if c = TBGRALayerGradientOriginal then exit(lkGradient) else
  818. if c = TBGRALayerSVGOriginal then exit(lkSVG) else
  819. exit(lkOther);
  820. end;
  821. end;
  822. function TGenericTool.GetAction: TLayerAction;
  823. begin
  824. if not Assigned(FAction) then
  825. begin
  826. FAction := Manager.Image.CreateAction(not IsSelectingTool And Manager.Image.SelectionMaskEmpty,
  827. IsSelectingTool or not Manager.Image.SelectionMaskEmpty);
  828. FAction.OnTryStop := @OnTryStop;
  829. FAction.ChangeBoundsNotified:= true;
  830. end;
  831. result := FAction;
  832. end;
  833. function TGenericTool.GetIdleAction: TLayerAction;
  834. begin
  835. if not Assigned(FAction) then
  836. begin
  837. FAction := Manager.Image.CreateAction(false);
  838. FAction.OnTryStop := @OnTryStop;
  839. FAction.ChangeBoundsNotified:= true;
  840. end;
  841. result := FAction;
  842. end;
  843. function TGenericTool.FixSelectionTransform: boolean;
  844. begin
  845. result:= true;
  846. end;
  847. function TGenericTool.FixLayerOffset: boolean;
  848. begin
  849. result:= true;
  850. end;
  851. function TGenericTool.DoToolDown(toolDest: TBGRABitmap; pt: TPoint;
  852. ptF: TPointF; rightBtn: boolean): TRect;
  853. begin
  854. result := EmptyRect;
  855. end;
  856. {$hints on}
  857. {$hints off}
  858. function TGenericTool.DoToolMove(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF): TRect;
  859. begin
  860. result := EmptyRect;
  861. end;
  862. function TGenericTool.DoToolKeyDown(var key: Word): TRect;
  863. begin
  864. result := EmptyRect;
  865. //defined later
  866. end;
  867. function TGenericTool.DoToolKeyUp(var key: Word): TRect;
  868. begin
  869. result := EmptyRect;
  870. //defined later
  871. end;
  872. {$hints on}
  873. constructor TGenericTool.Create(AManager: TToolManager);
  874. begin
  875. inherited Create;
  876. FManager := AManager;
  877. FAction := nil;
  878. FShiftState:= [];
  879. Cursor := crDefault;
  880. end;
  881. destructor TGenericTool.Destroy;
  882. begin
  883. FAction.Free;
  884. inherited Destroy;
  885. end;
  886. procedure TGenericTool.ReleaseUniversalBrushes;
  887. begin
  888. FreeAndNil(FForeFillScan);
  889. FreeAndNil(FForeFill);
  890. FreeAndNil(FBackFillScan);
  891. FreeAndNil(FBackFill);
  892. end;
  893. procedure TGenericTool.ValidateAction;
  894. begin
  895. if Assigned(FAction) then
  896. begin
  897. FValidating := true;
  898. FAction.Validate;
  899. FValidating := false;
  900. FreeAndNil(FAction);
  901. end;
  902. end;
  903. procedure TGenericTool.ValidateActionPartially;
  904. begin
  905. if Assigned(FAction) then
  906. begin
  907. FValidating := true;
  908. FAction.PartialValidate;
  909. FValidating := false;
  910. end;
  911. end;
  912. procedure TGenericTool.CancelAction;
  913. begin
  914. if FAction <> nil then
  915. begin
  916. FCanceling := true;
  917. FreeAndNil(FAction);
  918. FCanceling := false;
  919. end;
  920. end;
  921. procedure TGenericTool.CancelActionPartially;
  922. begin
  923. if Assigned(FAction) then
  924. begin
  925. FCanceling := true;
  926. FAction.PartialCancel;
  927. FCanceling := false;
  928. end;
  929. end;
  930. function TGenericTool.HasPen: boolean;
  931. begin
  932. result := (toDrawShape in Manager.ShapeOptions) or not (ctShape in GetContextualToolbars);
  933. end;
  934. function TGenericTool.DoToolUpdate(toolDest: TBGRABitmap): TRect;
  935. begin
  936. result := EmptyRect;
  937. //nothing
  938. end;
  939. procedure TGenericTool.OnTryStop(sender: TCustomLayerAction);
  940. begin
  941. Manager.ToolCloseAndReopenImmediatly;
  942. end;
  943. function TGenericTool.SelectionMaxPointDistance: single;
  944. begin
  945. result := DoScaleX(10,OriginalDPI);
  946. result /= Manager.Image.ZoomFactor;
  947. end;
  948. function TGenericTool.ToolUpdate: TRect;
  949. var toolDest :TBGRABitmap;
  950. begin
  951. toolDest := GetToolDrawingLayer;
  952. if toolDest = nil then
  953. begin
  954. result := EmptyRect;
  955. exit;
  956. end;
  957. toolDest.JoinStyle := Manager.JoinStyle;
  958. toolDest.LineCap := Manager.LineCap;
  959. toolDest.PenStyle := Manager.PenStyle;
  960. result := DoToolUpdate(toolDest);
  961. end;
  962. function TGenericTool.ToolDown(X, Y: single; rightBtn: boolean): TRect;
  963. var
  964. toolDest: TBGRABitmap;
  965. ptF: TPointF;
  966. begin
  967. result := EmptyRect;
  968. toolDest := GetToolDrawingLayer;
  969. if toolDest = nil then exit;
  970. toolDest.JoinStyle := Manager.JoinStyle;
  971. toolDest.LineCap := Manager.LineCap;
  972. toolDest.PenStyle := Manager.PenStyle;
  973. ptF := PointF(x,y);
  974. if toolDest = Manager.Image.CurrentLayerReadOnly then
  975. begin
  976. if FixLayerOffset then
  977. begin
  978. ptF.x -= LayerOffset.x;
  979. ptF.y -= LayerOffset.y;
  980. end;
  981. end else if FixSelectionTransform and ((toolDest = Manager.Image.SelectionMaskReadonly)
  982. or (toolDest = Manager.Image.SelectionLayerReadonly)) and
  983. IsAffineMatrixInversible(Manager.Image.SelectionTransform) then
  984. ptF := AffineMatrixInverse(Manager.Image.SelectionTransform)*ptF;
  985. result := DoToolDown(toolDest,ptF.Round,ptF,rightBtn);
  986. end;
  987. function TGenericTool.ToolMove(X, Y: single): TRect;
  988. var
  989. toolDest: TBGRABitmap;
  990. ptF: TPointF;
  991. begin
  992. ptF := PointF(x,y);
  993. Manager.FToolCurrentCursorPos := ptF;
  994. result := EmptyRect;
  995. toolDest := GetToolDrawingLayer;
  996. if toolDest = nil then exit;
  997. toolDest.JoinStyle := Manager.JoinStyle;
  998. toolDest.LineCap := Manager.LineCap;
  999. toolDest.PenStyle := Manager.PenStyle;
  1000. if toolDest = Manager.Image.CurrentLayerReadOnly then
  1001. begin
  1002. if FixLayerOffset then
  1003. begin
  1004. ptF.x -= LayerOffset.x;
  1005. ptF.y -= LayerOffset.y;
  1006. end;
  1007. end else if FixSelectionTransform and ((toolDest = Manager.Image.SelectionMaskReadonly)
  1008. or (toolDest = Manager.Image.SelectionLayerReadonly)) and
  1009. IsAffineMatrixInversible(Manager.Image.SelectionTransform) then
  1010. ptF := AffineMatrixInverse(Manager.Image.SelectionTransform)*ptF;
  1011. result := DoToolMove(toolDest,ptF.Round,ptF);
  1012. end;
  1013. {$hints off}
  1014. function TGenericTool.ToolKeyDown(var key: Word): TRect;
  1015. var
  1016. key2: Word;
  1017. begin
  1018. if key = VK_SHIFT then
  1019. begin
  1020. Include(FShiftState, ssShift);
  1021. //do not reset Key to preserve typing ^o or "o
  1022. end else
  1023. if (key = VK_MENU) then
  1024. Include(FShiftState, ssAlt);
  1025. if (Key = VK_SNAP) or (Key = VK_SNAP2) then
  1026. begin
  1027. key2 := VK_CONTROL;
  1028. Include(FShiftState, ssSnap);
  1029. result := DoToolKeyDown(key2);
  1030. if key2 = 0 then key := 0;
  1031. end else
  1032. result := DoToolKeyDown(key);
  1033. end;
  1034. function TGenericTool.ToolKeyUp(var key: Word): TRect;
  1035. var
  1036. key2: word;
  1037. begin
  1038. if (key = VK_SHIFT) and (ssShift in FShiftState) then
  1039. begin
  1040. Exclude(FShiftState, ssShift);
  1041. //do not reset key to preserve typing ^o or "o
  1042. end else
  1043. if (key = VK_MENU) and (ssAlt in FShiftState) then
  1044. Exclude(FShiftState, ssAlt);
  1045. //propagate in all cases to know when keys are released for unicode input
  1046. if (Key = VK_SNAP) or (Key = VK_SNAP2) then
  1047. begin
  1048. key2 := VK_CONTROL;
  1049. Exclude(FShiftState, ssSnap);
  1050. result := DoToolKeyUp(key2);
  1051. if key2 = 0 then key := 0;
  1052. end else
  1053. result := DoToolKeyUp(key);
  1054. end;
  1055. function TGenericTool.ToolKeyPress(var key: TUTF8Char): TRect;
  1056. begin
  1057. result := EmptyRect;
  1058. //defined later
  1059. end;
  1060. {$hints on}
  1061. function TGenericTool.ToolUp: TRect;
  1062. begin
  1063. result := EmptyRect;
  1064. //defined later
  1065. end;
  1066. function TGenericTool.ToolCommand(ACommand: TToolCommand): boolean;
  1067. begin
  1068. result := false;
  1069. end;
  1070. function TGenericTool.ToolProvideCommand(ACommand: TToolCommand): boolean;
  1071. begin
  1072. result := false;
  1073. end;
  1074. function TGenericTool.SuggestGradientBox: TAffineBox;
  1075. var
  1076. m: TAffineMatrix;
  1077. begin
  1078. result := TAffineBox.AffineBox(RectF(PointF(0,0),PointF(Manager.Image.Width,Manager.Image.Height)));
  1079. if not IsSelectingTool and Manager.Image.SelectionMaskEmpty then
  1080. begin
  1081. m := Manager.Image.LayerOriginalMatrix[Manager.Image.CurrentLayerIndex];
  1082. result := AffineMatrixInverse(m)*result;
  1083. end;
  1084. end;
  1085. function TGenericTool.GetContextualToolbars: TContextualToolbars;
  1086. begin
  1087. result := [ctPenFill, ctBackFill];
  1088. end;
  1089. function TGenericTool.GetToolDrawingLayer: TBGRABitmap;
  1090. begin
  1091. result := DoGetToolDrawingLayer;
  1092. FLastToolDrawingLayer := result;
  1093. end;
  1094. procedure TGenericTool.RestoreBackupDrawingLayer;
  1095. begin
  1096. if Assigned(FAction) then
  1097. begin
  1098. if IsSelectingTool then
  1099. Action.RestoreSelectionMask
  1100. else
  1101. Action.RestoreDrawingLayer;
  1102. end;
  1103. end;
  1104. function TGenericTool.GetBackupLayerIfExists: TBGRABitmap;
  1105. begin
  1106. if Action = nil then
  1107. begin
  1108. result := nil;
  1109. exit;
  1110. end;
  1111. if IsSelectingTool then
  1112. result := Action.BackupSelection
  1113. else
  1114. result := Action.BackupDrawingLayer;
  1115. end;
  1116. {$hints off}
  1117. function TGenericTool.Render(VirtualScreen: TBGRABitmap; VirtualScreenWidth, VirtualScreenHeight: integer; BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect;
  1118. begin
  1119. result := EmptyRect;
  1120. end;
  1121. {$hints on}
  1122. { TToolManager }
  1123. function TToolManager.GetCurrentToolType: TPaintToolType;
  1124. begin
  1125. result := FCurrentToolType;
  1126. end;
  1127. function TToolManager.SetCurrentToolType(tool: TPaintToolType): boolean;
  1128. begin
  1129. if not ToolSleeping then
  1130. begin
  1131. InternalSetCurrentToolType(tool);
  1132. result := true;
  1133. end
  1134. else result := false;
  1135. end;
  1136. function TToolManager.SetControlsVisible(AControls: TList; AVisible: Boolean; AName: string): boolean;
  1137. procedure SetVisibility(AControl: TControl; AVisible: boolean);
  1138. begin
  1139. if AControl.Visible <> AVisible then
  1140. begin
  1141. AControl.Visible := AVisible;
  1142. result := true;
  1143. end;
  1144. end;
  1145. var i: integer;
  1146. begin
  1147. result := false;
  1148. if AName <> '' then
  1149. begin
  1150. for i := AControls.Count-1 downto 0 do
  1151. if (TObject(AControls[i]) as TControl).Name <> AName then
  1152. SetVisibility(TObject(AControls[i]) as TControl, False);
  1153. for i := 0 to AControls.Count-1 do
  1154. if (TObject(AControls[i]) as TControl).Name = AName then
  1155. SetVisibility(TObject(AControls[i]) as TControl, True);
  1156. end else
  1157. begin
  1158. if AVisible then
  1159. begin
  1160. for i := 0 to AControls.Count-1 do
  1161. SetVisibility(TObject(AControls[i]) as TControl, True);
  1162. end else
  1163. for i := AControls.Count-1 downto 0 do
  1164. SetVisibility(TObject(AControls[i]) as TControl, False);
  1165. end;
  1166. end;
  1167. procedure TToolManager.SetArrowEnd(AValue: TArrowKind);
  1168. begin
  1169. if FArrowEnd=AValue then Exit;
  1170. FArrowEnd:=AValue;
  1171. ToolUpdate;
  1172. if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
  1173. end;
  1174. procedure TToolManager.SetArrowSize(AValue: TPointF);
  1175. begin
  1176. if AValue.x < MinArrowSize then AValue.x := MinArrowSize;
  1177. if AValue.x > MaxArrowSize then AValue.x := MaxArrowSize;
  1178. if AValue.y < MinArrowSize then AValue.y := MinArrowSize;
  1179. if AValue.y > MaxArrowSize then AValue.y := MaxArrowSize;
  1180. if FArrowSize=AValue then Exit;
  1181. FArrowSize:=AValue;
  1182. ToolUpdate;
  1183. if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
  1184. end;
  1185. procedure TToolManager.SetArrowStart(AValue: TArrowKind);
  1186. begin
  1187. if FArrowStart=AValue then Exit;
  1188. FArrowStart:=AValue;
  1189. ToolUpdate;
  1190. if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
  1191. end;
  1192. procedure TToolManager.SetBackColor(AValue: TBGRAPixel);
  1193. begin
  1194. FBackFill.SolidColor := AValue;
  1195. end;
  1196. procedure TToolManager.SetDeformationGridMode(AValue: TDeformationGridMode);
  1197. begin
  1198. if FDeformationGridMode=AValue then Exit;
  1199. FDeformationGridMode:=AValue;
  1200. ToolUpdate;
  1201. if Assigned(FOnDeformationGridChanged) then FOnDeformationGridChanged(self);
  1202. end;
  1203. procedure TToolManager.SetEraserAlpha(AValue: byte);
  1204. begin
  1205. if FEraserAlpha=AValue then Exit;
  1206. FEraserAlpha:=AValue;
  1207. ToolUpdate;
  1208. if Assigned(FOnEraserChanged) then FOnEraserChanged(self);
  1209. end;
  1210. procedure TToolManager.SetEraserMode(AValue: TEraserMode);
  1211. begin
  1212. if FEraserMode=AValue then Exit;
  1213. FEraserMode:=AValue;
  1214. ToolUpdate;
  1215. if Assigned(FOnEraserChanged) then FOnEraserChanged(self);
  1216. end;
  1217. procedure TToolManager.SetFloodFillOptions(AValue: TFloodFillOptions);
  1218. begin
  1219. if FFloodFillOptions=AValue then Exit;
  1220. FFloodFillOptions:=AValue;
  1221. ToolUpdate;
  1222. if Assigned(FOnFloodFillOptionChanged) then FOnFloodFillOptionChanged(self);
  1223. end;
  1224. procedure TToolManager.SetForeColor(AValue: TBGRAPixel);
  1225. begin
  1226. FForeFill.SolidColor := AValue;
  1227. end;
  1228. procedure TToolManager.SetJoinStyle(AValue: TPenJoinStyle);
  1229. begin
  1230. if FJoinStyle=AValue then Exit;
  1231. FJoinStyle:=AValue;
  1232. ToolUpdate;
  1233. if Assigned(FOnJoinStyleChanged) then FOnJoinStyleChanged(self);
  1234. end;
  1235. procedure TToolManager.SetLightAltitude(AValue: integer);
  1236. begin
  1237. if FLightAltitude=AValue then Exit;
  1238. FLightAltitude:=AValue;
  1239. ToolUpdate;
  1240. if Assigned(FOnLightChanged) then FOnLightChanged(self);
  1241. end;
  1242. procedure TToolManager.SetLightPosition(AValue: TPointF);
  1243. begin
  1244. if FLightPosition=AValue then Exit;
  1245. FLightPosition:=AValue;
  1246. ToolUpdate;
  1247. if Assigned(FOnLightChanged) then FOnLightChanged(self);
  1248. end;
  1249. procedure TToolManager.SetLineCap(AValue: TPenEndCap);
  1250. begin
  1251. if FLineCap=AValue then Exit;
  1252. FLineCap:=AValue;
  1253. ToolUpdate;
  1254. if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
  1255. end;
  1256. procedure TToolManager.SetOutlineColor(AValue: TBGRAPixel);
  1257. begin
  1258. FOutlineFill.SolidColor := AValue;
  1259. end;
  1260. procedure TToolManager.SetPerspectiveOptions(AValue: TPerspectiveOptions);
  1261. begin
  1262. if FPerspectiveOptions=AValue then Exit;
  1263. FPerspectiveOptions:=AValue;
  1264. ToolUpdate;
  1265. if Assigned(FOnPerspectiveOptionChanged) then FOnPerspectiveOptionChanged(self);
  1266. end;
  1267. procedure TToolManager.SetPhongShapeAltitude(AValue: integer);
  1268. begin
  1269. if AValue < MinPhongShapeAltitude then AValue := MinPhongShapeAltitude;
  1270. if AValue > MaxPhongShapeAltitude then AValue := MaxPhongShapeAltitude;
  1271. if FPhongShapeAltitude=AValue then Exit;
  1272. FPhongShapeAltitude:=AValue;
  1273. ToolUpdate;
  1274. if Assigned(FOnPhongShapeChanged) then FOnPhongShapeChanged(self);
  1275. end;
  1276. procedure TToolManager.SetPhongShapeBorderSize(AValue: integer);
  1277. begin
  1278. if AValue < MinPhongBorderSize then AValue := MinPhongBorderSize;
  1279. if AValue > MaxPhongBorderSize then AValue := MaxPhongBorderSize;
  1280. if FPhongShapeBorderSize=AValue then Exit;
  1281. FPhongShapeBorderSize:=AValue;
  1282. ToolUpdate;
  1283. if Assigned(FOnPhongShapeChanged) then FOnPhongShapeChanged(self);
  1284. end;
  1285. procedure TToolManager.SetPhongShapeKind(AValue: TPhongShapeKind);
  1286. begin
  1287. if FPhongShapeKind=AValue then Exit;
  1288. FPhongShapeKind:=AValue;
  1289. ToolUpdate;
  1290. if Assigned(FOnPhongShapeChanged) then FOnPhongShapeChanged(self);
  1291. end;
  1292. procedure TToolManager.SetShapeOptions(AValue: TShapeOptions);
  1293. begin
  1294. if FShapeOptions=AValue then Exit;
  1295. FShapeOptions:=AValue;
  1296. ToolUpdate;
  1297. if Assigned(FOnShapeOptionChanged) then FOnShapeOptionChanged(self);
  1298. end;
  1299. procedure TToolManager.SetPenStyle(AValue: TPenStyle);
  1300. begin
  1301. if FPenStyle=AValue then Exit;
  1302. FPenStyle:=AValue;
  1303. ToolUpdate;
  1304. if Assigned(FOnPenStyleChanged) then FOnPenStyleChanged(self);
  1305. end;
  1306. procedure TToolManager.SetPenWidth(AValue: single);
  1307. begin
  1308. if AValue < MinPenWidth then AValue := MinPenWidth;
  1309. if AValue > MaxPenWidth then AValue := MaxPenWidth;
  1310. if GetCurrentToolType = ptEraser then
  1311. begin
  1312. if FEraserWidth <> AValue then
  1313. begin
  1314. FEraserWidth := AValue;
  1315. ToolUpdate;
  1316. if Assigned(FOnPenWidthChanged) then FOnPenWidthChanged(self);
  1317. end;
  1318. end else
  1319. begin
  1320. if FNormalPenWidth <> AValue then
  1321. begin
  1322. FNormalPenWidth := AValue;
  1323. ToolUpdate;
  1324. if Assigned(FOnPenWidthChanged) then FOnPenWidthChanged(self);
  1325. end;
  1326. end;
  1327. end;
  1328. procedure TToolManager.SetShapeRatio(AValue: Single);
  1329. begin
  1330. if FShapeRatio=AValue then Exit;
  1331. FShapeRatio:=AValue;
  1332. ToolUpdate;
  1333. if Assigned(FOnShapeRatioChanged) then FOnShapeRatioChanged(self);
  1334. end;
  1335. procedure TToolManager.SetSplineStyle(AValue: TSplineStyle);
  1336. begin
  1337. if FSplineStyle=AValue then Exit;
  1338. FSplineStyle:=AValue;
  1339. ToolUpdate;
  1340. if Assigned(FOnSplineStyleChanged) then FOnSplineStyleChanged(self);
  1341. end;
  1342. procedure TToolManager.SetTextAlign(AValue: TAlignment);
  1343. begin
  1344. if FTextAlign=AValue then Exit;
  1345. FTextAlign:=AValue;
  1346. ToolUpdate;
  1347. if Assigned(FOnTextAlignChanged) then FOnTextAlignChanged(self);
  1348. end;
  1349. procedure TToolManager.SetTextPhong(AValue: boolean);
  1350. begin
  1351. if FTextPhong=AValue then Exit;
  1352. FTextPhong:=AValue;
  1353. ToolUpdate;
  1354. if Assigned(FOnTextPhongChanged) then FOnTextPhongChanged(self);
  1355. end;
  1356. procedure TToolManager.SetTextShadow(AValue: boolean);
  1357. begin
  1358. if FTextShadow=AValue then Exit;
  1359. FTextShadow:=AValue;
  1360. ToolUpdate;
  1361. if Assigned(FOnTextShadowChanged) then FOnTextShadowChanged(self);
  1362. end;
  1363. procedure TToolManager.SetTextShadowBlurRadius(AValue: single);
  1364. begin
  1365. if FTextShadowBlurRadius=AValue then Exit;
  1366. FTextShadowBlurRadius:=AValue;
  1367. ToolUpdate;
  1368. if Assigned(FOnTextShadowChanged) then FOnTextShadowChanged(self);
  1369. end;
  1370. procedure TToolManager.SetTextShadowOffset(AValue: TPoint);
  1371. begin
  1372. if FTextShadowOffset=AValue then Exit;
  1373. FTextShadowOffset:=AValue;
  1374. ToolUpdate;
  1375. if Assigned(FOnTextShadowChanged) then FOnTextShadowChanged(self);
  1376. end;
  1377. procedure TToolManager.SetTolerance(AValue: byte);
  1378. begin
  1379. if FTolerance=AValue then Exit;
  1380. FTolerance:=AValue;
  1381. ToolUpdate;
  1382. if Assigned(FOnToleranceChanged) then FOnToleranceChanged(self);
  1383. end;
  1384. function TToolManager.CheckExitTool: boolean;
  1385. begin
  1386. if FShouldExitTool then
  1387. begin
  1388. FShouldExitTool:= false;
  1389. if FCurrentToolType in[ptRect,ptEllipse,ptPolygon,ptSpline,ptText,ptPhong,ptGradient] then
  1390. SetCurrentToolType(ptEditShape)
  1391. else
  1392. SetCurrentToolType(ptHand);
  1393. result := true;
  1394. end else
  1395. result := false;
  1396. end;
  1397. procedure TToolManager.NotifyImageOrSelectionChanged(ALayer: TBGRABitmap; ARect: TRect);
  1398. begin
  1399. if (CurrentTool <> nil) and not IsRectEmpty(ARect) then
  1400. begin
  1401. if Assigned(CurrentTool.FAction) then
  1402. if not IsOnlyRenderChange(ARect) then
  1403. CurrentTool.FAction.NotifyChange(ALayer, ARect);
  1404. if Assigned(ALayer) then
  1405. begin
  1406. if ALayer = Image.CurrentLayerReadOnly then
  1407. Image.ImageMayChange(AddLayerOffset(ARect))
  1408. else
  1409. Image.LayerMayChange(ALayer, ARect);
  1410. end
  1411. end;
  1412. end;
  1413. function TToolManager.ToolCanBeUsed: boolean;
  1414. begin
  1415. result := (FCurrentToolType = ptHand) or ((CurrentTool <> nil) and (CurrentTool.IsSelectingTool or Image.CurrentLayerVisible));
  1416. end;
  1417. function TToolManager.ToolHasLineCap: boolean;
  1418. var
  1419. contextualToolbars: TContextualToolbars;
  1420. begin
  1421. if CurrentTool = nil then
  1422. result := false
  1423. else
  1424. begin
  1425. contextualToolbars := CurrentTool.GetContextualToolbars;
  1426. result := (ctLineCap in contextualToolbars) and CurrentTool.HasPen and
  1427. (not (toCloseShape in ShapeOptions) or not (ctCloseShape in contextualToolbars));
  1428. end;
  1429. end;
  1430. function TToolManager.GetBackColor: TBGRAPixel;
  1431. begin
  1432. if BlackAndWhite then
  1433. result := BGRAToGrayscale(FBackFill.AverageColor)
  1434. else
  1435. result := FBackFill.AverageColor;
  1436. end;
  1437. function TToolManager.GetBrushAt(AIndex: integer): TLazPaintBrush;
  1438. begin
  1439. if (FBrushInfoList = nil) or (AIndex < 0) or (AIndex >= FBrushInfoList.Count) then
  1440. result := nil
  1441. else
  1442. result := TObject(FBrushInfoList[AIndex]) as TLazPaintBrush;
  1443. end;
  1444. function TToolManager.GetBrushCount: integer;
  1445. begin
  1446. if Assigned(FBrushInfoList) then
  1447. result := FBrushInfoList.Count
  1448. else
  1449. result := 0;
  1450. end;
  1451. function TToolManager.GetBrushInfo: TLazPaintBrush;
  1452. begin
  1453. if (FBrushIndex < 0) or (FBrushIndex > FBrushInfoList.Count) then
  1454. FBrushIndex := 0;
  1455. if FBrushIndex > FBrushInfoList.Count then
  1456. result := nil
  1457. else
  1458. result := TObject(FBrushInfoList[FBrushIndex]) as TLazPaintBrush;
  1459. end;
  1460. function TToolManager.GetCursor: TCursor;
  1461. var toolCursor: TCursor;
  1462. begin
  1463. case GetCurrentToolType of
  1464. ptHand, ptMoveSelection, ptZoomLayer: result := crSizeAll;
  1465. ptRotateSelection,ptRotateLayer: result := crCustomRotate;
  1466. ptPen,ptBrush,ptClone: result := crCustomCrosshair;
  1467. ptRect,ptEllipse,ptSelectRect,ptSelectEllipse: result := crCustomCrosshair;
  1468. ptColorPicker: result := crCustomColorPicker;
  1469. ptFloodFill: result := crCustomFloodfill;
  1470. ptSelectPen: result := crHandPoint;
  1471. ptEraser: result := crDefault;
  1472. else result := crDefault;
  1473. end;
  1474. if CurrentTool <> nil then
  1475. toolCursor := CurrentTool.Cursor
  1476. else
  1477. toolCursor := crDefault;
  1478. if toolCursor <> crDefault then result := toolCursor;
  1479. end;
  1480. procedure TToolManager.FillChange(ASender: TObject;
  1481. var ADiff: TCustomVectorialFillDiff);
  1482. begin
  1483. if FInToolUpdate or FInSwapFill then exit;
  1484. ToolUpdate;
  1485. if Assigned(FOnFillChanged) then FOnFillChanged(self);
  1486. if (ASender = FBackFill) and (FBackFill.FillType = vftGradient) then
  1487. begin
  1488. FBackLastGradient.Free;
  1489. FBackLastGradient := FBackFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
  1490. end else
  1491. if (ASender = FForeFill) and (FForeFill.FillType = vftGradient) then
  1492. begin
  1493. FForeLastGradient.Free;
  1494. FForeLastGradient := FForeFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
  1495. end else
  1496. if (ASender = FOutlineFill) and (FOutlineFill.FillType = vftGradient) then
  1497. begin
  1498. FOutlineLastGradient.Free;
  1499. FOutlineLastGradient := FOutlineFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
  1500. end;
  1501. end;
  1502. function TToolManager.GetAllowedBackFillTypes: TVectorialFillTypes;
  1503. begin
  1504. if Assigned(CurrentTool) then result := CurrentTool.AllowedBackFillTypes
  1505. else result := [vftSolid,vftGradient,vftTexture];
  1506. end;
  1507. function TToolManager.GetAllowedForeFillTypes: TVectorialFillTypes;
  1508. begin
  1509. if Assigned(CurrentTool) then result := CurrentTool.AllowedForeFillTypes
  1510. else result := [vftSolid,vftGradient,vftTexture];
  1511. end;
  1512. function TToolManager.GetAllowedOutlineFillTypes: TVectorialFillTypes;
  1513. begin
  1514. if Assigned(CurrentTool) then result := CurrentTool.AllowedOutlineFillTypes
  1515. else result := [vftSolid,vftGradient,vftTexture];
  1516. end;
  1517. function TToolManager.GetForeColor: TBGRAPixel;
  1518. begin
  1519. if BlackAndWhite then
  1520. result := BGRAToGrayscale(FForeFill.AverageColor)
  1521. else
  1522. result := FForeFill.AverageColor;
  1523. end;
  1524. function TToolManager.GetMaxDeformationGridSize: TSize;
  1525. begin
  1526. result.cx := Max(MinDeformationGridSize,Min(image.Width div 2,50)+1);
  1527. result.cy := Max(MinDeformationGridSize,Min(image.Height div 2,50)+1);
  1528. end;
  1529. function TToolManager.GetOutlineColor: TBGRAPixel;
  1530. begin
  1531. if BlackAndWhite then
  1532. result := BGRAToGrayscale(FOutlineFill.AverageColor)
  1533. else
  1534. result := FOutlineFill.AverageColor;
  1535. end;
  1536. function TToolManager.GetShapeOptionAliasing: boolean;
  1537. begin
  1538. result := toAliasing in FShapeOptions;
  1539. end;
  1540. function TToolManager.GetPenWidth: single;
  1541. begin
  1542. if GetCurrentToolType = ptEraser then
  1543. result := FEraserWidth else result := FNormalPenWidth;
  1544. end;
  1545. function TToolManager.GetToolSleeping: boolean;
  1546. begin
  1547. result := FSleepingTool <> nil;
  1548. end;
  1549. function TToolManager.GetTextFontName: string;
  1550. begin
  1551. result := FTextFontName;
  1552. end;
  1553. function TToolManager.GetTextFontSize: single;
  1554. begin
  1555. result := FTextFontSize;
  1556. end;
  1557. function TToolManager.GetTextFontStyle: TFontStyles;
  1558. begin
  1559. result := FTextFontStyle;
  1560. end;
  1561. function TToolManager.ScriptGetAliasing(AVars: TVariableSet): TScriptResult;
  1562. begin
  1563. AVars.Booleans['Result'] := toAliasing in ShapeOptions;
  1564. result := srOk;
  1565. end;
  1566. function TToolManager.ScriptGetArrowEnd(AVars: TVariableSet): TScriptResult;
  1567. begin
  1568. AVars.Strings['Result'] := CSSToPascalCase(ArrowKindToStr[ArrowEnd]);
  1569. result := srOk;
  1570. end;
  1571. function TToolManager.ScriptGetArrowSize(AVars: TVariableSet): TScriptResult;
  1572. begin
  1573. AVars.Points2D['Result'] := ArrowSize;
  1574. result := srOk;
  1575. end;
  1576. function TToolManager.ScriptGetArrowStart(AVars: TVariableSet): TScriptResult;
  1577. begin
  1578. AVars.Strings['Result'] := CSSToPascalCase(ArrowKindToStr[ArrowStart]);
  1579. result := srOk;
  1580. end;
  1581. function TToolManager.ScriptGetBackColor(AVars: TVariableSet): TScriptResult;
  1582. begin
  1583. AVars.Pixels['Result'] := BackColor;
  1584. result := srOk;
  1585. end;
  1586. function TToolManager.ScriptGetOutlineColor(AVars: TVariableSet): TScriptResult;
  1587. begin
  1588. AVars.Pixels['Result'] := OutlineColor;
  1589. result := srOk;
  1590. end;
  1591. function TToolManager.ScriptGetBrushCount(AVars: TVariableSet): TScriptResult;
  1592. begin
  1593. AVars.Integers['Result'] := BrushCount;
  1594. result := srOk;
  1595. end;
  1596. function TToolManager.ScriptGetBrushIndex(AVars: TVariableSet): TScriptResult;
  1597. begin
  1598. AVars.Integers['Result'] := BrushIndex;
  1599. result := srOk;
  1600. end;
  1601. function TToolManager.ScriptGetBrushSpacing(AVars: TVariableSet): TScriptResult;
  1602. begin
  1603. AVars.Integers['Result'] := BrushSpacing;
  1604. result := srOk;
  1605. end;
  1606. function TToolManager.ScriptGetDeformationGridMode(AVars: TVariableSet): TScriptResult;
  1607. begin
  1608. result := srOk;
  1609. case DeformationGridMode of
  1610. gmDeform: AVars.Strings['Result'] := 'Deform';
  1611. gmMovePointWithoutDeformation: AVars.Strings['Result'] := 'MovePointWithoutDeformation';
  1612. else result := srException;
  1613. end;
  1614. end;
  1615. function TToolManager.ScriptGetDeformationGridSize(AVars: TVariableSet): TScriptResult;
  1616. begin
  1617. result := srOk;
  1618. with DeformationGridSize do
  1619. AVars.Points2D['Result'] := PointF(cx,cy);
  1620. end;
  1621. function TToolManager.ScriptGetEraserAlpha(AVars: TVariableSet): TScriptResult;
  1622. begin
  1623. AVars.Integers['Result'] := EraserAlpha;
  1624. result := srOk;
  1625. end;
  1626. function TToolManager.ScriptGetEraserMode(AVars: TVariableSet): TScriptResult;
  1627. begin
  1628. result := srOk;
  1629. case EraserMode of
  1630. emEraseAlpha: AVars.Strings['Result'] := 'EraseAlpha';
  1631. emSharpen: AVars.Strings['Result'] := 'Sharpen';
  1632. emSoften: AVars.Strings['Result'] := 'Soften';
  1633. emLighten: AVars.Strings['Result'] := 'Lighten';
  1634. emDarken: AVars.Strings['Result'] := 'Darken';
  1635. else result := srException;
  1636. end;
  1637. end;
  1638. function TToolManager.ScriptGetFloodFillOptions(AVars: TVariableSet): TScriptResult;
  1639. var
  1640. optionsVar: TScriptVariableReference;
  1641. option: TFloodFillOption;
  1642. begin
  1643. optionsVar := AVars.AddStringList('Result');
  1644. for option := low(TFloodFillOption) to high(TFloodFillOption) do
  1645. if option in FloodFillOptions then
  1646. case option of
  1647. ffProgressive: AVars.AppendString(optionsVar, 'Progressive');
  1648. ffFillAll: Avars.AppendString(optionsVar, 'FillAll');
  1649. end;
  1650. result := srOk;
  1651. end;
  1652. function TToolManager.ScriptGetFontName(AVars: TVariableSet): TScriptResult;
  1653. begin
  1654. AVars.Strings['Name'] := TextFontName;
  1655. result := srOk;
  1656. end;
  1657. function TToolManager.ScriptGetFontSize(AVars: TVariableSet): TScriptResult;
  1658. begin
  1659. AVars.Floats['Result'] := TextFontSize;
  1660. result := srOk;
  1661. end;
  1662. function TToolManager.ScriptGetFontStyle(AVars: TVariableSet): TScriptResult;
  1663. var
  1664. styles: TScriptVariableReference;
  1665. style: TFontStyle;
  1666. begin
  1667. styles := AVars.AddStringList('Result');
  1668. for style := low(TFontStyle) to high(TFontStyle) do
  1669. if style in TextFontStyle then
  1670. case style of
  1671. fsBold: AVars.AppendString(styles, 'Bold');
  1672. fsItalic: Avars.AppendString(styles, 'Italic');
  1673. fsUnderline: Avars.AppendString(styles, 'Underline');
  1674. fsStrikeOut: Avars.AppendString(styles, 'StrikeOut');
  1675. end;
  1676. result := srOk;
  1677. end;
  1678. function TToolManager.ScriptGetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  1679. begin
  1680. result := srOk;
  1681. if AFill.FillType <> vftGradient then result := srException else
  1682. AVars.Strings['Result'] := GradientInterpolationToStr(AFill.Gradient.ColorInterpolation);
  1683. end;
  1684. function TToolManager.ScriptGetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  1685. begin
  1686. result := srOk;
  1687. if AFill.FillType <> vftGradient then result := srException else
  1688. AVars.Strings['Result'] := GradientRepetitionToStr(AFill.Gradient.Repetition);
  1689. end;
  1690. function TToolManager.ScriptGetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  1691. begin
  1692. result := srOk;
  1693. if AFill.FillType <> vftGradient then result := srException else
  1694. AVars.Strings['Result'] := GradientTypeStr[AFill.Gradient.GradientType];
  1695. end;
  1696. function TToolManager.ScriptGetGradientColors(AVars: TVariableSet;
  1697. AFill: TVectorialFill): TScriptResult;
  1698. var
  1699. colors: TScriptVariableReference;
  1700. begin
  1701. result := srOk;
  1702. if AFill.FillType <> vftGradient then result := srException else
  1703. begin
  1704. colors := AVars.AddPixelList('Result');
  1705. TVariableSet.AppendPixel(colors, AFill.Gradient.StartColor);
  1706. TVariableSet.AppendPixel(colors, AFill.Gradient.EndColor);
  1707. end;
  1708. end;
  1709. function TToolManager.ScriptGetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
  1710. begin
  1711. result := ScriptGetGradientInterpolation(AVars, FBackFill);
  1712. end;
  1713. function TToolManager.ScriptGetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
  1714. begin
  1715. result := ScriptGetGradientRepetition(AVars, FBackFill);
  1716. end;
  1717. function TToolManager.ScriptGetBackGradientType(AVars: TVariableSet): TScriptResult;
  1718. begin
  1719. result := ScriptGetGradientType(AVars, FBackFill);
  1720. end;
  1721. function TToolManager.ScriptGetBackGradientColors(AVars: TVariableSet): TScriptResult;
  1722. begin
  1723. result := ScriptGetGradientColors(AVars, FBackFill);
  1724. end;
  1725. function TToolManager.ScriptGetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
  1726. begin
  1727. result := ScriptGetGradientInterpolation(AVars, FForeFill);
  1728. end;
  1729. function TToolManager.ScriptGetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
  1730. begin
  1731. result := ScriptGetGradientRepetition(AVars, FForeFill);
  1732. end;
  1733. function TToolManager.ScriptGetForeGradientType(AVars: TVariableSet): TScriptResult;
  1734. begin
  1735. result := ScriptGetGradientType(AVars, FForeFill);
  1736. end;
  1737. function TToolManager.ScriptGetForeGradientColors(AVars: TVariableSet): TScriptResult;
  1738. begin
  1739. result := ScriptGetGradientColors(AVars, FForeFill);
  1740. end;
  1741. function TToolManager.ScriptGetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
  1742. begin
  1743. result := ScriptGetGradientInterpolation(AVars, FOutlineFill);
  1744. end;
  1745. function TToolManager.ScriptGetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
  1746. begin
  1747. result := ScriptGetGradientRepetition(AVars, FOutlineFill);
  1748. end;
  1749. function TToolManager.ScriptGetOutlineGradientType(AVars: TVariableSet): TScriptResult;
  1750. begin
  1751. result := ScriptGetGradientType(AVars, FOutlineFill);
  1752. end;
  1753. function TToolManager.ScriptGetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
  1754. begin
  1755. result := ScriptGetGradientColors(AVars, FOutlineFill);
  1756. end;
  1757. function TToolManager.ScriptGetTextureRepetition(AVars: TVariableSet;
  1758. AFill: TVectorialFill): TScriptResult;
  1759. begin
  1760. if AFill.FillType <> vftTexture then exit(srException);
  1761. result := srOk;
  1762. case AFill.TextureRepetition of
  1763. trNone: AVars.Strings['Result'] := 'None';
  1764. trRepeatX: AVars.Strings['Result'] := 'RepeatX';
  1765. trRepeatY: AVars.Strings['Result'] := 'RepeatY';
  1766. trRepeatBoth: AVars.Strings['Result'] := 'RepeatBoth';
  1767. else
  1768. result := srException;
  1769. end;
  1770. end;
  1771. function TToolManager.ScriptGetTextureOpacity(AVars: TVariableSet;
  1772. AFill: TVectorialFill): TScriptResult;
  1773. begin
  1774. if AFill.FillType <> vftTexture then exit(srException);
  1775. AVars.Integers['Result'] := AFill.TextureOpacity;
  1776. result := srOk;
  1777. end;
  1778. function TToolManager.ScriptGetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
  1779. begin
  1780. result := ScriptGetTextureRepetition(AVars, BackFill);
  1781. end;
  1782. function TToolManager.ScriptGetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
  1783. begin
  1784. result := ScriptGetTextureOpacity(AVars, BackFill);
  1785. end;
  1786. function TToolManager.ScriptGetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
  1787. begin
  1788. result := ScriptGetTextureRepetition(AVars, ForeFill);
  1789. end;
  1790. function TToolManager.ScriptGetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
  1791. begin
  1792. result := ScriptGetTextureOpacity(AVars, ForeFill);
  1793. end;
  1794. function TToolManager.ScriptGetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
  1795. begin
  1796. result := ScriptGetTextureRepetition(AVars, OutlineFill);
  1797. end;
  1798. function TToolManager.ScriptGetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
  1799. begin
  1800. result := ScriptGetTextureOpacity(AVars, OutlineFill);
  1801. end;
  1802. function TToolManager.ScriptGetJoinStyle(AVars: TVariableSet): TScriptResult;
  1803. begin
  1804. result := srOk;
  1805. case JoinStyle of
  1806. pjsBevel: AVars.Strings['Result'] := 'Bevel';
  1807. pjsRound: AVars.Strings['Result'] := 'Round';
  1808. pjsMiter: AVars.Strings['Result'] := 'Miter';
  1809. else result := srException;
  1810. end;
  1811. end;
  1812. function TToolManager.ScriptGetLightPosition(AVars: TVariableSet): TScriptResult;
  1813. begin
  1814. AVars.Points2D['Result'] := LightPosition;
  1815. result := srOk;
  1816. end;
  1817. function TToolManager.ScriptGetLineCap(AVars: TVariableSet): TScriptResult;
  1818. begin
  1819. case LineCap of
  1820. pecSquare: AVars.Strings['Result'] := 'Square';
  1821. pecRound: AVars.Strings['Result'] := 'Round';
  1822. pecFlat: AVars.Strings['Result'] := 'Flat';
  1823. else exit(srException);
  1824. end;
  1825. result := srOk;
  1826. end;
  1827. function TToolManager.ScriptGetForeColor(AVars: TVariableSet): TScriptResult;
  1828. begin
  1829. AVars.Pixels['Result'] := ForeColor;
  1830. result := srOk;
  1831. end;
  1832. function TToolManager.ScriptGetPenStyle(AVars: TVariableSet): TScriptResult;
  1833. begin
  1834. result := srOk;
  1835. case PenStyle of
  1836. psSolid: AVars.Strings['Result'] := 'Solid';
  1837. psDash: AVars.Strings['Result'] := 'Dash';
  1838. psDot: AVars.Strings['Result'] := 'Dot';
  1839. psDashDot: AVars.Strings['Result'] := 'DashDot';
  1840. psDashDotDot: AVars.Strings['Result'] := 'DashDotDot';
  1841. else result := srException;
  1842. end;
  1843. end;
  1844. function TToolManager.ScriptGetPenWidth(AVars: TVariableSet): TScriptResult;
  1845. begin
  1846. AVars.Floats['Result'] := PenWidth;
  1847. result := srOk;
  1848. end;
  1849. function TToolManager.ScriptGetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
  1850. var
  1851. optionsVar: TScriptVariableReference;
  1852. option: TPerspectiveOption;
  1853. begin
  1854. optionsVar := AVars.AddStringList('Result');
  1855. for option := low(TPerspectiveOption) to high(TPerspectiveOption) do
  1856. if option in PerspectiveOptions then
  1857. case option of
  1858. poRepeat: Avars.AppendString(optionsVar, 'Repeat');
  1859. poTwoPlanes: Avars.AppendString(optionsVar, 'TwoPlanes');
  1860. end;
  1861. result := srOk;
  1862. end;
  1863. function TToolManager.ScriptGetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
  1864. begin
  1865. result := srOk;
  1866. AVars.Integers['Result'] := PhongShapeAltitude;
  1867. end;
  1868. function TToolManager.ScriptGetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
  1869. begin
  1870. result := srOk;
  1871. AVars.Integers['Result'] := PhongShapeBorderSize;
  1872. end;
  1873. function TToolManager.ScriptGetPhongShapeKind(AVars: TVariableSet): TScriptResult;
  1874. begin
  1875. result := srOk;
  1876. case PhongShapeKind of
  1877. pskRectangle: AVars.Strings['Result'] := 'Rectangle';
  1878. pskRoundRectangle: AVars.Strings['Result'] := 'RoundRectangle';
  1879. pskHalfSphere: AVars.Strings['Result'] := 'HalfSphere';
  1880. pskConeTop: AVars.Strings['Result'] := 'ConeTop';
  1881. pskConeSide: AVars.Strings['Result'] := 'ConeSide';
  1882. pskHorizCylinder: AVars.Strings['Result'] := 'HorizCylinder';
  1883. pskVertCylinder: AVars.Strings['Result'] := 'VertCylinder';
  1884. else result := srException;
  1885. end;
  1886. end;
  1887. function TToolManager.ScriptGetShapeOptions(AVars: TVariableSet): TScriptResult;
  1888. var
  1889. options: TScriptVariableReference;
  1890. opt: TShapeOption;
  1891. begin
  1892. options := AVars.AddStringList('Result');
  1893. for opt := low(TShapeOption) to high(TShapeOption) do
  1894. if opt in ShapeOptions then
  1895. case opt of
  1896. toDrawShape: Avars.AppendString(options, 'DrawShape');
  1897. toFillShape: Avars.AppendString(options, 'FillShape');
  1898. toCloseShape: Avars.AppendString(options, 'CloseShape');
  1899. end;
  1900. result := srOk;
  1901. end;
  1902. function TToolManager.ScriptGetShapeRatio(AVars: TVariableSet): TScriptResult;
  1903. begin
  1904. AVars.Floats['Result'] := ShapeRatio;
  1905. result := srOk;
  1906. end;
  1907. function TToolManager.ScriptGetSplineStyle(AVars: TVariableSet): TScriptResult;
  1908. var
  1909. s: String;
  1910. begin
  1911. case SplineStyle of
  1912. ssInside: s := 'Inside';
  1913. ssInsideWithEnds: s := 'InsideWithEnds';
  1914. ssCrossing: s := 'Crossing';
  1915. ssCrossingWithEnds: s := 'CrossingWithEnds';
  1916. ssOutside: s := 'Outside';
  1917. ssRoundOutside: s := 'RoundOutside';
  1918. ssVertexToSide: s := 'VertexToSide';
  1919. ssEasyBezier: s := 'EasyBezier';
  1920. else
  1921. exit(srException);
  1922. end;
  1923. AVars.Strings['Result'] := s;
  1924. result := srOk;
  1925. end;
  1926. function TToolManager.ScriptGetTextAlign(AVars: TVariableSet): TScriptResult;
  1927. begin
  1928. case TextAlign of
  1929. taLeftJustify: AVars.Strings['Result'] := 'Left';
  1930. taCenter: AVars.Strings['Result'] := 'Center';
  1931. taRightJustify: AVars.Strings['Result'] := 'Right';
  1932. else exit(srException);
  1933. end;
  1934. result := srOk;
  1935. end;
  1936. function TToolManager.ScriptGetTextOutline(AVars: TVariableSet): TScriptResult;
  1937. begin
  1938. if TextOutline then
  1939. AVars.Floats['Result'] := TextOutlineWidth
  1940. else
  1941. AVars.Floats['Result'] := 0;
  1942. result := srOk;
  1943. end;
  1944. function TToolManager.ScriptGetTextPhong(AVars: TVariableSet): TScriptResult;
  1945. begin
  1946. AVars.Booleans['Result'] := TextPhong;
  1947. result := srOk;
  1948. end;
  1949. function TToolManager.ScriptGetTolerance(AVars: TVariableSet): TScriptResult;
  1950. begin
  1951. AVars.Integers['Result'] := Tolerance;
  1952. result := srOk;
  1953. end;
  1954. function TToolManager.ScriptSetAliasing(AVars: TVariableSet): TScriptResult;
  1955. begin
  1956. if AVars.Booleans['Enabled'] then
  1957. ShapeOptions:= ShapeOptions + [toAliasing]
  1958. else
  1959. ShapeOptions:= ShapeOptions - [toAliasing];
  1960. result := srOk;
  1961. end;
  1962. function TToolManager.ScriptSetArrowEnd(AVars: TVariableSet): TScriptResult;
  1963. var ak: TArrowKind;
  1964. kindStr: String;
  1965. begin
  1966. kindStr := PascalToCSSCase(AVars.Strings['Kind']);
  1967. ak := StrToArrowKind(kindStr);
  1968. if (ak = akNone) and (kindStr <> ArrowKindToStr[akNone]) then
  1969. exit(srInvalidParameters);
  1970. ArrowEnd := ak;
  1971. result := srOk;
  1972. end;
  1973. function TToolManager.ScriptSetArrowSize(AVars: TVariableSet): TScriptResult;
  1974. var
  1975. s: TPointF;
  1976. begin
  1977. s := AVars.Points2D['Size'];
  1978. if isEmptyPointF(s) then exit(srInvalidParameters);
  1979. ArrowSize := s;
  1980. result := srOk;
  1981. end;
  1982. function TToolManager.ScriptSetArrowStart(AVars: TVariableSet): TScriptResult;
  1983. var ak: TArrowKind;
  1984. kindStr: String;
  1985. begin
  1986. kindStr := PascalToCSSCase(AVars.Strings['Kind']);
  1987. ak := StrToArrowKind(kindStr);
  1988. if (ak = akNone) and (kindStr <> ArrowKindToStr[akNone]) then
  1989. exit(srInvalidParameters);
  1990. ArrowStart := ak;
  1991. result := srOk;
  1992. end;
  1993. function TToolManager.ScriptSetBackColor(AVars: TVariableSet): TScriptResult;
  1994. begin
  1995. BackColor := AVars.Pixels['Color'];
  1996. result := srOk;
  1997. end;
  1998. function TToolManager.ScriptSetOutlineColor(AVars: TVariableSet): TScriptResult;
  1999. begin
  2000. OutlineColor := AVars.Pixels['Color'];
  2001. result := srOk;
  2002. end;
  2003. function TToolManager.ScriptSetBrushIndex(AVars: TVariableSet): TScriptResult;
  2004. var
  2005. index: Int64;
  2006. begin
  2007. index := AVars.Integers['Index'];
  2008. if (index < 0) or (index >= BrushCount) then exit(srException);
  2009. BrushIndex:= index;
  2010. result := srOk;
  2011. end;
  2012. function TToolManager.ScriptSetBrushSpacing(AVars: TVariableSet): TScriptResult;
  2013. begin
  2014. BrushSpacing := AVars.Integers['Spacing'];
  2015. result := srOk;
  2016. end;
  2017. function TToolManager.ScriptSetDeformationGridMode(AVars: TVariableSet): TScriptResult;
  2018. begin
  2019. result := srOk;
  2020. case AVars.Strings['Mode'] of
  2021. 'Deform': DeformationGridMode := gmDeform;
  2022. 'MovePointWithoutDeformation': DeformationGridMode := gmMovePointWithoutDeformation;
  2023. else result := srInvalidParameters;
  2024. end;
  2025. end;
  2026. function TToolManager.ScriptSetDeformationGridSize(AVars: TVariableSet): TScriptResult;
  2027. var
  2028. s: TPointF;
  2029. begin
  2030. s := AVars.Points2D['Size'];
  2031. if s.x < MinDeformationGridSize then exit(srInvalidParameters);
  2032. if s.y < MinDeformationGridSize then exit(srInvalidParameters);
  2033. DeformationGridSize := Size(round(s.x),round(s.y));
  2034. result := srOk;
  2035. end;
  2036. function TToolManager.ScriptSetEraserAlpha(AVars: TVariableSet): TScriptResult;
  2037. var
  2038. alpha: Int64;
  2039. begin
  2040. alpha := AVars.Integers['Alpha'];
  2041. if alpha < 0 then alpha := 0;
  2042. if alpha > 255 then alpha := 255;
  2043. EraserAlpha:= alpha;
  2044. result := srOk;
  2045. end;
  2046. function TToolManager.ScriptSetEraserMode(AVars: TVariableSet): TScriptResult;
  2047. begin
  2048. result := srOk;
  2049. case AVars.Strings['Mode'] of
  2050. 'EraseAlpha': EraserMode:= emEraseAlpha;
  2051. 'Soften': EraserMode := emSoften;
  2052. else result := srInvalidParameters;
  2053. end;
  2054. end;
  2055. function TToolManager.ScriptSetFloodFillOptions(AVars: TVariableSet): TScriptResult;
  2056. var optionsSet: TFloodFillOptions;
  2057. optionsVar: TScriptVariableReference;
  2058. i: Integer;
  2059. optionStr: string;
  2060. begin
  2061. optionsSet := [];
  2062. optionsVar := AVars.GetVariable('Options');
  2063. for i := 0 to AVars.GetListCount(optionsVar)-1 do
  2064. begin
  2065. optionStr := AVars.GetStringAt(optionsVar, i);
  2066. case optionStr of
  2067. 'Progressive': include(optionsSet, ffProgressive);
  2068. 'FillAll': include(optionsSet, ffFillAll);
  2069. else exit(srInvalidParameters);
  2070. end;
  2071. end;
  2072. FloodFillOptions:= optionsSet;
  2073. result := srOk;
  2074. end;
  2075. function TToolManager.ScriptSetFontName(AVars: TVariableSet): TScriptResult;
  2076. begin
  2077. SetTextFont(AVars.Strings['Name'], TextFontSize, TextFontStyle);
  2078. result := srOk;
  2079. end;
  2080. function TToolManager.ScriptSetFontSize(AVars: TVariableSet): TScriptResult;
  2081. begin
  2082. SetTextFont(TextFontName, AVars.Floats['Size'], TextFontStyle);
  2083. result := srOk;
  2084. end;
  2085. function TToolManager.ScriptSetFontStyle(AVars: TVariableSet): TScriptResult;
  2086. var style: TFontStyles;
  2087. styles: TScriptVariableReference;
  2088. i: Integer;
  2089. styleStr: string;
  2090. begin
  2091. style := [];
  2092. styles := AVars.GetVariable('Style');
  2093. for i := 0 to AVars.GetListCount(styles)-1 do
  2094. begin
  2095. styleStr := AVars.GetStringAt(styles, i);
  2096. case styleStr of
  2097. 'Bold': include(style, fsBold);
  2098. 'Italic': include(style, fsItalic);
  2099. 'Underline': include(style, fsUnderline);
  2100. 'StrikeOut': include(style, fsStrikeOut);
  2101. else exit(srInvalidParameters);
  2102. end;
  2103. end;
  2104. SetTextFont(TextFontName, TextFontSize, style);
  2105. result := srOk;
  2106. end;
  2107. function TToolManager.ScriptSetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  2108. var
  2109. ci: TBGRAColorInterpolation;
  2110. begin
  2111. if AFill.FillType <> vftGradient then exit(srException);
  2112. result := srOk;
  2113. ci := StrToGradientInterpolation(AVars.Strings['Interpolation']);
  2114. if GradientInterpolationToStr(ci) <> AVars.Strings['Interpolation'] then
  2115. result := srInvalidParameters
  2116. else AFill.Gradient.ColorInterpolation:= ci;
  2117. end;
  2118. function TToolManager.ScriptSetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  2119. var
  2120. gr: TBGRAGradientRepetition;
  2121. begin
  2122. if AFill.FillType <> vftGradient then exit(srException);
  2123. result := srOk;
  2124. gr := StrToGradientRepetition(AVars.Strings['Repetition']);
  2125. if GradientRepetitionToStr(gr) <> AVars.Strings['Repetition'] then
  2126. result := srInvalidParameters
  2127. else AFill.Gradient.Repetition:= gr;
  2128. end;
  2129. function TToolManager.ScriptSetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
  2130. var
  2131. gt: TGradientType;
  2132. b: TAffineBox;
  2133. lastGrad: TBGRALayerGradientOriginal;
  2134. begin
  2135. result := srOk;
  2136. gt := StrToGradientType(AVars.Strings['GradientType']);
  2137. if GradientTypeStr[gt] <> AVars.Strings['GradientType'] then
  2138. exit(srInvalidParameters);
  2139. if AFill.FillType = vftGradient then
  2140. AFill.Gradient.GradientType:= gt
  2141. else
  2142. begin
  2143. if AFill = BackFill then lastGrad := FBackLastGradient
  2144. else if AFill = OutlineFill then lastGrad := FOutlineLastGradient
  2145. else lastGrad := FForeLastGradient;
  2146. lastGrad.GradientType:= gt;
  2147. b := SuggestGradientBox;
  2148. if gt = gtLinear then lastGrad.Origin := b.TopLeft else
  2149. lastGrad.Origin := (b.TopLeft+b.BottomRight)*0.5;
  2150. lastGrad.XAxis := b.BottomRight;
  2151. lastGrad.YAxis := EmptyPointF;
  2152. lastGrad.FocalPoint := EmptyPointF;
  2153. lastGrad.Radius := 1;
  2154. lastGrad.FocalRadius := 0;
  2155. AFill.SetGradient(lastGrad, False);
  2156. end;
  2157. end;
  2158. function TToolManager.ScriptSetGradientColors(AVars: TVariableSet;
  2159. AFill: TVectorialFill): TScriptResult;
  2160. var
  2161. colors: TScriptVariableReference;
  2162. lastGrad: TBGRALayerGradientOriginal;
  2163. b: TAffineBox;
  2164. begin
  2165. result := srOk;
  2166. colors := AVars.GetVariable('Colors');
  2167. if TVariableSet.GetListCount(colors) <> 2 then
  2168. exit(srInvalidParameters);
  2169. if AFill.FillType = vftGradient then
  2170. AFill.Gradient.SetColors(TVariableSet.GetPixelAt(colors, 0), TVariableSet.GetPixelAt(colors, 1))
  2171. else
  2172. begin
  2173. if AFill = BackFill then lastGrad := FBackLastGradient
  2174. else if AFill = OutlineFill then lastGrad := FOutlineLastGradient
  2175. else lastGrad := FForeLastGradient;
  2176. b := SuggestGradientBox;
  2177. if lastGrad.GradientType = gtLinear then lastGrad.Origin := b.TopLeft else
  2178. lastGrad.Origin := (b.TopLeft+b.BottomRight)*0.5;
  2179. lastGrad.XAxis := b.BottomRight;
  2180. lastGrad.YAxis := EmptyPointF;
  2181. lastGrad.FocalPoint := EmptyPointF;
  2182. lastGrad.Radius := 1;
  2183. lastGrad.FocalRadius := 0;
  2184. lastGrad.SetColors(TVariableSet.GetPixelAt(colors, 0), TVariableSet.GetPixelAt(colors, 1));
  2185. AFill.SetGradient(lastGrad, False);
  2186. end;
  2187. end;
  2188. function TToolManager.ScriptSetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
  2189. begin
  2190. result := ScriptSetGradientInterpolation(AVars, FBackFill);
  2191. end;
  2192. function TToolManager.ScriptSetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
  2193. begin
  2194. result := ScriptSetGradientRepetition(AVars, FBackFill);
  2195. end;
  2196. function TToolManager.ScriptSetBackGradientType(AVars: TVariableSet): TScriptResult;
  2197. begin
  2198. result := ScriptSetGradientType(AVars, FBackFill);
  2199. end;
  2200. function TToolManager.ScriptSetBackGradientColors(AVars: TVariableSet): TScriptResult;
  2201. begin
  2202. result := ScriptSetGradientColors(AVars, FBackFill);
  2203. end;
  2204. function TToolManager.ScriptSetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
  2205. begin
  2206. result := ScriptSetGradientInterpolation(AVars, FOutlineFill);
  2207. end;
  2208. function TToolManager.ScriptSetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
  2209. begin
  2210. result := ScriptSetGradientRepetition(AVars, FOutlineFill);
  2211. end;
  2212. function TToolManager.ScriptSetOutlineGradientType(AVars: TVariableSet): TScriptResult;
  2213. begin
  2214. result := ScriptSetGradientType(AVars, FOutlineFill);
  2215. end;
  2216. function TToolManager.ScriptSetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
  2217. begin
  2218. result := ScriptSetGradientColors(AVars, FOutlineFill);
  2219. end;
  2220. function TToolManager.ScriptSetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
  2221. begin
  2222. result := ScriptSetGradientInterpolation(AVars, FForeFill);
  2223. end;
  2224. function TToolManager.ScriptSetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
  2225. begin
  2226. result := ScriptSetGradientRepetition(AVars, FForeFill);
  2227. end;
  2228. function TToolManager.ScriptSetForeGradientType(AVars: TVariableSet): TScriptResult;
  2229. begin
  2230. result := ScriptSetGradientType(AVars, FForeFill);
  2231. end;
  2232. function TToolManager.ScriptSetForeGradientColors(AVars: TVariableSet): TScriptResult;
  2233. begin
  2234. result := ScriptSetGradientColors(AVars, FForeFill);
  2235. end;
  2236. function TToolManager.ScriptSetTexture(AVars: TVariableSet;
  2237. AFill: TVectorialFill): TScriptResult;
  2238. var
  2239. fileName: String;
  2240. flatImg: TBGRABitmap;
  2241. begin
  2242. fileName := trim(AVars.Strings['FileName']);
  2243. if fileName='' then exit(srInvalidParameters);
  2244. flatImg := LoadFlatImageUTF8(fileName).bmp;
  2245. if flatImg = nil then exit(srException);
  2246. try
  2247. if AFill.FillType <> vftTexture then
  2248. AFill.SetTexture(flatImg, AffineMatrixIdentity)
  2249. else
  2250. AFill.SetTexture(flatImg, AffineMatrixIdentity, AFill.TextureOpacity, AFill.TextureRepetition);
  2251. result := srOk;
  2252. finally
  2253. flatImg.FreeReference;
  2254. end;
  2255. end;
  2256. function TToolManager.ScriptSetTextureRepetition(AVars: TVariableSet;
  2257. AFill: TVectorialFill): TScriptResult;
  2258. begin
  2259. if AFill.FillType <> vftTexture then exit(srException);
  2260. case AVars.Strings['Repetition'] of
  2261. 'None': AFill.TextureRepetition:= trNone;
  2262. 'RepeatX': AFill.TextureRepetition:= trRepeatX;
  2263. 'RepeatY': AFill.TextureRepetition:= trRepeatY;
  2264. 'RepeatBoth': AFill.TextureRepetition:= trRepeatBoth;
  2265. else exit(srInvalidParameters);
  2266. end;
  2267. result := srOk;
  2268. end;
  2269. function TToolManager.ScriptSetTextureOpacity(AVars: TVariableSet;
  2270. AFill: TVectorialFill): TScriptResult;
  2271. begin
  2272. if AFill.FillType <> vftTexture then exit(srException);
  2273. AFill.TextureOpacity := min(255, max(0, AVars.Integers['Opacity']));
  2274. result := srOk;
  2275. end;
  2276. function TToolManager.ScriptSetBackTexture(AVars: TVariableSet): TScriptResult;
  2277. begin
  2278. result := ScriptSetTexture(AVars, BackFill);
  2279. end;
  2280. function TToolManager.ScriptSetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
  2281. begin
  2282. result := ScriptSetTextureRepetition(AVars, BackFill);
  2283. end;
  2284. function TToolManager.ScriptSetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
  2285. begin
  2286. result := ScriptSetTextureOpacity(AVars, BackFill);
  2287. end;
  2288. function TToolManager.ScriptSetForeTexture(AVars: TVariableSet): TScriptResult;
  2289. begin
  2290. result := ScriptSetTexture(AVars, ForeFill);
  2291. end;
  2292. function TToolManager.ScriptSetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
  2293. begin
  2294. result := ScriptSetTextureRepetition(AVars, ForeFill);
  2295. end;
  2296. function TToolManager.ScriptSetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
  2297. begin
  2298. result := ScriptSetTextureOpacity(AVars, ForeFill);
  2299. end;
  2300. function TToolManager.ScriptSetOutlineTexture(AVars: TVariableSet): TScriptResult;
  2301. begin
  2302. result := ScriptSetTexture(AVars, OutlineFill);
  2303. end;
  2304. function TToolManager.ScriptSetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
  2305. begin
  2306. result := ScriptSetTextureRepetition(AVars, OutlineFill);
  2307. end;
  2308. function TToolManager.ScriptSetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
  2309. begin
  2310. result := ScriptSetTextureOpacity(AVars, OutlineFill);
  2311. end;
  2312. function TToolManager.ScriptSetJoinStyle(AVars: TVariableSet): TScriptResult;
  2313. begin
  2314. result := srOk;
  2315. case AVars.Strings['Style'] of
  2316. 'Bevel': JoinStyle := pjsBevel;
  2317. 'Miter': JoinStyle := pjsMiter;
  2318. 'Round': JoinStyle := pjsRound;
  2319. else result := srInvalidParameters;
  2320. end;
  2321. end;
  2322. function TToolManager.ScriptSetLightPosition(AVars: TVariableSet): TScriptResult;
  2323. var
  2324. ptF: TPointF;
  2325. begin
  2326. ptF := AVars.Points2D['Position'];
  2327. if IsEmptyPointF(ptF) then exit(srInvalidParameters);
  2328. LightPosition := ptF;
  2329. result := srOk;
  2330. end;
  2331. function TToolManager.ScriptSetLineCap(AVars: TVariableSet): TScriptResult;
  2332. var
  2333. capStr: String;
  2334. begin
  2335. capStr := AVars.Strings['Cap'];
  2336. case capStr of
  2337. 'Round': LineCap := pecRound;
  2338. 'Square': LineCap := pecSquare;
  2339. 'Flat': LineCap := pecFlat;
  2340. else exit(srInvalidParameters);
  2341. end;
  2342. result := srOk;
  2343. end;
  2344. function TToolManager.ScriptSetForeColor(AVars: TVariableSet): TScriptResult;
  2345. begin
  2346. ForeColor := AVars.Pixels['Color'];
  2347. ToolUpdate;
  2348. result := srOk;
  2349. end;
  2350. function TToolManager.ScriptSetPenStyle(AVars: TVariableSet): TScriptResult;
  2351. begin
  2352. result := srOk;
  2353. case AVars.Strings['Style'] of
  2354. 'Solid': PenStyle := psSolid;
  2355. 'Dash': PenStyle := psDash;
  2356. 'Dot': PenStyle := psDot;
  2357. 'DashDot': PenStyle := psDashDot;
  2358. 'DashDotDot': PenStyle := psDashDotDot;
  2359. else result := srInvalidParameters;
  2360. end;
  2361. end;
  2362. function TToolManager.ScriptSetPenWidth(AVars: TVariableSet): TScriptResult;
  2363. begin
  2364. PenWidth:= AVars.Floats['Width'];
  2365. result := srOk;
  2366. end;
  2367. function TToolManager.ScriptSetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
  2368. var optionsSet: TPerspectiveOptions;
  2369. optionsVar: TScriptVariableReference;
  2370. i: Integer;
  2371. optionStr: string;
  2372. begin
  2373. optionsSet := [];
  2374. optionsVar := AVars.GetVariable('Options');
  2375. for i := 0 to AVars.GetListCount(optionsVar)-1 do
  2376. begin
  2377. optionStr := AVars.GetStringAt(optionsVar, i);
  2378. case optionStr of
  2379. 'Repeat': include(optionsSet, poRepeat);
  2380. 'TwoPlanes': include(optionsSet, poTwoPlanes);
  2381. else exit(srInvalidParameters);
  2382. end;
  2383. end;
  2384. PerspectiveOptions := optionsSet;
  2385. result := srOk;
  2386. end;
  2387. function TToolManager.ScriptSetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
  2388. begin
  2389. if (AVars.Floats['Size'] < MinPhongShapeAltitude) or
  2390. (AVars.Floats['Size'] > MaxPhongShapeAltitude) then exit(srInvalidParameters);
  2391. result := srOk;
  2392. PhongShapeAltitude := AVars.Integers['Altitude'];
  2393. end;
  2394. function TToolManager.ScriptSetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
  2395. begin
  2396. if (AVars.Floats['Size'] < MinPhongBorderSize) or
  2397. (AVars.Floats['Size'] > MaxPhongBorderSize) then exit(srInvalidParameters);
  2398. result := srOk;
  2399. PhongShapeBorderSize := AVars.Integers['Size'];
  2400. end;
  2401. function TToolManager.ScriptSetPhongShapeKind(AVars: TVariableSet): TScriptResult;
  2402. begin
  2403. result := srOk;
  2404. case AVars.Strings['Kind'] of
  2405. 'Rectangle': PhongShapeKind := pskRectangle;
  2406. 'RoundRectangle': PhongShapeKind := pskRoundRectangle;
  2407. 'HalfSphere': PhongShapeKind := pskHalfSphere;
  2408. 'ConeTop': PhongShapeKind := pskConeTop;
  2409. 'ConeSide': PhongShapeKind := pskConeSide;
  2410. 'HorizCylinder': PhongShapeKind := pskHorizCylinder;
  2411. 'VertCylinder': PhongShapeKind := pskVertCylinder;
  2412. else result := srInvalidParameters;
  2413. end;
  2414. end;
  2415. function TToolManager.ScriptSetShapeOptions(AVars: TVariableSet): TScriptResult;
  2416. var so: TShapeOptions;
  2417. options: TScriptVariableReference;
  2418. i: Integer;
  2419. opt: String;
  2420. begin
  2421. so := [];
  2422. if toAliasing in ShapeOptions then include(so, toAliasing);
  2423. options := AVars.GetVariable('Options');
  2424. for i := 0 to AVars.GetListCount(options)-1 do
  2425. begin
  2426. opt := AVars.GetStringAt(options, i);
  2427. case opt of
  2428. 'DrawShape': include(so, toDrawShape);
  2429. 'FillShape': include(so, toFillShape);
  2430. 'CloseShape': include(so, toCloseShape);
  2431. else exit(srInvalidParameters);
  2432. end;
  2433. end;
  2434. if [toDrawShape,toFillShape]*so = [] then
  2435. so := so + [toDrawShape,toFillShape]*ShapeOptions;
  2436. ShapeOptions := so;
  2437. result := srOk;
  2438. end;
  2439. function TToolManager.ScriptSetShapeRatio(AVars: TVariableSet): TScriptResult;
  2440. var
  2441. ratio: single;
  2442. begin
  2443. ratio := AVars.Floats['Ratio'];
  2444. if ratio <= 0 then result := srException else
  2445. begin
  2446. ShapeRatio := ratio;
  2447. result := srOk;
  2448. end;
  2449. end;
  2450. function TToolManager.ScriptSetSplineStyle(AVars: TVariableSet): TScriptResult;
  2451. var
  2452. s: TSplineStyle;
  2453. begin
  2454. case AVars.Strings['Style'] of
  2455. 'Inside': s := ssInside;
  2456. 'InsideWithEnds': s := ssInsideWithEnds;
  2457. 'Crossing': s := ssCrossing;
  2458. 'CrossingWithEnds': s := ssCrossingWithEnds;
  2459. 'Outside': s := ssOutside;
  2460. 'RoundOutside': s := ssRoundOutside;
  2461. 'VertexToSide': s := ssVertexToSide;
  2462. 'EasyBezier': s := ssEasyBezier;
  2463. else
  2464. exit(srInvalidParameters);
  2465. end;
  2466. SplineStyle := s;
  2467. result := srOk;
  2468. end;
  2469. function TToolManager.ScriptSetTextAlign(AVars: TVariableSet): TScriptResult;
  2470. begin
  2471. case AVars.Strings['Align'] of
  2472. 'Left': TextAlign:= taLeftJustify;
  2473. 'Center': TextAlign:= taCenter;
  2474. 'Right': TextAlign:= taRightJustify;
  2475. else exit(srInvalidParameters);
  2476. end;
  2477. result := srOk;
  2478. end;
  2479. function TToolManager.ScriptSetTextOutline(AVars: TVariableSet): TScriptResult;
  2480. begin
  2481. if AVars.IsDefined('Width') and (AVars.Floats['Width'] > 0) then
  2482. SetTextOutline(true, AVars.Floats['Width'])
  2483. else
  2484. SetTextOutline(false, TextOutlineWidth);
  2485. result := srOk;
  2486. end;
  2487. function TToolManager.ScriptSetTextPhong(AVars: TVariableSet): TScriptResult;
  2488. begin
  2489. TextPhong:= AVars.Booleans['Enabled'];
  2490. result := srOk;
  2491. end;
  2492. function TToolManager.ScriptSetTolerance(AVars: TVariableSet): TScriptResult;
  2493. var
  2494. alpha: Int64;
  2495. begin
  2496. alpha := AVars.Integers['Tolerance'];
  2497. if alpha < 0 then alpha := 0;
  2498. if alpha > 255 then alpha := 255;
  2499. Tolerance:= alpha;
  2500. result := srOk;
  2501. end;
  2502. procedure TToolManager.SetBrushIndex(AValue: integer);
  2503. begin
  2504. if FBrushIndex=AValue then Exit;
  2505. FBrushIndex:=AValue;
  2506. ToolUpdate;
  2507. if Assigned(FOnBrushChanged) then FOnBrushChanged(self);
  2508. end;
  2509. procedure TToolManager.SetBrushSpacing(AValue: integer);
  2510. begin
  2511. if AValue < 0 then AValue := 0;
  2512. if AValue > MaxBrushSpacing then AValue := MaxBrushSpacing;
  2513. if FBrushSpacing=AValue then Exit;
  2514. FBrushSpacing:=AValue;
  2515. ToolUpdate;
  2516. if Assigned(FOnBrushChanged) then FOnBrushChanged(self);
  2517. end;
  2518. constructor TToolManager.Create(AImage: TLazPaintImage; AConfigProvider: IConfigProvider;
  2519. ABitmapToVirtualScreen: TBitmapToVirtualScreenFunction;
  2520. ABlackAndWhite : boolean; AScriptContext: TScriptContext);
  2521. begin
  2522. FImage:= AImage;
  2523. BitmapToVirtualScreen := ABitmapToVirtualScreen;
  2524. FShouldExitTool:= false;
  2525. FConfigProvider := AConfigProvider;
  2526. FBlackAndWhite := ABlackAndWhite;
  2527. FScriptContext := AScriptContext;
  2528. RegisterScriptFunctions(True);
  2529. FForeFill := TVectorialFill.Create;
  2530. FForeFill.TransparentMode := tmAlphaZeroOnly;
  2531. FForeFill.SolidColor := BGRABlack;
  2532. FForeFill.OnChange:= @FillChange;
  2533. FForeLastGradient:= TBGRALayerGradientOriginal.Create;
  2534. FForeLastGradient.ColorInterpolation:= ciLinearRGB;
  2535. FBackFill := TVectorialFill.Create;
  2536. FBackFill.TransparentMode := tmAlphaZeroOnly;
  2537. FBackFill.SolidColor := CSSSkyBlue;
  2538. FBackFill.OnChange:= @FillChange;
  2539. FBackLastGradient:= TBGRALayerGradientOriginal.Create;
  2540. FBackLastGradient.ColorInterpolation:= ciLinearRGB;
  2541. FOutlineFill := TVectorialFill.Create;
  2542. FOutlineFill.TransparentMode := tmAlphaZeroOnly;
  2543. FOutlineFill.SolidColor := CSSRed;
  2544. FOutlineFill.OnChange:= @FillChange;
  2545. FOutlineLastGradient:= TBGRALayerGradientOriginal.Create;
  2546. FOutlineLastGradient.ColorInterpolation:= ciLinearRGB;
  2547. FNormalPenWidth := 5;
  2548. FEraserWidth := 10;
  2549. FEraserAlpha := 255;
  2550. FEraserMode := emEraseAlpha;
  2551. ReloadBrushes;
  2552. FBrushSpacing := 1;
  2553. FShapeOptions := [toDrawShape, toFillShape, toCloseShape];
  2554. FPenStyle := psSolid;
  2555. FLineCap := pecRound;
  2556. FJoinStyle := pjsRound;
  2557. FArrowStart := akNone;
  2558. FArrowEnd := akNone;
  2559. FArrowSize := PointF(2,2);
  2560. FSplineStyle := ssEasyBezier;
  2561. FFloodFillOptions := [ffProgressive];
  2562. FTolerance := 64;
  2563. FTextOutline := False;
  2564. FTextOutlineWidth := 2;
  2565. FTextShadow := false;
  2566. FTextFontSize := 10;
  2567. FTextFontName := TTextShape.DefaultFontName;
  2568. FTextFontStyle:= [];
  2569. FTextAlign := taLeftJustify;
  2570. FTextPhong := False;
  2571. FTextShadowBlurRadius := 4;
  2572. FTextShadowOffset := Point(5,5);
  2573. FLightPosition := PointF(0,0);
  2574. FLightAltitude := 100;
  2575. FPhongShapeKind := pskRectangle;
  2576. FPhongShapeAltitude := 50;
  2577. FPhongShapeBorderSize := 20;
  2578. FPerspectiveOptions:= [];
  2579. FDeformationGridNbX := 5;
  2580. FDeformationGridNbY := 5;
  2581. FDeformationGridMode := gmDeform;
  2582. PenWidthControls := TList.Create;
  2583. AliasingControls := TList.Create;
  2584. ShapeControls := TList.Create;
  2585. PenStyleControls := TList.Create;
  2586. CloseShapeControls := TList.Create;
  2587. LineCapControls := TList.Create;
  2588. JoinStyleControls := TList.Create;
  2589. SplineStyleControls := TList.Create;
  2590. EraserControls := TList.Create;
  2591. ToleranceControls := TList.Create;
  2592. DeformationControls := TList.Create;
  2593. TextControls := TList.Create;
  2594. TextShadowControls := TList.Create;
  2595. PhongControls := TList.Create;
  2596. AltitudeControls := TList.Create;
  2597. PerspectiveControls := TList.Create;
  2598. FillControls := TList.Create;
  2599. OutlineFillControls := TList.Create;
  2600. BrushControls := TList.Create;
  2601. RatioControls := TList.Create;
  2602. DonateControls := TList.Create;
  2603. FCurrentToolType := ptHand;
  2604. FCurrentTool := PaintTools[ptHand].Create(Self);
  2605. end;
  2606. destructor TToolManager.Destroy;
  2607. var
  2608. i: Integer;
  2609. begin
  2610. SaveBrushes;
  2611. CurrentTool.Free;
  2612. PenWidthControls.Free;
  2613. AliasingControls.Free;
  2614. ShapeControls.Free;
  2615. PenStyleControls.Free;
  2616. CloseShapeControls.Free;
  2617. LineCapControls.Free;
  2618. JoinStyleControls.Free;
  2619. SplineStyleControls.Free;
  2620. EraserControls.Free;
  2621. ToleranceControls.Free;
  2622. DeformationControls.Free;
  2623. TextControls.Free;
  2624. TextShadowControls.Free;
  2625. PhongControls.Free;
  2626. AltitudeControls.Free;
  2627. PerspectiveControls.Free;
  2628. FillControls.Free;
  2629. OutlineFillControls.Free;
  2630. BrushControls.Free;
  2631. RatioControls.Free;
  2632. DonateControls.Free;
  2633. for i := 0 to BrushCount do
  2634. BrushAt[i].Free;
  2635. FBrushInfoList.Free;
  2636. FForeFill.Free;
  2637. FBackFill.Free;
  2638. FOutlineFill.Free;
  2639. FForeLastGradient.Free;
  2640. FBackLastGradient.Free;
  2641. FOutlineLastGradient.Free;
  2642. RegisterScriptFunctions(False);
  2643. inherited Destroy;
  2644. end;
  2645. procedure TToolManager.LoadFromConfig;
  2646. var
  2647. Config: TLazPaintConfig;
  2648. opt: TShapeOptions;
  2649. begin
  2650. if Assigned(FConfigProvider) then
  2651. Config := FConfigProvider.GetConfig
  2652. else
  2653. exit;
  2654. ForeColor := Config.DefaultToolForeColor;
  2655. BackColor := Config.DefaultToolBackColor;
  2656. OutlineColor := Config.DefaultToolOutlineColor;
  2657. AssignGradientFromConfigStr(FForeLastGradient, Config.DefaultToolForeGradient);
  2658. AssignGradientFromConfigStr(FBackLastGradient, Config.DefaultToolBackGradient);
  2659. AssignGradientFromConfigStr(FOutlineLastGradient, Config.DefaultToolOutlineGradient);
  2660. FNormalPenWidth := Config.DefaultToolPenWidth;
  2661. FEraserWidth := Config.DefaultToolEraserWidth;
  2662. if Assigned(FOnPenWidthChanged) then FOnPenWidthChanged(self);
  2663. ReloadBrushes;
  2664. opt := [];
  2665. if Config.DefaultToolOptionDrawShape then include(opt, toDrawShape);
  2666. if Config.DefaultToolOptionFillShape then include(opt, toFillShape);
  2667. if Config.DefaultToolOptionCloseShape then include(opt, toCloseShape);
  2668. ShapeOptions:= opt;
  2669. Tolerance := Config.DefaultToolTolerance;
  2670. //TextShadow := Config.DefaultToolTextShadow;
  2671. SetTextOutline(Config.DefaultToolTextOutline, Config.DefaultToolTextOutlineWidth);
  2672. TextPhong := Config.DefaultToolTextPhong;
  2673. with Config.DefaultToolTextFont do
  2674. SetTextFont(Name, Size, Style);
  2675. TextShadowBlurRadius := Config.DefaultToolTextBlur;
  2676. TextShadowOffset := Config.DefaultToolTextShadowOffset;
  2677. LightPosition := Config.DefaultToolLightPosition;
  2678. LightAltitude := Config.DefaultToolLightAltitude;
  2679. PhongShapeAltitude := Config.DefaultToolShapeAltitude;
  2680. PhongShapeBorderSize := Config.DefaultToolShapeBorderSize;
  2681. PhongShapeKind := Config.DefaultToolShapeType;
  2682. end;
  2683. procedure TToolManager.SaveToConfig;
  2684. var
  2685. Config: TLazPaintConfig;
  2686. begin
  2687. if Assigned(FConfigProvider) then
  2688. Config := FConfigProvider.GetConfig
  2689. else
  2690. exit;
  2691. if ForeFill.FillType = vftSolid then Config.SetDefaultToolForeColor(ForeColor);
  2692. if BackFill.FillType = vftSolid then Config.SetDefaultToolBackColor(BackColor);
  2693. if OutlineFill.FillType = vftSolid then Config.SetDefaultToolOutlineColor(OutlineColor);
  2694. Config.SetDefaultToolForeGradient(GradientToConfigStr(FForeLastGradient));
  2695. Config.SetDefaultToolBackGradient(GradientToConfigStr(FBackLastGradient));
  2696. Config.SetDefaultToolOutlineGradient(GradientToConfigStr(FOutlineLastGradient));
  2697. Config.SetDefaultToolPenWidth(FNormalPenWidth);
  2698. Config.SetDefaultToolEraserWidth(FEraserWidth);
  2699. Config.SetDefaultToolOptionDrawShape(toDrawShape in ShapeOptions);
  2700. Config.SetDefaultToolOptionFillShape(toFillShape in ShapeOptions);
  2701. Config.SetDefaultToolOptionCloseShape(toCloseShape in ShapeOptions);
  2702. Config.SetDefaultToolTolerance(Tolerance);
  2703. Config.SetDefaultToolTextFont(FTextFontName, FTextFontSize, FTextFontStyle);
  2704. Config.SetDefaultToolTextShadow(TextShadow);
  2705. Config.SetDefaultToolTextOutline(TextOutline);
  2706. Config.SetDefaultToolTextOutlineWidth(TextOutlineWidth);
  2707. Config.SetDefaultToolTextBlur(TextShadowBlurRadius);
  2708. Config.SetDefaultToolTextShadowOffset(TextShadowOffset);
  2709. Config.SetDefaultToolTextPhong(TextPhong);
  2710. Config.SetDefaultToolLightPosition(LightPosition);
  2711. Config.SetDefaultToolLightAltitude(LightAltitude);
  2712. Config.SetDefaultToolShapeBorderSize(PhongShapeBorderSize);
  2713. Config.SetDefaultToolShapeAltitude(PhongShapeAltitude);
  2714. Config.SetDefaultToolShapeType(PhongShapeKind);
  2715. end;
  2716. procedure TToolManager.ReloadBrushes;
  2717. var
  2718. i: Integer;
  2719. bi: TLazPaintBrush;
  2720. begin
  2721. If Assigned(FBrushInfoList) then
  2722. begin
  2723. for i := 0 to FBrushInfoList.Count-1 do
  2724. TObject(FBrushInfoList[i]).Free;
  2725. FBrushInfoList.Clear;
  2726. end else
  2727. FBrushInfoList := TList.Create;
  2728. if Assigned(FConfigProvider) and (FConfigProvider.GetConfig <> nil) then
  2729. begin
  2730. for i := 0 to FConfigProvider.GetConfig.BrushCount-1 do
  2731. begin
  2732. bi := TLazPaintBrush.Create;
  2733. try
  2734. bi.AsString := FConfigProvider.GetConfig.BrushInfo[i];
  2735. except
  2736. continue;
  2737. end;
  2738. FBrushInfoList.Add(bi);
  2739. end;
  2740. end;
  2741. if FBrushInfoList.Count = 0 then
  2742. begin
  2743. FBrushInfoList.Add(TLazPaintBrush.Create(0,True));
  2744. FBrushInfoList.Add(TLazPaintBrush.CreateFromStream64('TGF6UGFpbnQAAAAAMAAAAIAAAACAAAAAAQAAADAAAAAAAAAAAgAAAAAAAAAAAAAAgAAAAIAAAAAAAAAAC78sAABAf/+D/v37A/qD+/3+QDX/xf1VZwPz5YmrsEAi/4L9+gP3gvr9d+eUVGZgA+zniqrLwEAe/4T+9/LvA+yE7/L3/nTodDVFZgPl6Iqry9xAHP8B/cv1EzZqrd8B/XLJ/TNERFcD3emJvMzN0EAa/4L+9cvsETVqvf8B9dn+lzIzQ0ZXeZus3N3tQBn/hPfu5dzH1CN53oTc5e73y/8yMiQ0RQPO6ovM3O7eQBj/hv3y6d7Uy8XDJb6Fy9Te6fLZ+0IiIjNFZ5q83e7u7kAX/5P67+TZzsO4sK2wuMPO2eTv9vLryOMSIlVAA77rjN3u7+7wQAH/g/79+wP6g/v9/nyU9+zi1sm9sKSfpLC9ydbi6uzq4trW0iEzVXmL7e7+//7wPv/ldVZwA/PliauwepP37ODUyLqtn4+frbrI1Nzj4+Lax9AhEkIDqOOc0MS+7/CG2uDo7/X9PP/H/kVGZgPs54qqy8Bygv36A/eO+vXs4tbJvbCkn6SwvcfF0fyFgtHKysESIiRowIeosbjAyM/Xxd///3XppTZbrbAs/+iENUVmA+XsiqvL3JE1A+zkhzKJ2c7DuLCtsLjBxsnvqDCDysG6ybIiIyOOiKCstb7GztbdxOX/8HPjwTAB6cXfMsqE5PD3/in/yf0zRERXA93pibzMzFAB7MrkJXzNRUCC1MvLwyW+vdymg8zDu8mzEiMUEYmPnKe1vsXO1d3E5f/wcoX99ezgz8XDJJ2FyNXl9f0n/9X+MjNDRld5m6zc1ILg2cbRFHzQxdjneMzUI3maurhAgse9yrMhIkM1cImQm6ayvsbO1t3H5f/9h5D17NrHtqqin5+lr7zO4/T+Jv/qQjIkNEUDzueLzNxQg9bKwMa4FZ3wAcfP1OuYNWhombaEy8C3r8qnFDRVe8CHnKezv8jP18ff///Ikffu3sawoJKJhYeMl6a4zOLy5TiakCD/9HIiIiM0VnmrzduNzLuupJyVkZOcqbbF1OjLxWZkBNiE0sa9ssupEiZXea6foKm1wMvS2uDo7/X9//3y5821n4x9cm5vdoGQo7fO4MfxqZq7Hv/rUSISIjNAA77ljN2gj8Syo5aJgnp2eIGRpbjL3czp2VgVR3IQg8O4rsykEzZ4mt3wg664w8rP/v/++TCR797CqJB8a19ZW2JufpGovtPI5umqrMAc/+yxIREhIjIDteWO2jCUr52QgXVsZV5fanuTrMPW6vX69/TH6lMiI4TAtamgy5gmeZucz4StucXSyNrv7v2Ak/fs17qfh3BcT0hIUV5whJmxx9rI5Zqry/Ab/4r99e/o4NrSy8S+yrY0aszFIJWgj39xZVtTTkpbboSeutLo9fr38urG4hEhQIS7sqeczJNFm6mav8CEr7vM3Mfl7u6ok/fs07ecgmtUQT45RlZnfJCovtDI3am8zMAB+xr/xfsREYTXz8jAyrgRJ5zLUJWkk4NzZVhOR0RHVGZ9lrPM4PDz8evI4hESIiCEraObkMOImwWQ49vwhaWvwNDgw+/ecpP37NS4nIRtWEg+N0RTZXiNo7jJydabrNzdAfsZ/+TxEYfd1s7GvrWtyKQUy9lQlZqMe2tdUUdAO0ZTZHuUrsXa7O3q5MnbERIyM4Ogl47Mgv6JZWit4Iegr7/S6Pf+cpP679q9o4t1YVJKRk1YZnaHnLDDy86bzNzu3xj/5HERid3VzsW+taujmcaP/shQlZOHdmZXS0NAQUhWZ3uTqsHU5efj3MrUESMkMzCDmJKPA5DHjzJWaYiGjp2twNTt/XKT/fLjx66Wgm9hWFRXXWd1hJamt8zA/M3e7u7gF//kURGH3dbOxr61rcikEpzGQJWRhXZlV0s+Q0hPXGyAlKrB0t7e3NbYzhEyRERUN6RiERFJ0Ih9jJ2wxdzu/XKI9+zTu6aRf3LFaSfPh3eCkJyssbnKw+3u7+7wF//lkREQhNfPyMDLuBEkSqUxj4V4a1xPSktRWWR0hpetwcXRuoLQxyIkVVZXlZUgm5CGfXFmYWFlb32OobbN4fT+///+9eXOuKOThcZ5FJzgh4KLlp2jq7bKwv7+//7wFv+N/fXv6ODa0svEvraxrcaldpUwhZOIfHFkxVtI34Vwfo6gtMbF+ZlAAcPOuyRGV2l6xmCSn5SHeGpcVFNYYnGAk6jA1+r3coj99ePOuKmWicmAJovO642Wn6q4xMvS2uDo7/X9Fv/T/hIREhIjJCRnUoSWj4N4xW0Tu4ZwfImXp7zHxZl5Uc+1NFd3mZvHgZKai3hpWEhKTldkdIedts7i8v1yiP715dC+qpuQyYc0WJnfh5Shr7/Iz9fF3///F//zcSISIjNDI2ZREIOTioDFdiechX6KlqOyw765A8DxQRNGl6m6zIcgkqCQfGtZTkhDT1xrgJavyt7v+nSJ+OfUwK2hlIuBxXlEi4l/jJuqusbO1t3E5f/wF//ysiIiIzRTFERkjqKakoqBeHZ6gouXoK66A73TvHdDEnebq7vOtYazpZB9bF3FUhe/iGV6lK/G2+z3dJf68+PQvq6dkIJ0amlqaniIl6i4xc7V3cTl//AY//KCMiQ0RTIzRUSLo5uSjIR6g42Wo63YtsmHhlQSNbu8zM7cEIi1ppOBcGNZUgNRiGR7k7LH3Oz3dJf68+XUw7KhkIFxYWZrb3uJmKi4xs7W3cTl//AY//PDIzQ0ZTFCREUgxqQRNbCEm6SttEEVuLq4tYKyrc+kE5v83c7Lkoa1qZaGdmrFYTONiGuBmLLK4Oz3dJv79ObVxbWjlIV3bm1xeIGPnKu5xcnQ2OLr9PsZ/9n9M0REVzIkJDVTMjavzK/rqJh2VRCDo5mPzZj9/d7Jh4KFrZyMfnPFaxd/iHWKorfO4+/6dJL99evaybmqm46De3p9gouWoqzFt/3+hNrj7vwa/9z9Q1RWZRMjNFRURGrNyZADveV3RhDQpBTP7t7bR3aAhbOkk4Z8xXQ1voiClKi+0+Py/XSJ/vfv3tDAsqSZxpAmrvCNn6ettbm+wsrR3Of1/Rr/0/5FRmZxIlJFRjIDtYK4vgPA2cJ3Z2URJ57+7oZWV3SDq5yNxYMTi4mDj52uxNbk8foD98X6ujGG5tjKvLCmzp5Fq8m9+tzghsrU4ez1/hv/0f1VZ3QTNERDNAO+7Iy3l3hnZse2EzvPAbzLxLdTVVZBgqCUxYgmq4mOlqS2xdXh6+4D7MbvvdMQhOLUyL7NtRN0hnqorIizucLO2uXu9x3/3v52djJDMjNFZ5q8d3h3djABuMevNov/ycH3NDQlyaQiMUWshpSdqrfFz83ayqaq3ftChuHUzMO8tcOtRgOgxZ5Zn4iwu8fU3uny/SH/AfjJ8BE2VkUDzuuLyGh3aECCwbfGryd70Mq37oUjIxABm8iTJFaM4IWWn6u4wMvJ3Ixqvf/E9bMwheDWzMW6x7BBMzQDkImWorTDztnk7/of/8P+EwHqzuARZ72HeZugQRXe3NrYgszAx7YRWL3ItbypEiCDpJuRyIkTaNzwg5WgrMu169x5md6P3OXu9vjv6d7Wyr20rqSax5IUd4qIlqq9ydbi7Pce/4b99e7o3NHGySVd0AHSzNq4qbyGd3CE2MzAtsysJHr/zJaAhrCon5WJgMV4JayEfoeTn8upzdm4eL6Qy9Te6fH27+fg18q/tKuekceHJWh1iI2gs8PQ3uz3Hf+I/vXs49bLwbXFrFneg8LR3Mrkqqu3dyCF2szAtazNpCbO/qqWEY2ckIR5b2llZW13g4+a6k3KqWWLkbjDztnj6e/v5+DVx7yvpZeKx38lqX2IiZeotMPQ4vUd/5H37uTUxbepn5eVlpylssPV48jryqynMIvr3c7CtaqgmZaaosOr7QO4j7GlmYyBdGliXlxndH+MmcOhzAOs5HFtg7C9ycfW7tpBiNLEt6yglYV4x3Ccqd+JkJyotMHS5fX+Gv+I/fLp2Me1opHls3vwhpaktcrb7Mf1q7pkjO3f0sS3qp6Tj5Sgqsay6ZYgjaaZjH90Z1xeYml0gYzImf3IdECGloydrbrIx9D/yUOJ0MO1qJ+Rg3VmxnC5ydCKh5Kep7PD1uX1/Rn/lfrv4s67pJB+cmxscXuHlqrC1un1/nON/vPl1sm8rKCThJOjrMa1tnQwj6CXjYN3bWVlaW95hJCcpAOlxqJkJ/CDq7zHx9DdySOHybyxppyShsl6Frp6roqIkZqntsfW5fX+f4P+/fsD+sP7opTs3smymYFtX1lbX2p4i6C40eTy/XSK9+re0MG1qJyWmsii2ZWEQMOWI4KDfcV1Rr6EgImVn8qnhWZ1eNCCrLvIyP3MYiCHxbisoZmQisqCM5V3mvCJho2aq7nJ2uz3fcX9VWcD8+OJMJTo2MWuknpkT05NUl1sgJaxyt7v+nSI+u/k2MzAtKjVoEhyZXp1RmRzit+CkZvLpcVnWFmOg6+8x8fRy6QShMG0qJ7OliVUVERGi9CJgY+drb7R5PL9esf+RUZmA+zjijCU4tTDq5F6ZFRLQ0tUZHqRrMbb7Pd0iv3y6d7UybuvopjTkBI1iqmZqomKzgGbzKPbZVWHe/COsr3H0Nja2tLLxL6xpZzIlEeYJTDGejM2wIl3gpGjtsre7/p5yP1DVFZgA+XkilGI0cGsloBsXVIDTodjepKuw9blxPD7sHKK9+7l3My+rZ2Pgt55EWiq7f29y6vu+akzR1nAjqq1v8jR3N7Xz8jAuLCkypgmjJkhEI56c2tdZGx3ip2xxtvs93jJ/TNERFcD3eSJoqTSxLCcinhqX1tZXm2BmKy/0Nnh4+Tk7PX6/PXs3tC9rJeGdWvGYiSYwIVlcHqEjNKUzrvP1pdjEWngj6y4w8zW393Wzsa+ta2jl8iPm+qSEI+HgHZtZWRidYicscXa7Pd30v4yM0NGV3mbpiCPx7illod7cWxscn2On6+8yMXIRmzQjNTc4uHYyrunkn1rXMZTNInghltpdoWQmsyj+8zZd3RAnqeclZijr73H0Nre3dXOxb61q6OYipGZnqSgmJGJg8V4E42IfY6gtMne7Pd3yvojIkNEUAPO5YvLYI3Nw7KkmY+GgoKGkJyoxrDZISDFmleui6izubu4rZyKdWJSxkgzbOCGU2R2h5WizK3/rMllVSCHrJ2Mmqi0xcbP/bcQhc7GvrWtyaQUvdkTAZHGiBI2sIl/ipqqu87i7/p21P0iIiIzRWeavNtwg87BtcurEjns/YSEoZOLfsV2RYyLfIeRmp2ckINtW0rGQBVP0IhRZXiLnqu5wMnIq9dVRIi7sKSfpLC9ycXS7LiE18/IwMu4ESecRjEBi8eDNXzfiJeotsfY6fL9dsv6EiEiIzQDvuiM3e1zAcjJv0NZq4SGrJyMfGxhxlgli/CXZW56f4aDeWtWQzw0Njk+SFhsgpapuMXKzvqto1QgiMO4sK2wuMPOxtfdtCDE0hEgxbY0aQGkypwkESV84ImPmaSzxdTk7vd2zP4SERISIyADtfGOvM/vY0aHgxCGt6WOemRUx0cRaM2JS1JeZnB0cWZZxksUjPCIVmV5kKS4yNXI3sq7xECD3tTLxcMlvoLL1M7ey7MSEiMlUIOklo7HhURSfIt/iJelssHU4+z1/naK/fXv6ODa0svEvsq2NGqnm8CEv8jS3MbmuXRQidjMtZyDalFBNsYuRKrAiTZBSlZfZ2tqYcZZJHzwiGZ3jKG4ytrjx+25vMOD7uXcx9Qjed4B3Mzl2pISIjNAhbaomIl9x3Qlh5+Kf4+drsDQ5O71/XfF+xERhNfPyMDMuBEmRnnM8JK1wtHe7Pf69/DhzbSXeV5GMCrHIWKLv4UuO0dUYslq1lRIz4d6i6G1y9rqxPP4kAT6AfLL6iI1ar3/yvSyIiIzIIa/rpuIeG3GZCN74IpsfpSkuc7e6/f+eMT6ERCJ3dbOxr61raScyJJEiq3wkqSvwNLi8f7/9eXNspB1WUMwJscZVYuOhiQuQE1ebMd3ymh8h4eSorbI3OzG9fZWcAPz7GI1aGqt38n9UjIkM4fFsZ+LeWldxlQ0iqCJZn6Uq77S5fT+ecT6ERCJ3dXOxb61q6KTyICHaZvwkpKgsMXa6vf/9uTKrZB0WUY0JsccUoTIiR8mOU1ecICLlAOWh5mirr7N4OzH9bdFYwPo9IxGp8i735cyM0GHzLijj3trW8ZPEXjgiU5heZCovdDj7sP3u3fkURGJ3dbOxr61raCRyIIUVYrgkoSRo7jO5PL68uDIrZF4Xko3KsMhMgMTihYhLDxOZHeMnKrFssfPg87Z58nyykMiVAPa6oy8u9zLc+WDNBCW0rmkkHprXE5EPDk3NEFPYXeLobfK2+afvLx15VEREInXz8jAuK+hk4XHehE2nZN2h5mvxNrl6+fYwqqUe2RRQTIoxh8oW+CPKDRDV22Ema3DzdjY3uPsx/XZUhGE3NbQzAPKxMzO4MXk/+11i/3469a+p5B7Z1lNxkATaPCJQ1FhdYicsMLSx97e7dx0kP317+jg2tLLxL6zppaHe3DFZyJtk2t9kKGzx9LW1cy9p5N+a1dIOTDGJhhd0IowPE1hd5CowNPkye/tuocxhOng1s3JxDNmqt2Ezdbg6cPy/XSd/fLcwaiSfWxbTUE3MDAqNDxHU2N0h5aquMXP1NvF5P/tc+qRIREhIq+4q5yMfXFmW1RTUmR1hJSktcDDw7qvo5KCcl9SRDkuJiYkKjI7SFhsgZuyzOHz+nSK+vPp3tLHvLWspgOiiqastbzH0t7p8/pziv3u2sWslX5qWU3HQBEqz5BBTVhmdIOSoK+4vsPK1N7pw/L9c+lBIhIiMK++sqKShHVpXE9UWWNveoeWpK6wsKmgmY+Cd2tdT0Q5MC4sND5LV2Z5kKW+0ufz+nOJ/ffr39HEtqqgx5c1ar2HoKq2xNHf68X36oaK7NnBqZN/bFxNQcc5Fqy9k0pSXGp0goyXoKWpsrvE0Nrp8/pzyf0iIiIzh8W6rJuMfnHFZReshWt0f4mTA5zGlyQyEIRzal5TxUoVjIxPWWd2ipyyxdjo8/pzi/rv4tPDtKWXj4Z+A3uXfoaPl6W0w9Pi7/r/++jQu6SPe2pYTUHHOTLN3YdKUVtjbHN8xoXsreCIpbLAzdvq9/1zyPojIkNAiM7Dt6eXiX91x2wmrM/Pff2lVVV2VRHFXSXLjGRseYiarLzO3On0+3KK/vXp2Me1pJWIfcd0FXm/lH2IlaS1x9bl7OrWw6+ch3VkVkdAxzZIrd7ITu/97sADe+Pv8IiToK69zt3u+nPJ/jIzQ0SIzMS0p5qOgXXabUWa2sqlhJl5eXdXirCMeoKQnKq4xtLg7vX9cor98eDOuaeWh3lwx2UTed+ScHmHlqa0wcfGv6ubinxuXlFGxTsWTsM8/YJRV8xf3bmnVozQinqFkJ+uwNLl9f5zyP0zRERQi9jOxbirnIuAc2tnBGTUZaZpepy7mpqr3+CIlp6ps8DK1uPD8P9yi/rr2MOvnIt8bmJZxVEnnoVZYm58icWV/5GRlIR0aV1SS0M5NCwwNDtHT1fOX+2apiIlnOCKbHaCkKCxxtnt/XTI/UNUVlCI3NTLu6eVhnjbbhRFWGdYnN3OzMzc3++Jp6+7xdDc6fP6c4v45s+6pZOCcmRYTsVGJM6ETlhkccZ8+nMQg29iU8lIEkOGrYVASlNcZsZuu5VAgmVcxVMmjItXX2p3hZWnuc7l+HXJ/kVGZlGI2MWxnYt7cWfMXxQ0Vome0AFbzGP+7v7+79CJsLnDztjk7/f9c4v24Mqzn4t6a11PRMU8Iu6DRE9dxmb6oRCDWVFExDkUQAMohzA5QUtYZ3HGech3IINpXFHGRyPM8IpUX2x7i5yxxtz0d8f9VWd1id/LuqSUgHJlXMVSEyQDO+PM8IhWXmlyeYKLkcaZ//7wh8PM1uDr9Pp0i/TcxK2Yh3VlV0tAxTYkzoJAS8ZW/ZMQhE1BOTDGJhVegIcqMkBOXGx7xYbqc4aAcWJUSD7FNiz+i01YZHOElqq+1u7+eMT+dnCO8uPRvqmTgXFiVktBOTYDMI4yNj5GUVxmc3+HkpukrMW07u+D1t7pw/L9dJLy2cGrl4RyYlRHPDIqKCoyPEfFUexDhkc7MCgfGQMTkxYcKDlIW26DkpygnZeOfGxdT0TFORKujDxGUl9tf5CkudDp/XuM/PDgz7umkXtqW01B49EgAyiVKiw5QU5caneEj5qlrri/x8vS2ODpw/LtdYvy18GrlINxYVJHO8UyJM4BO8VH7oaGSDwwJhwTBA+UExwqPE9qhZuqsrOsnox5aVtOQDbFLirvi0NOW2p7jaG1zOX6e4z46trItJ+JdWRURjvoMiZY/os2RE9ebXyLmKSxu8bF/93ghOvz+f12kfLZwKuWg3FjVEg8NCwoLDQ8xUj8Zq5EOSocEw8KCgAKEx8uQFdyk7XIy8S1n4x5aVlNQDYuKCouNkBNWWl6jJ+1zOT4eo3+9OfVw7CbhXFeT0E3xy4kOryMMDlGUmJxhJOhsL3IxtP+ztDL97x1Z3mai/Laxa6Zh3VlV0tAxTcUzwFAxUv8Y51GNywcEw8ACgoTFiEyR15+oMHi4sy2oY16alxOQ8U3Em6MN0FNW2p5jKC1zOX3eoz98eTTwKyYg29cTUDpwiOLruCMPEhXaXiLnq67y9bh0enMzYYjRXm5tIrYxrKfi3prXVFGxTwkzgFGxVHtc4VLPDAkGcYPONzgkiY2S2eHrNDw6NC6pJB/bV5SRsY8Ik7wi0RPXW18kKK4z+b2eo778OLSwKyWhG1cSz4yKAMkwybOjTlBTltrfZCjtcTS4OfR8JlTEURnma3IitLDtKKTgXJkWU7FRiTOjE5ZYWVkX1ZHOy4kGQMTpRYcKjtRb5Cz1unn1r+qloRzZVhNQzs2MjdASFRicYGUqL7U6fd6jfrv4tK/r5iEcF5OQDTHLCqMzos+R1Jda3iKnay4wsbM3WRAzsMiZ5mtzutAicCzp5mKfG9iWcVRJ56MWWJucnRvZVtNPDAmxRxYvZIuQVd2lrXO4unZxbCcjHtsYVTFShFdjEdRXGp4iJytw9rq+HqN+u/j1MKwnId1ZFJEOckuaMy/74ZUXmp2hZLHm/7KeMulU1R3uuyNrLK7wMK9taqfk4d6cMdlE3nfjHB6goaDe3FjUkY2LgMmlCg2SF58l7LK3unizrqnloV2aVxSxUpIn4tXY3KCkqS4zN7t+nqN+O3bzbqsm417a1tNQcs5Warc7++DaXN804TOelM2U4aore+DlJ2oxbLJQoWknJGIfcd1FHnPon2IlJycmY1+b1xLQzk2NjlDUWV+lrDG2+rm2sWxoJCBcWXGWSRq8Itfa3qLna/B1OTx/XiO/vfu3su+rqKWin5zZVjVThSYuevd7d7od2PMZmNnh6q88IV1fYiUoMeru4IihJWPhn8Deo5/ho+XprK7uK+ejXpnW8ZSV5ywkGyDmbPH3Ozu5NHArp6Lem3GYxOK4Itnc4OVq7vN3Or1/neO/fXs3s2+rqGWi4R7dm7+0RR4mZusyqqzcUMzRqa35MvdhmFpdYKQnNCozYZBEyV5vvCLqrfDzNDMw6yYhHjGbzVp4JF5jaS3zODs8+7ezr6olYV4beUSi9CKcX6NoLTI2OPv+neK/vXq2Me4qZmOh9F/Q2dFNDh4eokDXuqEMUElRQQy5and0IdOV2Jwf5Ccyaj9mGciA6KFpqy1vMTFzP/Chce1oZWKxYEnrpGNnq/A0uTv+Pfq28u1opCDd8VuRb+KeoeYqr7S4Ov3/XeI9+fTwbCgj4H35Haaqpk0V2R2ZiZww04hxTkyRAMk6D1urP+IR1RhcoKUoK3Vtfulk2ea3M3Ky6SFx7KlmpUDkKCWo6+8zN7p8v368+nWw6+ekIF3cG5weYWUo7XI2unz+neI++rXwa6ciHfYaxPM3e7uZSNSVBMiIAFD0jkSQWVYW4uN3OCJO0ZTZHaJm6u2xsPcqVADyeyMlad5V2aCu7LHqDWc75u/zNrl7vf//vny4s67qZqNgHZyd4GPnK6/z+LD8v12k/7x3sqynYZ0YlhSUVNcZm95hI7HlokSEYh0bmVdU0tANsssIzVVhIPHE4u7v4ouO0pcbYGVqbfFxc/tqAPa7YUlRDVEh5DIsDab3uCFx9be6PTF/phjk+vaybeol4p9cH2Lmai3ydrr+P13ovfn1L6ljnZjU0dDQ0hRXW16iZihqaiimZCJfnNnXE9BNCzJJDJVSDiDAAoA5YjY8IwfJjREVGZ8kKS4xtPE3vyAA+iI5N7Wzca9t7DMqDeKyYvq8IXFytTd58bx75hgkvLj08OypZiNh42YpbLD0+Py/Xek/fLizrWdhGtYRzk5N0FLWGt6ipujrq+uppyQhnZmVkc5LCQfxBaBgAMKZQIKjhMZIS5AUmV5jqO2ytjkxuzbeGCH6NzQxbquo8ybFGiu7fzAnbi/x8/Z4+nu9f3///rr3s/CtaignaCotcLP3uv6eIr6797KsZZ8ZFJGxTx435RWZXWDk56oq62ooJaHdmVSQTImH8UWVDhpjwoTGSQuQE9jeI+iuMra6MXy63iJ8uTYybiqnJGHxn82i/CJi5Oan6SttcDJxdL9/4n1/v/98ufazsPFuxW/hsPO2ufy/XiJ9+zeybGWe2NRxkdGipCFU2N0g5DGm/ylQIuXiXhkUUAwIRwTEwMKaY8KFhwoNENTZ3qRpbnM3OnF9PyFiO/ezLqpmop9x3QRaa+Ydn6Hj5ehqbK7w87U3OXu9///9+7l3NLKA8WGytLc5e73eYj37N7KtZqAZcdPdXmqhVhlcn6JxpTOpXCIlIl3ZVFAMCbGHCVDgGgCD5wZISw7SlhtgJWpvs/g7vX9///45tTArJmJeG1ixVkmi5VcZGtzfIeQl6CstcHL1N7p8v3//vXL7BE1ar3/gvX+eYj37OLQu6SLc8hiFoeb4AFsynX/7tyVIIeHeGlWRjcsxiEyVIBBHgoAChaOGSQqNkFRYnSHnLHD1OPF8P+XivLgybOdinhpW1LHSDWM/pNbZG51gIiRm6i1w87Z5O/6///9y/UTNmqt3wH9eon67+TYxrOdh3jDcFYDauefurvAxoradTCGfG9eTT4yxSgTJQMPBQoCE48cHyo0PktbbH6RpLnK2+nF8/2Giu3Wv6eQfGpZTkPGOxSO4JFES1ZhanN7goucrb3J1uLs93KE/vfy7wPshO/y9/57if3y6d7Sw7ShkM2IRWR3pDadx37vujGGdmdWSDwyzyojUoW1i4vvji40QEpYZ3iJnq/E1OTvxffqg4rnzrSchG9dTUA3xS4mbJIwN0FLVl9qcnl6laq6yNTg7PfM/2VYaXqLsH6I9+7l3NTHvq/IpEJDNRCHeG1lZWt0fuXvtiCHgHNjVkg+NsouQlaFtYDDJKyQMjlBTVhndoeZq77Q3uv0+nKK+OLGq5B5ZFJDN+eiFY3wkDA3Q01YZG54hZmtvcnW4uzE94NQA+yE7/L3/hH/gv715lETMpvGwbm1rKSainxsXWJfcH+KlJqalo6CcmNXTUTEOzRAAyrnKo7N8IxKUl9seYiYqrvL2unD8v1yivbewKKHb1tIOy7GJhJbsJAkKDI7R1Jhbn2Oo7XDztnkzO61M2aq3fAB/RH/Af3ogTNmlY7Wz8O2pJSEdm1qbneFksWc+2GFkIN0aV3PUyE1Voqa3O+LXGdzgIycrLzL2+nD8u1zjPTZuZt/Z1NDNCohGQMTwxntjSw3RFFeb4GWr8HL1N7N6KgxNWq9/4L1/hH/hP738u8D7Jvv7OTZxbKjlId9eX2HkZ2osri1rqSWiXxyZ2HNWEN3mcnc/o10gIqXpK++yNbj7/f9dIry17WUeWJOPjImxxwlTL6SJCw0QU9ecYeguc7U3OXn5+Xcx9Qjed6E3OXu9xP/gv36A/ea+vvy59TCsaKWjoyOlqGtuMHKycK1q5yTh4DNdyNVecrL+4qGkJulr7e+yNPcxeXv33OK8tOykHVeSjssJMccJUy7iiEoNEBPYXSNqMfG2d/YYIPe1MvFwyW+hsvU3uny/Rn/hvfu3s6/ssWoFb+Msr7J1Nzc1sq+tauhzpkSNHqazevgg6evt8y/zO7czN3wAf1yifLRr5B1XUo5LMghMhPc4IohKjZEUmV6lLLUxeTdtY/k2c7DuLCtsLjDztnk7/oZ/4b+9ezczsPFuyWNi8DK2Obt7unf1MvE7cIlNnqqu9CCvcPPy995iXdqvf+Q9f7///LPsJB0Xko7LiQZFgMPoBYZISw3RlZqgpy94e/y9/fs4tbJvbCkn6SwvcnW4uz3Gv+F/fXs4NPFyhWMhMzW4+zF9KZS1+ISRUh5eZrc7t5XEsfUI3nekdzl7vf///LQsJN4YU08MCYcxROEjJ8cJC45SFtyiKTH5/f7/vfs4NTIuq2fj5+tusjU4Oz3G/+E/vfu4sXWRIqD2ODmyu+qyaZEQAPr7GmHWLvduYXy6d7Uy8XDJb6Ty9Te6fL9//LTtZh8ZVJAMigfFgMTjBYfKDA8TV9zjavH4sXwm1GP4tbJvbCkn6SwvcnW4uz3G//E/UEg1OQzqNq6q8vcqHdgA/rrFWNjl9kwnNzVzMO4sK2wuMPO2eTv+v/y17udhW1XRjksIRkDFowZISo2Q1Fhd46nwNfnardCII3Ow7iwrbC4w87Z5O/6Gv/J/TNERFcD3emJvMzN0HSG/fXu6N7Wy8wyXYqkMZivpJ+ksL3J1uLs9//03MCli3ZiT0A0KCEDHIwfJjI7SFZmeIyitcfJ0arFZ1PFwyW+hsvU3uny/Rn/1/4yMyElWpubrNzd7XKI/vXs49bKvLDLpxerzqhDlp2Pn626yNTg7Pf/9uDKr5Z/allKPDLHKiW+74hET1tqeYiZqcW4+b4Dyui6ZXnehNzl7vca/8T6IyCC3dTRzDRZu/zM3O7ecoj37uTUxbKik8aIN7rQAZTHndmDjpSwvcnW4uz3//jmz7ihjHdlVkhANgMuizI7Q01WYW13hJCd8s2s35vN6oq9/4L1/hn/w/0ihOnc0MbHvhN4vQHBzMnt3u7u6mCI8unYx7CdiHnGbze94IJ/jMWW+8yTsLjDztnk7/r/+uvYw62YhXRkVslNEmi+/YddZW12f4iRypqcvv/e4AHQx9zKrd8B/Rr/49EQhN7Qw7jHrxRYzYKyvcvI7u7+79OI7+LOuqGLdGTGWTi+8JpvfoyZoauxu8PL1N7p8v3//fHgzrmnlINzausRGHye3rDJb8792quImaCqtLvF0NvG59u98Br/44EghuPUxrmsosaZRJzwg6WxvcrJ7+//7xCI7N7JsZZ9ZFPFSGavnlZic4aWpLG8xc7U3OXu9////vXp2Me1pJOGeXBnZARhzmScubysqa7QiJOcqLXBztvqw/XbHP+J/fXu3My+r6GWxYwWm5WQmqa0w8vS2uDo7/X99+zaxayQdVvGRCNs4I1KWW6Dlqi4xdDZ3uXsxvX2WECJ6uDTw7Sll4+Fx3xEZocFbgJt5neb34mHkZyquMfY6fYe/4n79OnYx7enmYvloVrQiIWQnq29yM/Xxt///0CW7NvGrJF2XEo8NDQyO0NXb4acsMDQ28vk3fhVWGaH4NjQxLaqoM+XMyc0NWVVRwNh43/winuHk6GvwNDi8Pwd/5f68+XUw7SikoN1bGpscXuKmai4xs7W3cXl//iW797KsZd8ZVJGPjs8QU1ed46kusvb5c/vu4EzZqZkQoPHvLXIrCIzIiDMfFIhElaN4Itncn2Kmai4ydvq+B3/l/rz5dTDsqGQgXBfZWdneIeWqLjFztXdxeX/+4jy5NG7oopzYcVUFY2MW2yEm7PI2unz+vz1zewRNWqph3YBzcbEMyIgiZ+VjIN9dGxjW8VSFayNVl5rdoWSorPD1ef0/hz/l/rz5dTDtKKSg3Vsamxxe4qZqLjGztbdxeX//Yj37NrHsJyFdMVmFZ6Obn+UqMDU5/L9//fu5dzR1CN53cuqYiQii7atoZeLgnduYVdNA0GORk5ZZHF/jp+vwNPk8f0c/4n79OnYx7enmYvFfxWtiIWQnq29yM/Xx9///8eb9eXWwa+bin52c3R6hpamuc7e7vf//fLp3tTLxcMlvgHLytPuzEVCIJzHuqyfk4d7b2RXS0M+O0FKVGFvfYycrb/R4vD7HP+J/fXu3My+r6GWxYwWm7OQmqa0w8vS2uDo7/X9///99eXXxbakmZGPkJagrbvO3Oz1/v/67+TZzsO4sK2wuMPO2ODH6eljM4vUxbiomY6Ac2VZT8VHJb+MU2FtfIucrL7Q4u/6HP/D/hKG49TGuayixplEnPCDpbG9ycnv7//vcof+9ere0MW4xbBa7pjG0+Ds9f3///fs4tbJvbCkn6SwvcnW4urG88Z1EIrh0cCxopOFd2pfxVQSRo1LV2Jwf42er8DS4+/6Hf/D+hGE3tDDuMevFFjNgrK9ycju7v7vdYT88+rixtoiqPCC4OnD8t9ykPfs4NTIuq2fj5+tusjU4OzmH3Zxi+rayrqpmYt9cWVcxVQlroxcaXWCkqCyw9fj8fod/8P9IoTp3NDGx74TeL0BwcrJ7d7u7uB364U2OX2tsHSR9+zi1sm9sKSfpLC9ydbi7Pdzi/ry49C/r6CRhXlvxmUTasCMZW98iZint8nZ5vT7Hv/E+iMggt3U0cw0Wbv8zNzu3hn/kfrv5NnOw7iwrbC4w87Z5O/6c4v99+rYx7iom46CecdxFHjei3qGkqCvwM7d6/X9Hv/X/jIzISVam5us3N3tGf+G/fLp3tTLxcMlvobL1N7p8v10ivry4tDAsqWajoTHfENq3YuHkJyquMfW4+/3/h//yf0zRERXA93pibzMzdAb/4T37uXcx9Qjed6E3OXu93WJ/vnr2sy+sKSbyZIhZqr/iZ2otMPS3enz+iH/yP1DVFZgA+XoiqvL3Bz/gv71y+wRNWq9/4L1/naI/fbn2Mu+sqjJoBRWq+6Gq7XCz9rmw/D+Iv/nlFRmYAPs54qqy8Ae/wH9y/UTNmqt3wH9eIf99OTXzMC4yK8kOZvAhrK6xNDZ48Pu7iX/5bVWcAPz5YmrsCH/hP738u8D7ITv8vf+eob+9Ofa0MfJvzRXnM+EytTb5MTt7tAn/4P+/fsD+oP7/f4l/4L9+gP3gvr9fYX99uri2MPQQwPF5o/P/4Tv8/j9QCz/w/1BAerP4kRYmsvO69xALv/xlFNVV4msqsvAE//g'));
  2745. end;
  2746. FBrushInfoListChanged := false;
  2747. end;
  2748. procedure TToolManager.SaveBrushes;
  2749. var
  2750. i: Integer;
  2751. infos: TStringList;
  2752. begin
  2753. if Assigned(FConfigProvider) and FBrushInfoListChanged then
  2754. begin
  2755. infos := TStringList.Create;
  2756. try
  2757. for i := 0 to BrushCount-1 do
  2758. infos.Add(BrushAt[i].AsString);
  2759. FConfigProvider.GetConfig.SetBrushes(infos);
  2760. except
  2761. end;
  2762. infos.Free;
  2763. end;
  2764. FBrushInfoListChanged := false;
  2765. end;
  2766. function TToolManager.ApplyPressure(AColor: TBGRAPixel): TBGRAPixel;
  2767. var alpha: integer;
  2768. begin
  2769. alpha := round(AColor.alpha*FToolPressure);
  2770. if alpha <= 0 then
  2771. result := BGRAPixelTransparent
  2772. else if alpha >= 255 then
  2773. result := AColor
  2774. else
  2775. begin
  2776. result := AColor;
  2777. result.alpha := alpha;
  2778. end;
  2779. end;
  2780. function TToolManager.ApplyPressure(AOpacity: byte): byte;
  2781. begin
  2782. result := round(AOpacity*FToolPressure);
  2783. end;
  2784. procedure TToolManager.SetPressure(APressure: single);
  2785. begin
  2786. if APressure <= 0 then
  2787. FToolPressure := 0
  2788. else if APressure >= 1 then
  2789. FToolPressure := 1
  2790. else
  2791. FToolPressure:= APressure;
  2792. end;
  2793. function TToolManager.GetPressureB: Byte;
  2794. begin
  2795. result := round(FToolPressure*255);
  2796. end;
  2797. procedure TToolManager.InternalSetCurrentToolType(tool: TPaintToolType);
  2798. begin
  2799. if (tool <> FCurrentToolType) or (FCurrentTool=nil) then
  2800. begin
  2801. FreeAndNil(FCurrentTool);
  2802. if PaintTools[tool] <> nil then
  2803. FCurrentTool := PaintTools[tool].Create(self)
  2804. else
  2805. FCurrentTool := nil;
  2806. FCurrentToolType:= tool;
  2807. if not IsSelectingTool then
  2808. Image.ReleaseEmptySelection;
  2809. UpdateContextualToolbars;
  2810. If Assigned(FOnToolChangedHandler) then
  2811. FOnToolChangedHandler(self, FCurrentToolType);
  2812. If Assigned(FOnToolRenderChanged) then
  2813. FOnToolRenderChanged(self);
  2814. end;
  2815. FShouldExitTool:= false;
  2816. end;
  2817. function TToolManager.UpdateContextualToolbars: boolean;
  2818. var
  2819. contextualToolbars: TContextualToolbars;
  2820. hasPen: Boolean;
  2821. procedure OrResult(AValue: boolean);
  2822. begin
  2823. if AValue then result := true;
  2824. end;
  2825. begin
  2826. result := false;
  2827. if Assigned(FCurrentTool) then
  2828. begin
  2829. contextualToolbars := FCurrentTool.GetContextualToolbars;
  2830. hasPen := FCurrentTool.HasPen;
  2831. end
  2832. else
  2833. begin
  2834. contextualToolbars := [ctPenFill, ctBackFill];
  2835. hasPen := false;
  2836. end;
  2837. if (ctBackFill in contextualToolbars) and not (ctPenFill in contextualToolbars) then
  2838. OrResult(SetControlsVisible(FillControls, True, 'Panel_BackFill')) else
  2839. if (ctPenFill in contextualToolbars) and not (ctBackFill in contextualToolbars) then
  2840. OrResult(SetControlsVisible(FillControls, True, 'Panel_PenFill'))
  2841. else
  2842. OrResult(SetControlsVisible(FillControls, (ctPenFill in contextualToolbars) and (ctBackFill in contextualToolbars)));
  2843. OrResult(SetControlsVisible(BrushControls, ctBrush in contextualToolbars));
  2844. OrResult(SetControlsVisible(ShapeControls, ctShape in contextualToolbars));
  2845. OrResult(SetControlsVisible(PenWidthControls, (ctPenWidth in contextualToolbars) and hasPen));
  2846. OrResult(SetControlsVisible(JoinStyleControls, (ctJoinStyle in contextualToolbars) and hasPen));
  2847. OrResult(SetControlsVisible(PenStyleControls, (ctPenStyle in contextualToolbars) and hasPen));
  2848. OrResult(SetControlsVisible(CloseShapeControls, ctCloseShape in contextualToolbars));
  2849. OrResult(SetControlsVisible(LineCapControls, ToolHasLineCap));
  2850. OrResult(SetControlsVisible(AliasingControls, ctAliasing in contextualToolbars));
  2851. OrResult(SetControlsVisible(SplineStyleControls, ctSplineStyle in contextualToolbars));
  2852. OrResult(SetControlsVisible(EraserControls, ctEraserOption in contextualToolbars));
  2853. OrResult(SetControlsVisible(ToleranceControls, ctTolerance in contextualToolbars));
  2854. OrResult(SetControlsVisible(DeformationControls, ctDeformation in contextualToolbars));
  2855. if (ctText in contextualToolbars) and not (ctOutlineWidth in contextualToolbars) then
  2856. OrResult(SetControlsVisible(TextControls, True, 'Panel_Text')) else
  2857. if (ctOutlineWidth in contextualToolbars) and not (ctText in contextualToolbars) then
  2858. OrResult(SetControlsVisible(TextControls, True, 'Panel_TextOutline'))
  2859. else
  2860. OrResult(SetControlsVisible(TextControls, (ctText in contextualToolbars) and (ctOutlineWidth in contextualToolbars)));
  2861. OrResult(SetControlsVisible(OutlineFillControls, ctOutlineFill in contextualToolbars));
  2862. OrResult(SetControlsVisible(TextShadowControls, ctTextShadow in contextualToolbars));
  2863. OrResult(SetControlsVisible(PhongControls, ctPhong in contextualToolbars));
  2864. OrResult(SetControlsVisible(AltitudeControls, ctAltitude in contextualToolbars));
  2865. OrResult(SetControlsVisible(PerspectiveControls, ctPerspective in contextualToolbars));
  2866. OrResult(SetControlsVisible(RatioControls, ctRatio in contextualToolbars));
  2867. OrResult(SetControlsVisible(DonateControls, FCurrentToolType = ptHand));
  2868. if result and Assigned(FOnToolbarChanged) then FOnToolbarChanged(self);
  2869. end;
  2870. function TToolManager.InternalBitmapToVirtualScreen(PtF: TPointF): TPointF;
  2871. begin
  2872. if Assigned(FCurrentTool) then
  2873. begin
  2874. ptF.x += FCurrentTool.LayerOffset.X;
  2875. ptF.y += FCurrentTool.LayerOffset.Y;
  2876. end;
  2877. result := BitmapToVirtualScreen(ptF);
  2878. end;
  2879. function TToolManager.AddLayerOffset(ARect: TRect): TRect;
  2880. begin
  2881. result := ARect;
  2882. if (result.Left = OnlyRenderChange.Left) and
  2883. (result.Top = OnlyRenderChange.Top) and
  2884. (result.Right = OnlyRenderChange.Right) and
  2885. (result.Bottom = OnlyRenderChange.Bottom) then exit;
  2886. if Assigned(FCurrentTool) then
  2887. OffsetRect(result, FCurrentTool.LayerOffset.X,FCurrentTool.LayerOffset.Y);
  2888. end;
  2889. procedure TToolManager.RegisterScriptFunctions(ARegister: boolean);
  2890. begin
  2891. if not Assigned(FScriptContext) then exit;
  2892. FScriptContext.RegisterScriptFunction('ToolSetForeColor', @ScriptSetForeColor, ARegister);
  2893. FScriptContext.RegisterScriptFunction('ToolGetForeColor', @ScriptGetForeColor, ARegister);
  2894. FScriptContext.RegisterScriptFunction('ToolSetBackColor', @ScriptSetBackColor, ARegister);
  2895. FScriptContext.RegisterScriptFunction('ToolGetBackColor', @ScriptGetBackColor, ARegister);
  2896. FScriptContext.RegisterScriptFunction('ToolSetOutlineColor', @ScriptSetOutlineColor, ARegister);
  2897. FScriptContext.RegisterScriptFunction('ToolGetOutlineColor', @ScriptGetOutlineColor, ARegister);
  2898. FScriptContext.RegisterScriptFunction('ToolSetEraserMode', @ScriptSetEraserMode, ARegister);
  2899. FScriptContext.RegisterScriptFunction('ToolGetEraserMode', @ScriptGetEraserMode, ARegister);
  2900. FScriptContext.RegisterScriptFunction('ToolSetEraserAlpha', @ScriptSetEraserAlpha, ARegister);
  2901. FScriptContext.RegisterScriptFunction('ToolGetEraserAlpha', @ScriptGetEraserAlpha, ARegister);
  2902. FScriptContext.RegisterScriptFunction('ToolSetPenWidth', @ScriptSetPenWidth, ARegister);
  2903. FScriptContext.RegisterScriptFunction('ToolGetPenWidth', @ScriptGetPenWidth, ARegister);
  2904. FScriptContext.RegisterScriptFunction('ToolSetPenStyle', @ScriptSetPenStyle, ARegister);
  2905. FScriptContext.RegisterScriptFunction('ToolGetPenStyle', @ScriptGetPenStyle, ARegister);
  2906. FScriptContext.RegisterScriptFunction('ToolSetJoinStyle', @ScriptSetJoinStyle, ARegister);
  2907. FScriptContext.RegisterScriptFunction('ToolGetJoinStyle', @ScriptGetJoinStyle, ARegister);
  2908. FScriptContext.RegisterScriptFunction('ToolSetShapeOptions', @ScriptSetShapeOptions, ARegister);
  2909. FScriptContext.RegisterScriptFunction('ToolGetShapeOptions', @ScriptGetShapeOptions, ARegister);
  2910. FScriptContext.RegisterScriptFunction('ToolSetAliasing', @ScriptSetAliasing, ARegister);
  2911. FScriptContext.RegisterScriptFunction('ToolGetAliasing', @ScriptGetAliasing, ARegister);
  2912. FScriptContext.RegisterScriptFunction('ToolSetShapeRatio', @ScriptSetShapeRatio, ARegister);
  2913. FScriptContext.RegisterScriptFunction('ToolGetShapeRatio', @ScriptGetShapeRatio, ARegister);
  2914. FScriptContext.RegisterScriptFunction('ToolSetBrushIndex', @ScriptSetBrushIndex, ARegister);
  2915. FScriptContext.RegisterScriptFunction('ToolGetBrushIndex', @ScriptGetBrushIndex, ARegister);
  2916. FScriptContext.RegisterScriptFunction('ToolGetBrushCount', @ScriptGetBrushCount, ARegister);
  2917. FScriptContext.RegisterScriptFunction('ToolSetBrushSpacing', @ScriptSetBrushSpacing, ARegister);
  2918. FScriptContext.RegisterScriptFunction('ToolGetBrushSpacing', @ScriptGetBrushSpacing, ARegister);
  2919. FScriptContext.RegisterScriptFunction('ToolSetFontName', @ScriptSetFontName, ARegister);
  2920. FScriptContext.RegisterScriptFunction('ToolGetFontName', @ScriptGetFontName, ARegister);
  2921. FScriptContext.RegisterScriptFunction('ToolSetFontSize', @ScriptSetFontSize, ARegister);
  2922. FScriptContext.RegisterScriptFunction('ToolGetFontSize', @ScriptGetFontSize, ARegister);
  2923. FScriptContext.RegisterScriptFunction('ToolSetFontStyle', @ScriptSetFontStyle, ARegister);
  2924. FScriptContext.RegisterScriptFunction('ToolGetFontStyle', @ScriptGetFontStyle, ARegister);
  2925. FScriptContext.RegisterScriptFunction('ToolSetTextAlign', @ScriptSetTextAlign, ARegister);
  2926. FScriptContext.RegisterScriptFunction('ToolGetTextAlign', @ScriptGetTextAlign, ARegister);
  2927. FScriptContext.RegisterScriptFunction('ToolSetTextOutline', @ScriptSetTextOutline, ARegister);
  2928. FScriptContext.RegisterScriptFunction('ToolGetTextOutline', @ScriptGetTextOutline, ARegister);
  2929. FScriptContext.RegisterScriptFunction('ToolSetTextPhong', @ScriptSetTextPhong, ARegister);
  2930. FScriptContext.RegisterScriptFunction('ToolGetTextPhong', @ScriptGetTextPhong, ARegister);
  2931. FScriptContext.RegisterScriptFunction('ToolSetLightPosition', @ScriptSetLightPosition, ARegister);
  2932. FScriptContext.RegisterScriptFunction('ToolGetLightPosition', @ScriptGetLightPosition, ARegister);
  2933. { FScriptContext.RegisterScriptFunction('ToolSetLightAltitude', @ScriptSetLightAltitude, ARegister);
  2934. FScriptContext.RegisterScriptFunction('ToolGetLightAltitude', @ScriptGetLightAltitude, ARegister);}
  2935. FScriptContext.RegisterScriptFunction('ToolSetLineCap', @ScriptSetLineCap, ARegister);
  2936. FScriptContext.RegisterScriptFunction('ToolGetLineCap', @ScriptGetLineCap, ARegister);
  2937. FScriptContext.RegisterScriptFunction('ToolSetArrowStart', @ScriptSetArrowStart, ARegister);
  2938. FScriptContext.RegisterScriptFunction('ToolGetArrowStart', @ScriptGetArrowStart, ARegister);
  2939. FScriptContext.RegisterScriptFunction('ToolSetArrowEnd', @ScriptSetArrowEnd, ARegister);
  2940. FScriptContext.RegisterScriptFunction('ToolGetArrowEnd', @ScriptGetArrowEnd, ARegister);
  2941. FScriptContext.RegisterScriptFunction('ToolSetArrowSize', @ScriptSetArrowSize, ARegister);
  2942. FScriptContext.RegisterScriptFunction('ToolGetArrowSize', @ScriptGetArrowSize, ARegister);
  2943. FScriptContext.RegisterScriptFunction('ToolSetSplineStyle', @ScriptSetSplineStyle, ARegister);
  2944. FScriptContext.RegisterScriptFunction('ToolGetSplineStyle', @ScriptGetSplineStyle, ARegister);
  2945. FScriptContext.RegisterScriptFunction('ToolSetForeGradientType', @ScriptSetForeGradientType, ARegister);
  2946. FScriptContext.RegisterScriptFunction('ToolGetForeGradientType', @ScriptGetForeGradientType, ARegister);
  2947. FScriptContext.RegisterScriptFunction('ToolSetForeGradientRepetition', @ScriptSetForeGradientRepetition, ARegister);
  2948. FScriptContext.RegisterScriptFunction('ToolGetForeGradientRepetition', @ScriptGetForeGradientRepetition, ARegister);
  2949. FScriptContext.RegisterScriptFunction('ToolSetForeGradientInterpolation', @ScriptSetForeGradientInterpolation, ARegister);
  2950. FScriptContext.RegisterScriptFunction('ToolGetForeGradientInterpolation', @ScriptGetForeGradientInterpolation, ARegister);
  2951. FScriptContext.RegisterScriptFunction('ToolSetForeGradientColors', @ScriptSetForeGradientColors, ARegister);
  2952. FScriptContext.RegisterScriptFunction('ToolGetForeGradientColors', @ScriptGetForeGradientColors, ARegister);
  2953. FScriptContext.RegisterScriptFunction('ToolSetBackGradientType', @ScriptSetBackGradientType, ARegister);
  2954. FScriptContext.RegisterScriptFunction('ToolGetBackGradientType', @ScriptGetBackGradientType, ARegister);
  2955. FScriptContext.RegisterScriptFunction('ToolSetBackGradientRepetition', @ScriptSetBackGradientRepetition, ARegister);
  2956. FScriptContext.RegisterScriptFunction('ToolGetBackGradientRepetition', @ScriptGetBackGradientRepetition, ARegister);
  2957. FScriptContext.RegisterScriptFunction('ToolSetBackGradientInterpolation', @ScriptSetBackGradientInterpolation, ARegister);
  2958. FScriptContext.RegisterScriptFunction('ToolGetBackGradientInterpolation', @ScriptGetBackGradientInterpolation, ARegister);
  2959. FScriptContext.RegisterScriptFunction('ToolSetBackGradientColors', @ScriptSetBackGradientColors, ARegister);
  2960. FScriptContext.RegisterScriptFunction('ToolGetBackGradientColors', @ScriptGetBackGradientColors, ARegister);
  2961. FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientType', @ScriptSetOutlineGradientType, ARegister);
  2962. FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientType', @ScriptGetOutlineGradientType, ARegister);
  2963. FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientRepetition', @ScriptSetOutlineGradientRepetition, ARegister);
  2964. FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientRepetition', @ScriptGetOutlineGradientRepetition, ARegister);
  2965. FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientInterpolation', @ScriptSetOutlineGradientInterpolation, ARegister);
  2966. FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientInterpolation', @ScriptGetOutlineGradientInterpolation, ARegister);
  2967. FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientColors', @ScriptSetOutlineGradientColors, ARegister);
  2968. FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientColors', @ScriptGetOutlineGradientColors, ARegister);
  2969. FScriptContext.RegisterScriptFunction('ToolSetForeTexture', @ScriptSetForeTexture, ARegister);
  2970. FScriptContext.RegisterScriptFunction('ToolSetForeTextureRepetition', @ScriptSetForeTextureRepetition, ARegister);
  2971. FScriptContext.RegisterScriptFunction('ToolGetForeTextureRepetition', @ScriptGetForeTextureRepetition, ARegister);
  2972. FScriptContext.RegisterScriptFunction('ToolSetForeTextureOpacity', @ScriptSetForeTextureOpacity, ARegister);
  2973. FScriptContext.RegisterScriptFunction('ToolGetForeTextureOpacity', @ScriptGetForeTextureOpacity, ARegister);
  2974. FScriptContext.RegisterScriptFunction('ToolSetBackTexture', @ScriptSetBackTexture, ARegister);
  2975. FScriptContext.RegisterScriptFunction('ToolSetBackTextureRepetition', @ScriptSetBackTextureRepetition, ARegister);
  2976. FScriptContext.RegisterScriptFunction('ToolGetBackTextureRepetition', @ScriptGetBackTextureRepetition, ARegister);
  2977. FScriptContext.RegisterScriptFunction('ToolSetBackTextureOpacity', @ScriptSetBackTextureOpacity, ARegister);
  2978. FScriptContext.RegisterScriptFunction('ToolGetBackTextureOpacity', @ScriptGetBackTextureOpacity, ARegister);
  2979. FScriptContext.RegisterScriptFunction('ToolSetOutlineTexture', @ScriptSetOutlineTexture, ARegister);
  2980. FScriptContext.RegisterScriptFunction('ToolSetOutlineTextureRepetition', @ScriptSetOutlineTextureRepetition, ARegister);
  2981. FScriptContext.RegisterScriptFunction('ToolGetOutlineTextureRepetition', @ScriptGetOutlineTextureRepetition, ARegister);
  2982. FScriptContext.RegisterScriptFunction('ToolSetOutlineTextureOpacity', @ScriptSetOutlineTextureOpacity, ARegister);
  2983. FScriptContext.RegisterScriptFunction('ToolGetOutlineTextureOpacity', @ScriptGetOutlineTextureOpacity, ARegister);
  2984. FScriptContext.RegisterScriptFunction('ToolSetPhongShapeAltitude', @ScriptSetPhongShapeAltitude, ARegister);
  2985. FScriptContext.RegisterScriptFunction('ToolGetPhongShapeAltitude', @ScriptGetPhongShapeAltitude, ARegister);
  2986. FScriptContext.RegisterScriptFunction('ToolSetPhongShapeBorderSize', @ScriptSetPhongShapeBorderSize, ARegister);
  2987. FScriptContext.RegisterScriptFunction('ToolGetPhongShapeBorderSize', @ScriptGetPhongShapeBorderSize, ARegister);
  2988. FScriptContext.RegisterScriptFunction('ToolSetPhongShapeKind', @ScriptSetPhongShapeKind, ARegister);
  2989. FScriptContext.RegisterScriptFunction('ToolGetPhongShapeKind', @ScriptGetPhongShapeKind, ARegister);
  2990. FScriptContext.RegisterScriptFunction('ToolSetDeformationGridSize', @ScriptSetDeformationGridSize, ARegister);
  2991. FScriptContext.RegisterScriptFunction('ToolGetDeformationGridSize', @ScriptGetDeformationGridSize, ARegister);
  2992. FScriptContext.RegisterScriptFunction('ToolSetDeformationGridMode', @ScriptSetDeformationGridMode, ARegister);
  2993. FScriptContext.RegisterScriptFunction('ToolGetDeformationGridMode', @ScriptGetDeformationGridMode, ARegister);
  2994. FScriptContext.RegisterScriptFunction('ToolSetTolerance', @ScriptSetTolerance, ARegister);
  2995. FScriptContext.RegisterScriptFunction('ToolGetTolerance', @ScriptGetTolerance, ARegister);
  2996. FScriptContext.RegisterScriptFunction('ToolSetFloodFillOptions', @ScriptSetFloodFillOptions, ARegister);
  2997. FScriptContext.RegisterScriptFunction('ToolGetFloodFillOptions', @ScriptGetFloodFillOptions, ARegister);
  2998. FScriptContext.RegisterScriptFunction('ToolSetPerspectiveOptions', @ScriptSetPerspectiveOptions, ARegister);
  2999. FScriptContext.RegisterScriptFunction('ToolGetPerspectiveOptions', @ScriptGetPerspectiveOptions, ARegister);
  3000. end;
  3001. procedure TToolManager.ToolWakeUp;
  3002. begin
  3003. if FSleepingTool <> nil then
  3004. begin
  3005. FreeAndNil(FCurrentTool);
  3006. FCurrentTool := FSleepingTool;
  3007. FSleepingTool := nil;
  3008. FCurrentToolType := FSleepingToolType;
  3009. UpdateContextualToolbars;
  3010. If Assigned(FOnToolChangedHandler) then
  3011. FOnToolChangedHandler(self, FCurrentToolType);
  3012. If Assigned(FOnToolRenderChanged) then
  3013. FOnToolRenderChanged(self);
  3014. end;
  3015. end;
  3016. procedure TToolManager.ToolSleep;
  3017. begin
  3018. if (FSleepingTool = nil) and (FCurrentToolType <> ptHand) then
  3019. begin
  3020. FSleepingTool := FCurrentTool;
  3021. FSleepingToolType := FCurrentToolType;
  3022. FCurrentTool := nil;
  3023. InternalSetCurrentToolType(ptHand);
  3024. end;
  3025. end;
  3026. { tool implementation }
  3027. procedure TToolManager.SetDeformationGridSize(ASize: TSize);
  3028. begin
  3029. if ASize.cx < 3 then ASize.cx := 3;
  3030. if ASize.cy < 3 then ASize.cy := 3;
  3031. if (ASize.cx <> DeformationGridNbX) or (ASize.cy <> DeformationGridNbY) then
  3032. begin
  3033. FDeformationGridNbX := ASize.cx;
  3034. FDeformationGridNbY := ASize.cy;
  3035. ToolUpdate;
  3036. if Assigned(FOnDeformationGridChanged) then FOnDeformationGridChanged(self);
  3037. end;
  3038. end;
  3039. function TToolManager.SwapToolColors: boolean;
  3040. var
  3041. tmpFill: TVectorialFill;
  3042. begin
  3043. result := false;
  3044. if FInSwapFill then exit;
  3045. if FForeFill.Equals(FBackFill) then exit;
  3046. FInSwapFill:= true;
  3047. tmpFill := FForeFill.Duplicate;
  3048. FForeFill.Assign(FBackFill);
  3049. FBackFill.Assign(tmpFill);
  3050. tmpFill.Free;
  3051. if FForeFill.FillType = vftGradient then
  3052. begin
  3053. FForeLastGradient.Free;
  3054. FForeLastGradient := FForeFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
  3055. end;
  3056. if FBackFill.FillType = vftGradient then
  3057. begin
  3058. FBackLastGradient.Free;
  3059. FBackLastGradient := FBackFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
  3060. end;
  3061. if Assigned(FOnFillChanged) then FOnFillChanged(self);
  3062. FInSwapFill:= false;
  3063. result := true;
  3064. end;
  3065. procedure TToolManager.NeedBackGradient;
  3066. var
  3067. tempFill: TVectorialFill;
  3068. begin
  3069. if BackFill.FillType <> vftGradient then
  3070. begin
  3071. tempFill := TVectorialFill.Create;
  3072. tempFill.SetGradient(FBackLastGradient, False);
  3073. tempFill.FitGeometry(SuggestGradientBox);
  3074. BackFill.Assign(tempFill);
  3075. tempFill.Free;
  3076. end;
  3077. end;
  3078. procedure TToolManager.NeedForeGradient;
  3079. var
  3080. tempFill: TVectorialFill;
  3081. begin
  3082. if ForeFill.FillType <> vftGradient then
  3083. begin
  3084. tempFill := TVectorialFill.Create;
  3085. tempFill.SetGradient(FForeLastGradient, False);
  3086. tempFill.FitGeometry(SuggestGradientBox);
  3087. ForeFill.Assign(tempFill);
  3088. tempFill.Free;
  3089. end;
  3090. end;
  3091. procedure TToolManager.AddBrush(brush: TLazPaintBrush);
  3092. begin
  3093. FBrushIndex := FBrushInfoList.Add(brush);
  3094. FBrushInfoListChanged := true;
  3095. if Assigned(FOnBrushListChanged) then FOnBrushListChanged(self);
  3096. end;
  3097. procedure TToolManager.RemoveBrushAt(index: integer);
  3098. begin
  3099. if Assigned(FBrushInfoList) then
  3100. begin
  3101. if (index >= 1) and (index < BrushCount) then
  3102. begin
  3103. BrushAt[index].Free;
  3104. FBrushInfoList.Delete(index);
  3105. if index < FBrushIndex then dec(FBrushIndex)
  3106. else if index = FBrushIndex then
  3107. begin
  3108. if FBrushIndex >= BrushCount then
  3109. dec(FBrushIndex);
  3110. end;
  3111. FBrushInfoListChanged := true;
  3112. if Assigned(FOnBrushListChanged) then FOnBrushListChanged(self);
  3113. end;
  3114. end;
  3115. end;
  3116. procedure TToolManager.SetTextFont(AName: string; ASize: single;
  3117. AStyle: TFontStyles);
  3118. begin
  3119. if AName = '' then AName := FTextFontName;
  3120. if (FTextFontName <> AName) or
  3121. (FTextFontSize <> ASize) or
  3122. (FTextFontStyle <> AStyle) then
  3123. begin
  3124. FTextFontName := AName;
  3125. if ASize >= 0 then FTextFontSize := ASize;
  3126. FTextFontStyle := AStyle;
  3127. ToolUpdate;
  3128. if Assigned(FOnTextFontChanged) then FOnTextFontChanged(self);
  3129. end;
  3130. end;
  3131. procedure TToolManager.SetTextFont(AFont: TFont);
  3132. begin
  3133. SetTextFont(AFont.Name, AFont.Size, AFont.Style);
  3134. end;
  3135. procedure TToolManager.SetTextOutline(AEnabled: boolean; AWidth: single);
  3136. begin
  3137. if (FTextOutline <> AEnabled) or
  3138. (FTextOutlineWidth <> AWidth) then
  3139. begin
  3140. FTextOutlineWidth := AWidth;
  3141. FTextOutline := AEnabled;
  3142. ToolUpdate;
  3143. if Assigned(FOnTextOutlineChanged) then FOnTextOutlineChanged(self);
  3144. end;
  3145. end;
  3146. function TToolManager.ToolDown(X, Y: single; ARightBtn: boolean;
  3147. APressure: single): boolean;
  3148. var changed: TRect;
  3149. begin
  3150. if FInTool then exit(false);
  3151. FInTool := true;
  3152. try
  3153. SetPressure(APressure);
  3154. if ToolCanBeUsed and Assigned(CurrentTool) then
  3155. changed := CurrentTool.ToolDown(X,Y,ARightBtn)
  3156. else
  3157. changed := EmptyRect;
  3158. result := not IsRectEmpty(changed);
  3159. if IsOnlyRenderChange(changed) then changed := EmptyRect;
  3160. if CheckExitTool then result := true;
  3161. if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
  3162. finally
  3163. FInTool := false;
  3164. end;
  3165. end;
  3166. function TToolManager.ToolMove(X, Y: single; APressure: single): boolean;
  3167. var changed: TRect;
  3168. begin
  3169. if FInTool then exit(false);
  3170. FInTool := true;
  3171. try
  3172. SetPressure(APressure);
  3173. if ToolCanBeUsed and Assigned(CurrentTool) then
  3174. changed := CurrentTool.ToolMove(X,Y)
  3175. else
  3176. changed := EmptyRect;
  3177. result := not IsRectEmpty(changed);
  3178. if IsOnlyRenderChange(changed) then changed := EmptyRect;
  3179. if CheckExitTool then result := true;
  3180. if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
  3181. finally
  3182. FInTool := false;
  3183. end;
  3184. end;
  3185. function TToolManager.ToolKeyDown(var key: Word): boolean;
  3186. var changed: TRect;
  3187. begin
  3188. if FInTool then exit(false);
  3189. FInTool := true;
  3190. try
  3191. if ToolCanBeUsed and Assigned(CurrentTool) then
  3192. changed := CurrentTool.ToolKeyDown(key)
  3193. else
  3194. changed := EmptyRect;
  3195. result := not IsRectEmpty(changed);
  3196. if IsOnlyRenderChange(changed) then changed := EmptyRect;
  3197. if CheckExitTool then result := true;
  3198. if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
  3199. finally
  3200. FInTool := false;
  3201. end;
  3202. end;
  3203. function TToolManager.ToolKeyUp(var key: Word): boolean;
  3204. var changed: TRect;
  3205. begin
  3206. if FInTool then exit(false);
  3207. FInTool := true;
  3208. try
  3209. if ToolCanBeUsed and Assigned(CurrentTool) then
  3210. changed := CurrentTool.ToolKeyUp(key)
  3211. else
  3212. changed := EmptyRect;
  3213. result := not IsRectEmpty(changed);
  3214. if IsOnlyRenderChange(changed) then changed := EmptyRect;
  3215. if CheckExitTool then result := true;
  3216. if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
  3217. finally
  3218. FInTool := false;
  3219. end;
  3220. end;
  3221. function TToolManager.ToolKeyPress(var key: TUTF8Char): boolean;
  3222. var changed: TRect;
  3223. begin
  3224. if FInTool then exit(false);
  3225. FInTool := true;
  3226. try
  3227. if ToolCanBeUsed and Assigned(CurrentTool) then
  3228. changed := CurrentTool.ToolKeyPress(key)
  3229. else
  3230. changed := EmptyRect;
  3231. result := not IsRectEmpty(changed);
  3232. if IsOnlyRenderChange(changed) then changed := EmptyRect;
  3233. if CheckExitTool then result := true;
  3234. if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
  3235. finally
  3236. FInTool := false;
  3237. end;
  3238. end;
  3239. function TToolManager.ToolCommand(ACommand: TToolCommand): boolean;
  3240. begin
  3241. if FInTool then exit(false);
  3242. FInTool := true;
  3243. try
  3244. if Assigned(FCurrentTool) then
  3245. begin
  3246. result := FCurrentTool.ToolCommand(ACommand);
  3247. CheckExitTool;
  3248. end
  3249. else
  3250. result := false;
  3251. finally
  3252. FInTool := false;
  3253. end;
  3254. end;
  3255. function TToolManager.ToolProvideCommand(ACommand: TToolCommand): boolean;
  3256. begin
  3257. if Assigned(FCurrentTool) then
  3258. result := FCurrentTool.ToolProvideCommand(ACommand)
  3259. else
  3260. result := false;
  3261. end;
  3262. function TToolManager.ToolUp: boolean;
  3263. var changed: TRect;
  3264. begin
  3265. if FInTool then exit(false);
  3266. FInTool := true;
  3267. try
  3268. if ToolCanBeUsed and Assigned(CurrentTool) then
  3269. changed := CurrentTool.ToolUp
  3270. else
  3271. changed := EmptyRect;
  3272. result := not IsRectEmpty(changed);
  3273. if IsOnlyRenderChange(changed) then changed := EmptyRect;
  3274. if CheckExitTool then result := true;
  3275. if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
  3276. finally
  3277. FInTool := false;
  3278. end;
  3279. end;
  3280. procedure TToolManager.ToolCloseDontReopen;
  3281. begin
  3282. if CurrentTool <> nil then
  3283. begin
  3284. if FInTool then raise exception.Create('Cannot close active tool');
  3285. FreeAndNil(FCurrentTool);
  3286. end;
  3287. end;
  3288. procedure TToolManager.ToolCloseAndReopenImmediatly;
  3289. begin
  3290. if CurrentTool <> nil then
  3291. begin
  3292. if FInTool then raise exception.Create('Cannot close active tool');
  3293. FInTool := true;
  3294. try
  3295. FreeAndNil(FCurrentTool);
  3296. finally
  3297. FInTool := false;
  3298. end;
  3299. ToolOpen;
  3300. end;
  3301. end;
  3302. procedure TToolManager.ToolOpen;
  3303. begin
  3304. if (FCurrentTool = nil) and (PaintTools[FCurrentToolType] <> nil) then
  3305. begin
  3306. if FInTool then raise exception.Create('Internal error');
  3307. FInTool := true;
  3308. try
  3309. FCurrentTool := PaintTools[FCurrentToolType].Create(self);
  3310. UpdateContextualToolbars;
  3311. If Assigned(FOnToolRenderChanged) then
  3312. FOnToolRenderChanged(self);
  3313. finally
  3314. FInTool := false;
  3315. end;
  3316. end;
  3317. end;
  3318. function TToolManager.ToolUpdate: boolean;
  3319. var changed: TRect;
  3320. begin
  3321. if FInTool then exit(false);
  3322. FInTool := true;
  3323. FInToolUpdate := true;
  3324. try
  3325. if ToolCanBeUsed and Assigned(CurrentTool) then
  3326. changed := CurrentTool.ToolUpdate
  3327. else
  3328. changed := EmptyRect;
  3329. result := not IsRectEmpty(changed);
  3330. if IsOnlyRenderChange(changed) then changed := EmptyRect;
  3331. if CheckExitTool then result := true;
  3332. if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
  3333. finally
  3334. FInTool := false;
  3335. FInToolUpdate := false;
  3336. end;
  3337. end;
  3338. function TToolManager.ToolUpdateNeeded: boolean;
  3339. begin
  3340. if ToolCanBeUsed and Assigned(CurrentTool) then
  3341. result := CurrentTool.ToolUpdateNeeded
  3342. else
  3343. result := false;
  3344. if CheckExitTool then
  3345. result := true;
  3346. end;
  3347. procedure TToolManager.ToolPopup(AMessage: TToolPopupMessage; AKey: Word = 0);
  3348. begin
  3349. if Assigned(FOnPopupToolHandler) then
  3350. FOnPopupToolHandler(self, AMessage, AKey);
  3351. end;
  3352. function TToolManager.IsSelectingTool: boolean;
  3353. begin
  3354. if CurrentTool <> nil then
  3355. result := CurrentTool.IsSelectingTool
  3356. else
  3357. result := false;
  3358. end;
  3359. function TToolManager.DisplayFilledSelection: boolean;
  3360. begin
  3361. result := IsSelectingTool or (FCurrentToolType = ptEditShape);
  3362. end;
  3363. function TToolManager.IsForeEditGradTexPoints: boolean;
  3364. begin
  3365. if Assigned(CurrentTool) then result := CurrentTool.IsForeEditGradTexPoints
  3366. else result := false;
  3367. end;
  3368. function TToolManager.IsBackEditGradTexPoints: boolean;
  3369. begin
  3370. if Assigned(CurrentTool) then result := CurrentTool.IsBackEditGradTexPoints
  3371. else result := false;
  3372. end;
  3373. function TToolManager.IsOutlineEditGradTexPoints: boolean;
  3374. begin
  3375. if Assigned(CurrentTool) then result := CurrentTool.IsOutlineEditGradTexPoints
  3376. else result := false;
  3377. end;
  3378. procedure TToolManager.QueryExitTool;
  3379. begin
  3380. FShouldExitTool:= true;
  3381. end;
  3382. function TToolManager.RenderTool(formBitmap: TBGRABitmap): TRect;
  3383. begin
  3384. if ToolCanBeUsed and Assigned(CurrentTool) and not FInTool then
  3385. begin
  3386. FInTool := true;
  3387. try
  3388. result := CurrentTool.Render(formBitmap,formBitmap.Width,formBitmap.Height, @InternalBitmapToVirtualScreen);
  3389. finally
  3390. FInTool := false;
  3391. end;
  3392. end else
  3393. result := EmptyRect;
  3394. end;
  3395. function TToolManager.GetRenderBounds(VirtualScreenWidth, VirtualScreenHeight: integer): TRect;
  3396. begin
  3397. if ToolCanBeUsed and Assigned(CurrentTool) and not CurrentTool.Validating and not CurrentTool.Canceling then
  3398. result := CurrentTool.Render(nil,VirtualScreenWidth,VirtualScreenHeight, @InternalBitmapToVirtualScreen)
  3399. else
  3400. result := EmptyRect;
  3401. end;
  3402. function TToolManager.SuggestGradientBox: TAffineBox;
  3403. begin
  3404. if Assigned(CurrentTool) then
  3405. result := CurrentTool.SuggestGradientBox
  3406. else
  3407. result := TAffineBox.AffineBox(RectF(PointF(0,0),PointF(Image.Width,Image.Height)));
  3408. end;
  3409. function TToolManager.GetDeformationGridSize: TSize;
  3410. begin
  3411. result := Size(DeformationGridNbX, DeformationGridNbY);
  3412. end;
  3413. function TToolManager.ToolDown(ACoord: TPointF; ARightBtn: boolean;
  3414. APressure: single): boolean;
  3415. begin
  3416. result := ToolDown(ACoord.x,ACoord.y,ARightBtn,APressure)
  3417. end;
  3418. function TToolManager.ToolMove(ACoord: TPointF; APressure: single): boolean;
  3419. begin
  3420. result := ToolMove(ACoord.x,ACoord.y,APressure)
  3421. end;
  3422. initialization
  3423. fillchar({%H-}PaintTools,sizeof(PaintTools),0);
  3424. end.