1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UTool;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 uses
9   Classes, Types, SysUtils, Graphics, BGRABitmap, BGRABitmapTypes, uimage, UImageType,
10   ULayerAction, LCLType, Controls, UBrushType, UConfig, LCVectorPolyShapes,
11   BGRAGradientScanner, BGRALayerOriginal, LCVectorRectShapes, UScripting,
12   LCVectorialFill, BGRAGradientOriginal;
13 
14 const
15   VK_SNAP = {$IFDEF DARWIN}VK_LWIN{$ELSE}VK_CONTROL{$ENDIF};
16   VK_SNAP2 = {$IFDEF DARWIN}VK_RWIN{$ELSE}VK_CONTROL{$ENDIF};
17   ssSnap = {$IFDEF DARWIN}ssMeta{$ELSE}ssCtrl{$ENDIF};
18 
19 type TPaintToolType = (ptHand,ptHotSpot, ptMoveLayer,ptRotateLayer,ptZoomLayer,
20                    ptPen, ptBrush, ptClone, ptColorPicker, ptEraser,
21                    ptEditShape, ptRect, ptEllipse, ptPolygon, ptSpline, ptPolyline, ptOpenedCurve,
22                    ptFloodFill, ptGradient, ptPhong,
23                    ptSelectPen, ptSelectRect, ptSelectEllipse, ptSelectPoly, ptSelectSpline,
24                    ptMoveSelection, ptRotateSelection, ptMagicWand, ptDeformation, ptTextureMapping, ptLayerMapping,
25                    ptText);
26 
27 const
28   PaintToolTypeStr : array[TPaintToolType] of string = ('Hand','HotSpot', 'MoveLayer','RotateLayer','ZoomLayer',
29                    'Pen', 'Brush', 'Clone', 'ColorPicker', 'Eraser',
30                    'EditShape', 'Rect', 'Ellipse', 'Polygon', 'Spline', 'Polyline', 'OpenedCurve',
31                    'FloodFill', 'Gradient', 'Phong',
32                    'SelectPen', 'SelectRect', 'SelectEllipse', 'SelectPoly', 'SelectSpline',
33                    'MoveSelection', 'RotateSelection', 'MagicWand', 'Deformation', 'TextureMapping', 'LayerMapping',
34                    'Text');
35 
StrToPaintToolTypenull36 function StrToPaintToolType(const s: ansistring): TPaintToolType;
37 
38 type
39   TContextualToolbar = (ctPenFill, ctPenWidth, ctPenStyle, ctJoinStyle, ctLineCap,
40     ctCloseShape, ctSplineStyle, ctShape, ctRatio, ctBackFill,
41     ctBrush, ctEraserOption, ctAliasing, ctTolerance, ctDeformation, ctPerspective,
42     ctText, ctOutlineWidth, ctOutlineFill, ctTextShadow, ctPhong, ctAltitude);
43   TContextualToolbars = set of TContextualToolbar;
44 
45 type
46   TToolManager = class;
47   TBitmapToVirtualScreenFunction = function(PtF: TPointF): TPointF of object;
48 
49   TEraserMode = (emEraseAlpha, emSharpen, emSoften, emLighten, emDarken);
50   TToolCommand = (tcCut, tcCopy, tcPaste, tcDelete, tcFinish, tcMoveUp, tcMoveDown, tcMoveToFront, tcMoveToBack,
51     tcAlignLeft, tcCenterHorizontally, tcAlignRight, tcAlignTop, tcCenterVertically, tcAlignBottom,
52     tcShapeToSpline, tcForeAdjustToShape, tcBackAdjustToShape, tcOutlineAdjustToShape,
53     tcForeEditGradTexPoints, tcBackEditGradTexPoints, tcOutlineEditGradTexPoints);
54 
55   TDeformationGridMode = (gmDeform, gmMovePointWithoutDeformation);
56 
57 const
58   MaxPenWidth = 999.9;
59   MinPenWidth = 1;
60   MaxArrowSize = 9.9;
61   MinArrowSize = 1;
62   MaxBrushSpacing = 99;
63   MinPhongShapeAltitude = 1;
64   MaxPhongShapeAltitude = 100;
65   MinPhongBorderSize = 1;
66   MaxPhongBorderSize = 100;
67   MinDeformationGridSize = 3;
68 
GradientInterpolationToDisplaynull69 function GradientInterpolationToDisplay(AValue: TBGRAColorInterpolation): string;
DisplayToGradientInterpolationnull70 function DisplayToGradientInterpolation(AValue: string): TBGRAColorInterpolation;
71 
72 type
73   TLayerKind = (lkUnknown, lkEmpty, lkBitmap, lkTransformedBitmap, lkGradient, lkVectorial, lkSVG, lkOther);
74 
75   { TGenericTool }
76 
77   TGenericTool = class
78   private
79     FShiftState: TShiftState;
80     FAction: TLayerAction;
81     FForeFill, FBackFill: TVectorialFill;
82     FBackFillScan, FForeFillScan: TBGRACustomScanner;
GetUniversalBrushnull83     function GetUniversalBrush(ASource: TVectorialFill; var ADest: TVectorialFill; var AScan: TBGRACustomScanner): TUniversalBrush;
84   protected
85     FManager: TToolManager;
86     FLastToolDrawingLayer: TBGRABitmap;
87     FValidating, FCanceling: boolean;
GetActionnull88     function GetAction: TLayerAction; virtual;
GetIdleActionnull89     function GetIdleAction: TLayerAction; virtual;
GetLayerOffsetnull90     function GetLayerOffset: TPoint; virtual;
GetIsSelectingToolnull91     function GetIsSelectingTool: boolean; virtual; abstract;
FixSelectionTransformnull92     function FixSelectionTransform: boolean; virtual;
FixLayerOffsetnull93     function FixLayerOffset: boolean; virtual;
DoToolDownnull94     function DoToolDown(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF; rightBtn: boolean): TRect; virtual;
DoToolMovenull95     function DoToolMove(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF): TRect; virtual;
DoToolKeyDownnull96     function DoToolKeyDown(var key: Word): TRect; virtual;
DoToolKeyUpnull97     function DoToolKeyUp(var key: Word): TRect; virtual;
DoToolUpdatenull98     function DoToolUpdate({%H-}toolDest: TBGRABitmap): TRect; virtual;
99     procedure OnTryStop({%H-}sender: TCustomLayerAction); virtual;
SelectionMaxPointDistancenull100     function SelectionMaxPointDistance: single;
GetStatusTextnull101     function GetStatusText: string; virtual;
DoGetToolDrawingLayernull102     function DoGetToolDrawingLayer: TBGRABitmap; virtual;
GetCurrentLayerKindnull103     function GetCurrentLayerKind: TLayerKind;
GetIsForeEditGradTexPointsnull104     function GetIsForeEditGradTexPoints: boolean; virtual;
GetIsBackEditGradTexPointsnull105     function GetIsBackEditGradTexPoints: boolean; virtual;
GetIsOutlineEditGradTexPointsnull106     function GetIsOutlineEditGradTexPoints: boolean; virtual;
GetAllowedBackFillTypesnull107     function GetAllowedBackFillTypes: TVectorialFillTypes; virtual;
GetAllowedForeFillTypesnull108     function GetAllowedForeFillTypes: TVectorialFillTypes; virtual;
GetAllowedOutlineFillTypesnull109     function GetAllowedOutlineFillTypes: TVectorialFillTypes; virtual;
110     property ShiftState: TShiftState read FShiftState;
111   public
112     ToolUpdateNeeded: boolean;
113     Cursor: TCursor;
114     constructor Create(AManager: TToolManager); virtual;
115     destructor Destroy; override;
GetForeUniversalBrushnull116     function GetForeUniversalBrush: TUniversalBrush;
GetBackUniversalBrushnull117     function GetBackUniversalBrush: TUniversalBrush;
118     procedure ReleaseUniversalBrushes; virtual;
119     procedure ValidateAction;
120     procedure ValidateActionPartially;
121     procedure CancelAction;
122     procedure CancelActionPartially;
HasPennull123     function HasPen: boolean; virtual;
ToolUpdatenull124     function ToolUpdate: TRect;
ToolDownnull125     function ToolDown(X,Y: single; rightBtn: boolean): TRect;
ToolMovenull126     function ToolMove(X,Y: single): TRect;
ToolKeyDownnull127     function ToolKeyDown(var key: Word): TRect;
ToolKeyUpnull128     function ToolKeyUp(var key: Word): TRect;
ToolKeyPressnull129     function ToolKeyPress(var key: TUTF8Char): TRect; virtual;
ToolUpnull130     function ToolUp: TRect; virtual;
ToolCommandnull131     function ToolCommand({%H-}ACommand: TToolCommand): boolean; virtual;
ToolProvideCommandnull132     function ToolProvideCommand({%H-}ACommand: TToolCommand): boolean; virtual;
SuggestGradientBoxnull133     function SuggestGradientBox: TAffineBox; virtual;
GetContextualToolbarsnull134     function GetContextualToolbars: TContextualToolbars; virtual;
GetToolDrawingLayernull135     function GetToolDrawingLayer: TBGRABitmap;
136     procedure RestoreBackupDrawingLayer;
GetBackupLayerIfExistsnull137     function GetBackupLayerIfExists: TBGRABitmap;
Rendernull138     function Render(VirtualScreen: TBGRABitmap; VirtualScreenWidth, VirtualScreenHeight: integer; BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect; virtual;
139     property Manager : TToolManager read FManager;
140     property IsSelectingTool: boolean read GetIsSelectingTool;
141     property Action : TLayerAction read GetAction;
142     property LayerOffset : TPoint read GetLayerOffset;
143     property LastToolDrawingLayer: TBGRABitmap read FLastToolDrawingLayer;
144     property StatusText: string read GetStatusText;
145     property Validating: boolean read FValidating;
146     property Canceling: boolean read FCanceling;
147     property ForeUniversalBrush: TUniversalBrush read GetForeUniversalBrush;
148     property IsForeEditGradTexPoints: boolean read GetIsForeEditGradTexPoints;
149     property IsBackEditGradTexPoints: boolean read GetIsBackEditGradTexPoints;
150     property IsOutlineEditGradTexPoints: boolean read GetIsOutlineEditGradTexPoints;
151     property AllowedForeFillTypes: TVectorialFillTypes read GetAllowedForeFillTypes;
152     property AllowedBackFillTypes: TVectorialFillTypes read GetAllowedBackFillTypes;
153     property AllowedOutlineFillTypes: TVectorialFillTypes read GetAllowedOutlineFillTypes;
154   end;
155 
156   { TReadonlyTool }
157 
158   TReadonlyTool = class(TGenericTool)
159   protected
GetActionnull160     function GetAction: TLayerAction; override;
GetIsSelectingToolnull161     function GetIsSelectingTool: boolean; override;
DoGetToolDrawingLayernull162     function DoGetToolDrawingLayer: TBGRABitmap; override;
163   end;
164 
165   TToolClass = class of TGenericTool;
166 
167   TToolPopupMessage= (tpmNone, tpmHoldKeyForSquare, tpmHoldKeySnapToPixel,
168     tpmReturnValides, tpmBackspaceRemoveLastPoint, tpmHoldKeyRestrictRotation,
169     tpmHoldKeysScaleMode, tpmCurveModeHint, tpmBlendOpBackground,
170     tpmRightClickForSource, tpmNothingToBeDeformed);
171 
172   TOnToolChangedHandler = procedure(sender: TToolManager; ANewToolType: TPaintToolType) of object;
173   TOnPopupToolHandler = procedure(sender: TToolManager; APopupMessage: TToolPopupMessage; AKey: Word; AAlways: boolean) of object;
174   TOnQueryColorTargetHandler = procedure(sender: TToolManager; ATarget: TVectorialFill) of object;
175 
176   TShapeOption = (toAliasing, toDrawShape, toFillShape, toCloseShape);
177   TShapeOptions = set of TShapeOption;
178 
179   TFloodFillOption = (ffProgressive, ffFillAll);
180   TFloodFillOptions = set of TFloodFillOption;
181 
182   TPerspectiveOption = (poRepeat, poTwoPlanes);
183   TPerspectiveOptions = set of TPerspectiveOption;
184 
185   { TToolManager }
186 
187   TToolManager = class
188   private
189     FConfigProvider: IConfigProvider;
190     FOnQueryColorTarget: TOnQueryColorTargetHandler;
191     FShouldExitTool: boolean;
192     FImage: TLazPaintImage;
193     FBlackAndWhite: boolean;
194     FScriptContext: TScriptContext;
195     FToolPressure: single;
196     FInTool, FInToolUpdate, FInSwapFill: boolean;
197     FCurrentTool : TGenericTool;
198     FCurrentToolType : TPaintToolType;
199     FToolCurrentCursorPos: TPointF;
200     FSleepingTool: TGenericTool;
201     FSleepingToolType: TPaintToolType;
202     FReturnValidatesHintShown: boolean;
203     FOnToolChangedHandler: TOnToolChangedHandler;
204     FOnToolRenderChanged: TNotifyEvent;
205     FOnToolbarChanged: TNotifyEvent;
206     FOnPopupToolHandler: TOnPopupToolHandler;
207 
208     FForeFill, FBackFill, FOutlineFill: TVectorialFill;
209     FForeLastGradient, FBackLastGradient, FOutlineLastGradient: TBGRALayerGradientOriginal;
210     FEraserMode: TEraserMode;
211     FEraserAlpha: byte;
212     FBrushInfoList: TList;
213     FBrushInfoListChanged: boolean;
214     FBrushIndex: integer;
215     FBrushSpacing: integer;
216     FPenStyle: TPenStyle;
217     FJoinStyle: TPenJoinStyle;
218     FNormalPenWidth, FEraserWidth: Single;
219     FShapeOptions: TShapeOptions;
220     FTextFontName: string;
221     FTextFontSize: single;
222     FTextFontStyle: TFontStyles;
223     FTextAlign: TAlignment;
224     FTextOutline: boolean;
225     FTextOutlineWidth: single;
226     FTextPhong: boolean;
227     FLightPosition: TPointF;
228     FLightAltitude: integer;
229     FTextShadow: boolean;
230     FTextShadowBlurRadius: single;
231     FTextShadowOffset: TPoint;
232     FLineCap: TPenEndCap;
233     FArrowStart,FArrowEnd: TArrowKind;
234     FArrowSize: TPointF;
235     FSplineStyle: TSplineStyle;
236     FPhongShapeAltitude: integer;
237     FPhongShapeBorderSize: integer;
238     FPhongShapeKind: TPhongShapeKind;
239     FDeformationGridNbX,FDeformationGridNbY: integer;
240     FDeformationGridMode: TDeformationGridMode;
241     FTolerance: byte;
242     FFloodFillOptions: TFloodFillOptions;
243     FPerspectiveOptions: TPerspectiveOptions;
244     FShapeRatio: Single;
245 
246     FOnFillChanged: TNotifyEvent;
247     FOnEraserChanged: TNotifyEvent;
248     FOnJoinStyleChanged: TNotifyEvent;
249     FOnLineCapChanged: TNotifyEvent;
250     FOnPenStyleChanged: TNotifyEvent;
251     FOnPenWidthChanged: TNotifyEvent;
252     FOnBrushChanged, FOnBrushListChanged: TNotifyEvent;
253     FOnPhongShapeChanged: TNotifyEvent;
254     FOnSplineStyleChanged: TNotifyEvent;
255     FOnTextFontChanged, FOnTextAlignChanged: TNotifyEvent;
256     FOnTextOutlineChanged: TNotifyEvent;
257     FOnTextPhongChanged, FOnLightChanged: TNotifyEvent;
258     FOnTextShadowChanged: TNotifyEvent;
259     FOnShapeOptionChanged, FOnShapeRatioChanged: TNotifyEvent;
260     FOnDeformationGridChanged: TNotifyEvent;
261     FOnToleranceChanged: TNotifyEvent;
262     FOnFloodFillOptionChanged: TNotifyEvent;
263     FOnPerspectiveOptionChanged: TNotifyEvent;
264 
265     procedure FillChange(ASender: TObject;
266       var {%H-}ADiff: TCustomVectorialFillDiff);
GetAllowedBackFillTypesnull267     function GetAllowedBackFillTypes: TVectorialFillTypes;
GetAllowedForeFillTypesnull268     function GetAllowedForeFillTypes: TVectorialFillTypes;
GetAllowedOutlineFillTypesnull269     function GetAllowedOutlineFillTypes: TVectorialFillTypes;
GetCursornull270     function GetCursor: TCursor;
GetBackColornull271     function GetBackColor: TBGRAPixel;
GetBrushAtnull272     function GetBrushAt(AIndex: integer): TLazPaintBrush;
GetBrushCountnull273     function GetBrushCount: integer;
GetBrushInfonull274     function GetBrushInfo: TLazPaintBrush;
GetForeColornull275     function GetForeColor: TBGRAPixel;
GetMaxDeformationGridSizenull276     function GetMaxDeformationGridSize: TSize;
GetOutlineColornull277     function GetOutlineColor: TBGRAPixel;
GetShapeOptionAliasingnull278     function GetShapeOptionAliasing: boolean;
GetPenWidthnull279     function GetPenWidth: single;
GetToolSleepingnull280     function GetToolSleeping: boolean;
GetTextFontNamenull281     function GetTextFontName: string;
GetTextFontSizenull282     function GetTextFontSize: single;
GetTextFontStylenull283     function GetTextFontStyle: TFontStyles;
ScriptGetAliasingnull284     function ScriptGetAliasing(AVars: TVariableSet): TScriptResult;
ScriptGetArrowEndnull285     function ScriptGetArrowEnd(AVars: TVariableSet): TScriptResult;
ScriptGetArrowSizenull286     function ScriptGetArrowSize(AVars: TVariableSet): TScriptResult;
ScriptGetArrowStartnull287     function ScriptGetArrowStart(AVars: TVariableSet): TScriptResult;
ScriptGetBackColornull288     function ScriptGetBackColor(AVars: TVariableSet): TScriptResult;
ScriptGetOutlineColornull289     function ScriptGetOutlineColor(AVars: TVariableSet): TScriptResult;
ScriptGetBrushCountnull290     function ScriptGetBrushCount(AVars: TVariableSet): TScriptResult;
ScriptGetBrushIndexnull291     function ScriptGetBrushIndex(AVars: TVariableSet): TScriptResult;
ScriptGetBrushSpacingnull292     function ScriptGetBrushSpacing(AVars: TVariableSet): TScriptResult;
ScriptGetDeformationGridModenull293     function ScriptGetDeformationGridMode(AVars: TVariableSet): TScriptResult;
ScriptGetDeformationGridSizenull294     function ScriptGetDeformationGridSize(AVars: TVariableSet): TScriptResult;
ScriptGetEraserAlphanull295     function ScriptGetEraserAlpha(AVars: TVariableSet): TScriptResult;
ScriptGetEraserModenull296     function ScriptGetEraserMode(AVars: TVariableSet): TScriptResult;
ScriptGetFloodFillOptionsnull297     function ScriptGetFloodFillOptions(AVars: TVariableSet): TScriptResult;
ScriptGetFontNamenull298     function ScriptGetFontName(AVars: TVariableSet): TScriptResult;
ScriptGetFontSizenull299     function ScriptGetFontSize(AVars: TVariableSet): TScriptResult;
ScriptGetFontStylenull300     function ScriptGetFontStyle(AVars: TVariableSet): TScriptResult;
ScriptGetGradientInterpolationnull301     function ScriptGetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptGetGradientRepetitionnull302     function ScriptGetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptGetGradientTypenull303     function ScriptGetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptGetGradientColorsnull304     function ScriptGetGradientColors(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptGetBackGradientInterpolationnull305     function ScriptGetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
ScriptGetBackGradientRepetitionnull306     function ScriptGetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
ScriptGetBackGradientTypenull307     function ScriptGetBackGradientType(AVars: TVariableSet): TScriptResult;
ScriptGetBackGradientColorsnull308     function ScriptGetBackGradientColors(AVars: TVariableSet): TScriptResult;
ScriptGetForeGradientInterpolationnull309     function ScriptGetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
ScriptGetForeGradientRepetitionnull310     function ScriptGetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
ScriptGetForeGradientTypenull311     function ScriptGetForeGradientType(AVars: TVariableSet): TScriptResult;
ScriptGetForeGradientColorsnull312     function ScriptGetForeGradientColors(AVars: TVariableSet): TScriptResult;
ScriptGetOutlineGradientInterpolationnull313     function ScriptGetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
ScriptGetOutlineGradientRepetitionnull314     function ScriptGetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
ScriptGetOutlineGradientTypenull315     function ScriptGetOutlineGradientType(AVars: TVariableSet): TScriptResult;
ScriptGetOutlineGradientColorsnull316     function ScriptGetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
ScriptGetTextureRepetitionnull317     function ScriptGetTextureRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptGetTextureOpacitynull318     function ScriptGetTextureOpacity(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptGetBackTextureRepetitionnull319     function ScriptGetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
ScriptGetBackTextureOpacitynull320     function ScriptGetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
ScriptGetForeTextureRepetitionnull321     function ScriptGetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
ScriptGetForeTextureOpacitynull322     function ScriptGetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
ScriptGetOutlineTextureRepetitionnull323     function ScriptGetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
ScriptGetOutlineTextureOpacitynull324     function ScriptGetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
ScriptGetJoinStylenull325     function ScriptGetJoinStyle(AVars: TVariableSet): TScriptResult;
ScriptGetLightPositionnull326     function ScriptGetLightPosition(AVars: TVariableSet): TScriptResult;
ScriptGetLineCapnull327     function ScriptGetLineCap(AVars: TVariableSet): TScriptResult;
ScriptGetForeColornull328     function ScriptGetForeColor(AVars: TVariableSet): TScriptResult;
ScriptGetPenStylenull329     function ScriptGetPenStyle(AVars: TVariableSet): TScriptResult;
ScriptGetPenWidthnull330     function ScriptGetPenWidth(AVars: TVariableSet): TScriptResult;
ScriptGetPerspectiveOptionsnull331     function ScriptGetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
ScriptGetPhongShapeAltitudenull332     function ScriptGetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
ScriptGetPhongShapeBorderSizenull333     function ScriptGetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
ScriptGetPhongShapeKindnull334     function ScriptGetPhongShapeKind(AVars: TVariableSet): TScriptResult;
ScriptGetShapeOptionsnull335     function ScriptGetShapeOptions(AVars: TVariableSet): TScriptResult;
ScriptGetShapeRationull336     function ScriptGetShapeRatio(AVars: TVariableSet): TScriptResult;
ScriptGetSplineStylenull337     function ScriptGetSplineStyle(AVars: TVariableSet): TScriptResult;
ScriptGetTextAlignnull338     function ScriptGetTextAlign(AVars: TVariableSet): TScriptResult;
ScriptGetTextOutlinenull339     function ScriptGetTextOutline(AVars: TVariableSet): TScriptResult;
ScriptGetTextPhongnull340     function ScriptGetTextPhong(AVars: TVariableSet): TScriptResult;
ScriptGetTolerancenull341     function ScriptGetTolerance(AVars: TVariableSet): TScriptResult;
ScriptSetAliasingnull342     function ScriptSetAliasing(AVars: TVariableSet): TScriptResult;
ScriptSetArrowEndnull343     function ScriptSetArrowEnd(AVars: TVariableSet): TScriptResult;
ScriptSetArrowSizenull344     function ScriptSetArrowSize(AVars: TVariableSet): TScriptResult;
ScriptSetArrowStartnull345     function ScriptSetArrowStart(AVars: TVariableSet): TScriptResult;
ScriptSetBackColornull346     function ScriptSetBackColor(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineColornull347     function ScriptSetOutlineColor(AVars: TVariableSet): TScriptResult;
ScriptSetBrushIndexnull348     function ScriptSetBrushIndex(AVars: TVariableSet): TScriptResult;
ScriptSetBrushSpacingnull349     function ScriptSetBrushSpacing(AVars: TVariableSet): TScriptResult;
ScriptSetDeformationGridModenull350     function ScriptSetDeformationGridMode(AVars: TVariableSet): TScriptResult;
ScriptSetDeformationGridSizenull351     function ScriptSetDeformationGridSize(AVars: TVariableSet): TScriptResult;
ScriptSetEraserAlphanull352     function ScriptSetEraserAlpha(AVars: TVariableSet): TScriptResult;
ScriptSetEraserModenull353     function ScriptSetEraserMode(AVars: TVariableSet): TScriptResult;
ScriptSetFloodFillOptionsnull354     function ScriptSetFloodFillOptions(AVars: TVariableSet): TScriptResult;
ScriptSetFontNamenull355     function ScriptSetFontName(AVars: TVariableSet): TScriptResult;
ScriptSetFontSizenull356     function ScriptSetFontSize(AVars: TVariableSet): TScriptResult;
ScriptSetFontStylenull357     function ScriptSetFontStyle(AVars: TVariableSet): TScriptResult;
ScriptSetGradientInterpolationnull358     function ScriptSetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptSetGradientRepetitionnull359     function ScriptSetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptSetGradientTypenull360     function ScriptSetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptSetGradientColorsnull361     function ScriptSetGradientColors(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptSetBackGradientInterpolationnull362     function ScriptSetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
ScriptSetBackGradientRepetitionnull363     function ScriptSetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
ScriptSetBackGradientTypenull364     function ScriptSetBackGradientType(AVars: TVariableSet): TScriptResult;
ScriptSetBackGradientColorsnull365     function ScriptSetBackGradientColors(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineGradientInterpolationnull366     function ScriptSetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineGradientRepetitionnull367     function ScriptSetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineGradientTypenull368     function ScriptSetOutlineGradientType(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineGradientColorsnull369     function ScriptSetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
ScriptSetForeGradientInterpolationnull370     function ScriptSetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
ScriptSetForeGradientRepetitionnull371     function ScriptSetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
ScriptSetForeGradientTypenull372     function ScriptSetForeGradientType(AVars: TVariableSet): TScriptResult;
ScriptSetForeGradientColorsnull373     function ScriptSetForeGradientColors(AVars: TVariableSet): TScriptResult;
ScriptSetTexturenull374     function ScriptSetTexture(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptSetTextureRepetitionnull375     function ScriptSetTextureRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptSetTextureOpacitynull376     function ScriptSetTextureOpacity(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
ScriptSetBackTexturenull377     function ScriptSetBackTexture(AVars: TVariableSet): TScriptResult;
ScriptSetBackTextureRepetitionnull378     function ScriptSetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
ScriptSetBackTextureOpacitynull379     function ScriptSetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
ScriptSetForeTexturenull380     function ScriptSetForeTexture(AVars: TVariableSet): TScriptResult;
ScriptSetForeTextureRepetitionnull381     function ScriptSetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
ScriptSetForeTextureOpacitynull382     function ScriptSetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineTexturenull383     function ScriptSetOutlineTexture(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineTextureRepetitionnull384     function ScriptSetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
ScriptSetOutlineTextureOpacitynull385     function ScriptSetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
ScriptSetJoinStylenull386     function ScriptSetJoinStyle(AVars: TVariableSet): TScriptResult;
ScriptSetLightPositionnull387     function ScriptSetLightPosition(AVars: TVariableSet): TScriptResult;
ScriptSetLineCapnull388     function ScriptSetLineCap(AVars: TVariableSet): TScriptResult;
ScriptSetForeColornull389     function ScriptSetForeColor(AVars: TVariableSet): TScriptResult;
ScriptSetPenStylenull390     function ScriptSetPenStyle(AVars: TVariableSet): TScriptResult;
ScriptSetPenWidthnull391     function ScriptSetPenWidth(AVars: TVariableSet): TScriptResult;
ScriptSetPerspectiveOptionsnull392     function ScriptSetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
ScriptSetPhongShapeAltitudenull393     function ScriptSetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
ScriptSetPhongShapeBorderSizenull394     function ScriptSetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
ScriptSetPhongShapeKindnull395     function ScriptSetPhongShapeKind(AVars: TVariableSet): TScriptResult;
ScriptSetShapeOptionsnull396     function ScriptSetShapeOptions(AVars: TVariableSet): TScriptResult;
ScriptSetShapeRationull397     function ScriptSetShapeRatio(AVars: TVariableSet): TScriptResult;
ScriptSetSplineStylenull398     function ScriptSetSplineStyle(AVars: TVariableSet): TScriptResult;
ScriptSetTextAlignnull399     function ScriptSetTextAlign(AVars: TVariableSet): TScriptResult;
ScriptSetTextOutlinenull400     function ScriptSetTextOutline(AVars: TVariableSet): TScriptResult;
ScriptSetTextPhongnull401     function ScriptSetTextPhong(AVars: TVariableSet): TScriptResult;
ScriptSetTolerancenull402     function ScriptSetTolerance(AVars: TVariableSet): TScriptResult;
403     procedure SetBrushIndex(AValue: integer);
404     procedure SetBrushSpacing(AValue: integer);
SetControlsVisiblenull405     function SetControlsVisible(AControls: TList; AVisible: Boolean; AName: string = ''): boolean;
406     procedure SetArrowEnd(AValue: TArrowKind);
407     procedure SetArrowSize(AValue: TPointF);
408     procedure SetArrowStart(AValue: TArrowKind);
409     procedure SetBackColor(AValue: TBGRAPixel);
410     procedure SetDeformationGridMode(AValue: TDeformationGridMode);
411     procedure SetEraserAlpha(AValue: byte);
412     procedure SetEraserMode(AValue: TEraserMode);
413     procedure SetFloodFillOptions(AValue: TFloodFillOptions);
414     procedure SetForeColor(AValue: TBGRAPixel);
415     procedure SetJoinStyle(AValue: TPenJoinStyle);
416     procedure SetLightAltitude(AValue: integer);
417     procedure SetLightPosition(AValue: TPointF);
418     procedure SetLineCap(AValue: TPenEndCap);
419     procedure SetOnQueryColorTarget(AValue: TOnQueryColorTargetHandler);
420     procedure SetOutlineColor(AValue: TBGRAPixel);
421     procedure SetPerspectiveOptions(AValue: TPerspectiveOptions);
422     procedure SetPhongShapeAltitude(AValue: integer);
423     procedure SetPhongShapeBorderSize(AValue: integer);
424     procedure SetPhongShapeKind(AValue: TPhongShapeKind);
425     procedure SetShapeOptions(AValue: TShapeOptions);
426     procedure SetPenStyle(AValue: TPenStyle);
427     procedure SetPenWidth(AValue: single);
428     procedure SetShapeRatio(AValue: Single);
429     procedure SetSplineStyle(AValue: TSplineStyle);
430     procedure SetTextAlign(AValue: TAlignment);
431     procedure SetTextPhong(AValue: boolean);
432     procedure SetTextShadow(AValue: boolean);
433     procedure SetTextShadowBlurRadius(AValue: single);
434     procedure SetTextShadowOffset(AValue: TPoint);
435     procedure SetTolerance(AValue: byte);
436     procedure ToolCloseAndReopenImmediatly;
437   protected
CheckExitToolnull438     function CheckExitTool: boolean;
439     procedure NotifyImageOrSelectionChanged(ALayer: TBGRABitmap; ARect: TRect);
440     procedure InternalSetCurrentToolType(tool: TPaintToolType);
InternalBitmapToVirtualScreennull441     function InternalBitmapToVirtualScreen(PtF: TPointF): TPointF;
AddLayerOffsetnull442     function AddLayerOffset(ARect: TRect) : TRect;
443     procedure RegisterScriptFunctions(ARegister: boolean);
444   public
445     BitmapToVirtualScreen: TBitmapToVirtualScreenFunction;
PenWidthControlsnull446     PenWidthControls, AliasingControls, EraserControls, ToleranceControls,
447     ShapeControls, PenStyleControls, JoinStyleControls, SplineStyleControls,
448     CloseShapeControls, LineCapControls, DeformationControls,
449     TextControls, TextShadowControls, PhongControls, AltitudeControls,
450     PerspectiveControls,FillControls,OutlineFillControls,
451     BrushControls, RatioControls, DonateControls: TList;
452     CanvasScale: integer;
453 
454     constructor Create(AImage: TLazPaintImage; AConfigProvider: IConfigProvider;
455       ABitmapToVirtualScreen: TBitmapToVirtualScreenFunction = nil;
456       ABlackAndWhite : boolean = false;
457       AScriptContext: TScriptContext = nil);
458     destructor Destroy; override;
459     procedure LoadFromConfig;
460     procedure SaveToConfig;
461     procedure ReloadBrushes;
462     procedure SaveBrushes;
ApplyPressurenull463     function ApplyPressure(AColor: TBGRAPixel): TBGRAPixel;
ApplyPressurenull464     function ApplyPressure(AOpacity: byte): byte;
465     procedure SetPressure(APressure: single);
GetPressureBnull466     function GetPressureB: Byte;
467     procedure StepPenSize(ADecrease: boolean);
468 
GetCurrentToolTypenull469     function GetCurrentToolType: TPaintToolType;
SetCurrentToolTypenull470     function SetCurrentToolType(tool: TPaintToolType): boolean;
UpdateContextualToolbarsnull471     function UpdateContextualToolbars: boolean;
GetContextualToolbarsnull472     function GetContextualToolbars: TContextualToolbars;
ToolCanBeUsednull473     function ToolCanBeUsed: boolean;
ToolHasLineCapnull474     function ToolHasLineCap: boolean;
475     procedure ToolWakeUp;
476     procedure ToolSleep;
477 
ToolDownnull478     function ToolDown(X,Y: single; ARightBtn: boolean; APressure: single): boolean; overload;
ToolMovenull479     function ToolMove(X,Y: single; APressure: single): boolean; overload;
ToolDownnull480     function ToolDown(ACoord: TPointF; ARightBtn: boolean; APressure: single): boolean; overload;
ToolMovenull481     function ToolMove(ACoord: TPointF; APressure: single): boolean; overload;
ToolKeyDownnull482     function ToolKeyDown(var key: Word): boolean;
ToolKeyUpnull483     function ToolKeyUp(var key: Word): boolean;
ToolKeyPressnull484     function ToolKeyPress(var key: TUTF8Char): boolean;
ToolCommandnull485     function ToolCommand(ACommand: TToolCommand): boolean; virtual;
ToolProvideCommandnull486     function ToolProvideCommand(ACommand: TToolCommand): boolean; virtual;
ToolUpnull487     function ToolUp: boolean;
488     procedure ToolCloseDontReopen;
489     procedure ToolOpen;
ToolUpdatenull490     function ToolUpdate: boolean;
ToolUpdateNeedednull491     function ToolUpdateNeeded: boolean;
492     procedure ToolPopup(AMessage: TToolPopupMessage; AKey: Word = 0; AAlways: boolean = false);
493     procedure HintReturnValidates;
494 
IsSelectingToolnull495     function IsSelectingTool: boolean;
DisplayFilledSelectionnull496     function DisplayFilledSelection: boolean;
IsForeEditGradTexPointsnull497     function IsForeEditGradTexPoints: boolean;
IsBackEditGradTexPointsnull498     function IsBackEditGradTexPoints: boolean;
IsOutlineEditGradTexPointsnull499     function IsOutlineEditGradTexPoints: boolean;
500     procedure QueryExitTool;
501     procedure QueryColorTarget(ATarget: TVectorialFill);
502 
RenderToolnull503     function RenderTool(formBitmap: TBGRABitmap): TRect;
GetRenderBoundsnull504     function GetRenderBounds(VirtualScreenWidth, VirtualScreenHeight: integer): TRect;
SuggestGradientBoxnull505     function SuggestGradientBox: TAffineBox;
506 
SwapToolColorsnull507     function SwapToolColors: boolean;
508     procedure NeedBackGradient;
509     procedure NeedForeGradient;
510     procedure NeedOutlineGradient;
511     procedure AddBrush(brush: TLazPaintBrush);
512     procedure RemoveBrushAt(index: integer);
513     procedure SetTextFont(AName: string; ASize: single; AStyle: TFontStyles);
514     procedure SetTextFont(AFont: TFont);
515     procedure SetTextOutline(AEnabled: boolean; AWidth: single);
GetDeformationGridSizenull516     function GetDeformationGridSize: TSize;
517     procedure SetDeformationGridSize(ASize: TSize);
518 
519     property Image: TLazPaintImage read FImage;
520     property Scripting: TScriptContext read FScriptContext;
521     property BlackAndWhite: boolean read FBlackAndWhite write FBlackAndWhite;
522     property CurrentTool: TGenericTool read FCurrentTool;
523     property ToolCurrentCursorPos: TPointF read FToolCurrentCursorPos;
524     property ToolSleeping: boolean read GetToolSleeping;
525     property Cursor: TCursor read GetCursor;
526 
527     property ForeFill: TVectorialFill read FForeFill;
528     property AllowedForeFillTypes: TVectorialFillTypes read GetAllowedForeFillTypes;
529     property BackFill: TVectorialFill read FBackFill;
530     property AllowedBackFillTypes: TVectorialFillTypes read GetAllowedBackFillTypes;
531     property OutlineFill: TVectorialFill read FOutlineFill;
532     property AllowedOutlineFillTypes: TVectorialFillTypes read GetAllowedOutlineFillTypes;
533     property ForeColor: TBGRAPixel read GetForeColor write SetForeColor;
534     property BackColor: TBGRAPixel read GetBackColor write SetBackColor;
535     property OutlineColor: TBGRAPixel read GetOutlineColor write SetOutlineColor;
536     property ForeLastGradient: TBGRALayerGradientOriginal read FForeLastGradient;
537     property BackLastGradient: TBGRALayerGradientOriginal read FBackLastGradient;
538     property OutlineLastGradient: TBGRALayerGradientOriginal read FOutlineLastGradient;
539     property EraserMode: TEraserMode read FEraserMode write SetEraserMode;
540     property EraserAlpha: byte read FEraserAlpha write SetEraserAlpha;
541     property PenWidth: single read GetPenWidth write SetPenWidth;
542     property PenStyle: TPenStyle read FPenStyle write SetPenStyle;
543     property JoinStyle: TPenJoinStyle read FJoinStyle write SetJoinStyle;
544     property ShapeOptions: TShapeOptions read FShapeOptions write SetShapeOptions;
545     property ShapeOptionAliasing: boolean read GetShapeOptionAliasing;
546     property ShapeRatio: Single read FShapeRatio write SetShapeRatio;
547     property BrushInfo: TLazPaintBrush read GetBrushInfo;
548     property BrushAt[AIndex: integer]: TLazPaintBrush read GetBrushAt;
549     property BrushCount: integer read GetBrushCount;
550     property BrushIndex: integer read FBrushIndex write SetBrushIndex;
551     property BrushSpacing: integer read FBrushSpacing write SetBrushSpacing;
552     property TextFontName: string read GetTextFontName;
553     property TextFontSize: single read GetTextFontSize;
554     property TextFontStyle: TFontStyles read GetTextFontStyle;
555     property TextAlign: TAlignment read FTextAlign write SetTextAlign;
556     property TextOutline: boolean read FTextOutline;
557     property TextOutlineWidth: single read FTextOutlineWidth;
558     property TextPhong: boolean read FTextPhong write SetTextPhong;
559     property LightPosition: TPointF read FLightPosition write SetLightPosition;
560     property LightAltitude: integer read FLightAltitude write SetLightAltitude;
561     property TextShadow: boolean read FTextShadow write SetTextShadow;
562     property TextShadowBlurRadius: single read FTextShadowBlurRadius write SetTextShadowBlurRadius;
563     property TextShadowOffset: TPoint read FTextShadowOffset write SetTextShadowOffset;
564     property LineCap: TPenEndCap read FLineCap write SetLineCap;
565     property ArrowStart: TArrowKind read FArrowStart write SetArrowStart;
566     property ArrowEnd: TArrowKind read FArrowEnd write SetArrowEnd;
567     property ArrowSize: TPointF read FArrowSize write SetArrowSize;
568     property SplineStyle: TSplineStyle read FSplineStyle write SetSplineStyle;
569     property PhongShapeAltitude: integer read FPhongShapeAltitude write SetPhongShapeAltitude;
570     property PhongShapeBorderSize: integer read FPhongShapeBorderSize write SetPhongShapeBorderSize;
571     property PhongShapeKind: TPhongShapeKind read FPhongShapeKind write SetPhongShapeKind;
572     property DeformationGridNbX: integer read FDeformationGridNbX;
573     property DeformationGridNbY: integer read FDeformationGridNbY;
574     property DeformationGridSize: TSize read GetDeformationGridSize write SetDeformationGridSize;
575     property MaxDeformationGridSize: TSize read GetMaxDeformationGridSize;
576     property DeformationGridMode: TDeformationGridMode read FDeformationGridMode write SetDeformationGridMode;
577     property Tolerance: byte read FTolerance write SetTolerance;
578     property FloodFillOptions: TFloodFillOptions read FFloodFillOptions write SetFloodFillOptions;
579     property PerspectiveOptions: TPerspectiveOptions read FPerspectiveOptions write SetPerspectiveOptions;
580 
581     property OnToolChanged: TOnToolChangedHandler read FOnToolChangedHandler write FOnToolChangedHandler;
582     property OnToolRenderChanged: TNotifyEvent read FOnToolRenderChanged write FOnToolRenderChanged;
583     property OnToolbarChanged: TNotifyEvent read FOnToolbarChanged write FOnToolbarChanged;
584     property OnPopup: TOnPopupToolHandler read FOnPopupToolHandler write FOnPopupToolHandler;
585     property OnEraserChanged: TNotifyEvent read FOnEraserChanged write FOnEraserChanged;
586     property OnFillChanged: TNotifyEvent read FOnFillChanged write FOnFillChanged;
587     property OnQueryColorTarget: TOnQueryColorTargetHandler read FOnQueryColorTarget write SetOnQueryColorTarget;
588     property OnPenWidthChanged: TNotifyEvent read FOnPenWidthChanged write FOnPenWidthChanged;
589     property OnBrushChanged: TNotifyEvent read FOnBrushChanged write FOnBrushChanged;
590     property OnBrushListChanged: TNotifyEvent read FOnBrushListChanged write FOnBrushListChanged;
591     property OnPenStyleChanged: TNotifyEvent read FOnPenStyleChanged write FOnPenStyleChanged;
592     property OnJoinStyleChanged: TNotifyEvent read FOnJoinStyleChanged write FOnJoinStyleChanged;
593     property OnShapeOptionChanged: TNotifyEvent read FOnShapeOptionChanged write FOnShapeOptionChanged;
594     property OnShapeRatioChanged: TNotifyEvent read FOnShapeRatioChanged write FOnShapeRatioChanged;
595     property OnTextFontChanged: TNotifyEvent read FOnTextFontChanged write FOnTextFontChanged;
596     property OnTextAlignChanged: TNotifyEvent read FOnTextAlignChanged write FOnTextAlignChanged;
597     property OnTextOutlineChanged: TNotifyEvent read FOnTextOutlineChanged write FOnTextOutlineChanged;
598     property OnTextPhongChanged: TNotifyEvent read FOnTextPhongChanged write FOnTextPhongChanged;
599     property OnLightChanged: TNotifyEvent read FOnLightChanged write FOnLightChanged;
600     property OnTextShadowChanged: TNotifyEvent read FOnTextShadowChanged write FOnTextShadowChanged;
601     property OnLineCapChanged: TNotifyEvent read FOnLineCapChanged write FOnLineCapChanged;
602     property OnSplineStyleChanged: TNotifyEvent read FOnSplineStyleChanged write FOnSplineStyleChanged;
603     property OnPhongShapeChanged: TNotifyEvent read FOnPhongShapeChanged write FOnPhongShapeChanged;
604     property OnDeformationGridChanged: TNotifyEvent read FOnDeformationGridChanged write FOnDeformationGridChanged;
605     property OnToleranceChanged: TNotifyEvent read FOnToleranceChanged write FOnToleranceChanged;
606     property OnFloodFillOptionChanged: TNotifyEvent read FOnFloodFillOptionChanged write FOnFloodFillOptionChanged;
607     property OnPerspectiveOptionChanged: TNotifyEvent read FOnPerspectiveOptionChanged write FOnPerspectiveOptionChanged;
608   end;
609 
610 procedure RegisterTool(ATool: TPaintToolType; AClass: TToolClass);
ToolPopupMessageToStrnull611 function ToolPopupMessageToStr(AMessage :TToolPopupMessage; AKey: Word = 0): string;
612 
613 implementation
614 
615 uses UGraph, LCScaleDPI, LazPaintType, UCursors, BGRATextFX, ULoading, UResourceStrings,
616   BGRATransform, LCVectorOriginal, BGRASVGOriginal, math, ULoadImage, LCVectorTextShapes;
617 
StrToPaintToolTypenull618 function StrToPaintToolType(const s: ansistring): TPaintToolType;
619 var pt: TPaintToolType;
620     ls: ansistring;
621 begin
622   result := ptHand;
623   ls:= LowerCase(s);
624   for pt := low(TPaintToolType) to high(TPaintToolType) do
625     if ls = LowerCase(PaintToolTypeStr[pt]) then
626     begin
627       result := pt;
628       break;
629     end;
630 end;
631 
GradientInterpolationToDisplaynull632 function GradientInterpolationToDisplay(AValue: TBGRAColorInterpolation): string;
633 begin
634   case AValue of
635     ciLinearRGB: result := rsLinearRGB;
636     ciLinearHSLPositive: result := rsHueCW;
637     ciLinearHSLNegative: result := rsHueCCW;
638     ciGSBPositive: result := rsCorrectedHueCW;
639     ciGSBNegative: result := rsCorrectedHueCCW;
640   else
641     result := rsRGB;
642   end;
643 end;
644 
DisplayToGradientInterpolationnull645 function DisplayToGradientInterpolation(AValue: string): TBGRAColorInterpolation;
646 begin
647   if AValue=rsLinearRGB then result := ciLinearRGB else
648   if AValue=rsHueCW then result := ciLinearHSLPositive else
649   if AValue=rsHueCCW then result := ciLinearHSLNegative else
650   if AValue=rsCorrectedHueCW then result := ciGSBPositive else
651   if AValue=rsCorrectedHueCCW then result := ciGSBNegative
652   else
653     result := ciStdRGB;
654 end;
655 
GradientInterpolationToStrnull656 function GradientInterpolationToStr(AValue: TBGRAColorInterpolation): string;
657 begin
658   case AValue of
659     ciStdRGB: result := 'StdRGB';
660     ciLinearHSLPositive: result := 'LinearHSLPositive';
661     ciLinearHSLNegative: result := 'LinearHSLNegative';
662     ciGSBPositive: result := 'GSBPositive';
663     ciGSBNegative: result := 'GSBNegative';
664   else
665     result := 'LinearRGB';
666   end;
667 end;
668 
StrToGradientInterpolationnull669 function StrToGradientInterpolation(AValue: string): TBGRAColorInterpolation;
670 begin
671   if AValue='StdRGB' then result := ciStdRGB else
672   if AValue='LinearHSLPositive' then result := ciLinearHSLPositive else
673   if AValue='LinearHSLNegative' then result := ciLinearHSLNegative else
674   if AValue='GSBPositive' then result := ciGSBPositive else
675   if AValue='GSBNegative' then result := ciGSBNegative
676   else
677     result := ciLinearRGB;
678 end;
679 
GradientRepetitionToStrnull680 function GradientRepetitionToStr(AValue: TBGRAGradientRepetition): string;
681 begin
682   case AValue of
683     grRepeat: result:= 'Repeat';
684     grReflect: result:= 'Reflect';
685     grSine: result:= 'Sine';
686     else result := 'Pad';
687   end;
688 end;
689 
StrToGradientRepetitionnull690 function StrToGradientRepetition(AValue: string): TBGRAGradientRepetition;
691 begin
692   case AValue of
693     'Repeat': result:= grRepeat;
694     'Reflect': result:= grReflect;
695     'Sine': result:= grSine;
696     else result := grPad;
697   end;
698 end;
699 
GradientToConfigStrnull700 function GradientToConfigStr(AGradient: TBGRALayerGradientOriginal): string;
701 var
702   vars: TVariableSet;
703 begin
704   vars := TVariableSet.Create('');
705   vars.Pixels['StartColor'] := AGradient.StartColor;
706   vars.Pixels['EndColor'] := AGradient.EndColor;
707   vars.Strings['GradientType'] := GradientTypeStr[AGradient.GradientType];
708   vars.Strings['ColorInterpolation'] := GradientInterpolationToStr(AGradient.ColorInterpolation);
709   vars.Strings['Repetition'] := GradientRepetitionToStr(AGradient.Repetition);
710   result := vars.VariablesAsString;
711   vars.Free;
712 end;
713 
714 procedure AssignGradientFromConfigStr(AGradient: TBGRALayerGradientOriginal; AValue: string);
715 var
716   vars: TVariableSet;
717 begin
718   vars := TVariableSet.Create('', AValue);
719   if vars.IsDefined('StartColor') then AGradient.StartColor := vars.Pixels['StartColor'];
720   if vars.IsDefined('EndColor') then AGradient.EndColor := vars.Pixels['EndColor'];
721   if vars.IsDefined('GradientType') then AGradient.GradientType := StrToGradientType(vars.Strings['GradientType']);
722   if vars.IsDefined('ColorInterpolation') then AGradient.ColorInterpolation := StrToGradientInterpolation(vars.Strings['ColorInterpolation']);
723   if vars.IsDefined('Repetition') then AGradient.Repetition := StrToGradientRepetition(vars.Strings['Repetition']);
724   vars.Free;
725 end;
726 
727 var
728    PaintTools: array[TPaintToolType] of TToolClass;
729 
730 procedure RegisterTool(ATool: TPaintToolType; AClass: TToolClass);
731 begin
732   PaintTools[ATool] := AClass;
733 end;
734 
ReplaceKeynull735 function ReplaceKey(AText: string; AKey: Word; AParam: integer = 1): string;
736 begin
737   if AKey = VK_SHIFT then result := StringReplace(AText, '%'+inttostr(AParam), rsShift, []) else
738   if AKey = VK_CONTROL then result := StringReplace(AText, '%'+inttostr(AParam), {$IFDEF DARWIN}rsCmd{$ELSE}rsCtrl{$ENDIF}, []) else
739   if AKey = VK_MENU then result := StringReplace(AText, '%'+inttostr(AParam), rsAlt, []) else
740     result := AText;
741 
742 end;
743 
ToolPopupMessageToStrnull744 function ToolPopupMessageToStr(AMessage: TToolPopupMessage; AKey: Word = 0): string;
745 begin
746   case AMessage of
747   tpmHoldKeyForSquare: result := ReplaceKey(rsHoldKeyForSquare, AKey);
748   tpmHoldKeySnapToPixel: result := ReplaceKey(rsHoldKeySnapToPixel, AKey);
749   tpmReturnValides: result := rsReturnValides;
750   tpmBackspaceRemoveLastPoint: result := rsBackspaceRemoveLastPoint;
751   tpmHoldKeyRestrictRotation: result := ReplaceKey(rsHoldKeyRestrictRotation, AKey);
752   tpmHoldKeysScaleMode: result := ReplaceKey(ReplaceKey(rsHoldKeysScaleMode, AKey, 2), VK_MENU);
753   tpmCurveModeHint: result := rsCurveModeHint;
754   tpmBlendOpBackground: result := rsBlendOpNotUsedForBackground;
755   tpmRightClickForSource: result := rsRightClickForSource;
756   tpmNothingToBeDeformed: result := rsNothingToBeDeformed;
757   else
758     result := '';
759   end;
760 end;
761 
762 { TReadonlyTool }
763 
GetActionnull764 function TReadonlyTool.GetAction: TLayerAction;
765 begin
766   Result:= nil;
767 end;
768 
GetIsSelectingToolnull769 function TReadonlyTool.GetIsSelectingTool: boolean;
770 begin
771   result := false;
772 end;
773 
TReadonlyTool.DoGetToolDrawingLayernull774 function TReadonlyTool.DoGetToolDrawingLayer: TBGRABitmap;
775 begin
776   if Manager.Image.SelectionMaskEmpty or not assigned(Manager.Image.SelectionLayerReadonly) then
777     Result:= Manager.Image.CurrentLayerReadOnly
778   else
779     Result:= Manager.Image.SelectionLayerReadonly;
780 end;
781 
782 procedure TToolManager.HintReturnValidates;
783 begin
784   if not FReturnValidatesHintShown then
785   begin
786     ToolPopup(tpmReturnValides);
787     FReturnValidatesHintShown:= true;
788   end;
789 end;
790 
791 { TGenericTool }
792 
793 {$hints off}
794 
GetLayerOffsetnull795 function TGenericTool.GetLayerOffset: TPoint;
796 begin
797   if IsSelectingTool or not Assigned(Manager.Image) then
798     result := Point(0,0)
799   else
800     if GetToolDrawingLayer = Manager.Image.CurrentLayerReadOnly then
801       result := Manager.Image.LayerOffset[Manager.Image.CurrentLayerIndex]
802     else
803       result := Point(0,0);
804 end;
805 
GetUniversalBrushnull806 function TGenericTool.GetUniversalBrush(ASource: TVectorialFill;
807   var ADest: TVectorialFill; var AScan: TBGRACustomScanner): TUniversalBrush;
808 begin
809   FreeAndNil(AScan);
810   FreeAndNil(ADest);
811   case ASource.FillType of
812   vftNone: TBGRABitmap.IdleBrush(result);
813   vftSolid: TBGRABitmap.SolidBrush(result, Manager.ApplyPressure(ASource.SolidColor));
814   else
815     begin
816       ADest := ASource.Duplicate;
817       ADest.FitGeometry(TAffineBox.AffineBox(RectF(0,0,Manager.Image.Width,Manager.Image.Height)));
818       ADest.ApplyOpacity(Manager.GetPressureB);
819       AScan := ADest.CreateScanner(AffineMatrixIdentity, false);
820       TBGRABitmap.ScannerBrush(result, AScan);
821     end;
822   end;
823 end;
824 
TGenericTool.GetAllowedBackFillTypesnull825 function TGenericTool.GetAllowedBackFillTypes: TVectorialFillTypes;
826 begin
827   result := [vftSolid,vftGradient,vftTexture];
828 end;
829 
TGenericTool.GetAllowedForeFillTypesnull830 function TGenericTool.GetAllowedForeFillTypes: TVectorialFillTypes;
831 begin
832   result := [vftSolid,vftGradient,vftTexture];
833 end;
834 
TGenericTool.GetAllowedOutlineFillTypesnull835 function TGenericTool.GetAllowedOutlineFillTypes: TVectorialFillTypes;
836 begin
837   result := [vftSolid,vftGradient,vftTexture];
838 end;
839 
GetIsBackEditGradTexPointsnull840 function TGenericTool.GetIsBackEditGradTexPoints: boolean;
841 begin
842   result := false;
843 end;
844 
GetIsOutlineEditGradTexPointsnull845 function TGenericTool.GetIsOutlineEditGradTexPoints: boolean;
846 begin
847   result := false;
848 end;
849 
GetIsForeEditGradTexPointsnull850 function TGenericTool.GetIsForeEditGradTexPoints: boolean;
851 begin
852   result := false;
853 end;
854 
TGenericTool.GetForeUniversalBrushnull855 function TGenericTool.GetForeUniversalBrush: TUniversalBrush;
856 begin
857   result := GetUniversalBrush(Manager.ForeFill, FForeFill, FForeFillScan);
858 end;
859 
TGenericTool.GetBackUniversalBrushnull860 function TGenericTool.GetBackUniversalBrush: TUniversalBrush;
861 begin
862   result := GetUniversalBrush(Manager.BackFill, FBackFill, FBackFillScan);
863 end;
864 
TGenericTool.GetStatusTextnull865 function TGenericTool.GetStatusText: string;
866 begin
867   result := '';
868 end;
869 
TGenericTool.DoGetToolDrawingLayernull870 function TGenericTool.DoGetToolDrawingLayer: TBGRABitmap;
871 begin
872   if Action = nil then
873     result := nil
874   else if IsSelectingTool then
875   begin
876     Action.QuerySelection;
877     result := Action.CurrentSelection;
878     if result = nil then
879       raise exception.Create('Selection not created');
880   end
881   else
882     result := Action.DrawingLayer;
883 end;
884 
TGenericTool.GetCurrentLayerKindnull885 function TGenericTool.GetCurrentLayerKind: TLayerKind;
886 var
887   c: TBGRALayerOriginalAny;
888 begin
889   if not Manager.Image.LayerOriginalDefined[Manager.Image.CurrentLayerIndex] then
890   begin
891     if Manager.Image.CurrentLayerEmpty then exit(lkEmpty)
892     else exit(lkBitmap);
893   end else
894   if not Manager.Image.LayerOriginalKnown[Manager.Image.CurrentLayerIndex] then
895    exit(lkUnknown)
896   else
897   begin
898     c := Manager.Image.LayerOriginalClass[Manager.Image.CurrentLayerIndex];
899     if c = TVectorOriginal then exit(lkVectorial) else
900     if c = TBGRALayerImageOriginal then exit(lkTransformedBitmap) else
901     if c = TBGRALayerGradientOriginal then exit(lkGradient) else
902     if c = TBGRALayerSVGOriginal then exit(lkSVG) else
903       exit(lkOther);
904   end;
905 end;
906 
GetActionnull907 function TGenericTool.GetAction: TLayerAction;
908 begin
909   if not Assigned(FAction) then
910   begin
911     FAction := Manager.Image.CreateAction(not IsSelectingTool And Manager.Image.SelectionMaskEmpty,
912                                           IsSelectingTool or not Manager.Image.SelectionMaskEmpty);
913     FAction.OnTryStop := @OnTryStop;
914     FAction.ChangeBoundsNotified:= true;
915   end;
916   result := FAction;
917 end;
918 
GetIdleActionnull919 function TGenericTool.GetIdleAction: TLayerAction;
920 begin
921   if not Assigned(FAction) then
922   begin
923     FAction := Manager.Image.CreateAction(false);
924     FAction.OnTryStop := @OnTryStop;
925     FAction.ChangeBoundsNotified:= true;
926   end;
927   result := FAction;
928 end;
929 
TGenericTool.FixSelectionTransformnull930 function TGenericTool.FixSelectionTransform: boolean;
931 begin
932   result:= true;
933 end;
934 
TGenericTool.FixLayerOffsetnull935 function TGenericTool.FixLayerOffset: boolean;
936 begin
937   result:= true;
938 end;
939 
TGenericTool.DoToolDownnull940 function TGenericTool.DoToolDown(toolDest: TBGRABitmap; pt: TPoint;
941   ptF: TPointF; rightBtn: boolean): TRect;
942 begin
943   result := EmptyRect;
944 end;
945 {$hints on}
946 
947 {$hints off}
DoToolMovenull948 function TGenericTool.DoToolMove(toolDest: TBGRABitmap; pt: TPoint; ptF: TPointF): TRect;
949 begin
950   result := EmptyRect;
951 end;
952 
TGenericTool.DoToolKeyDownnull953 function TGenericTool.DoToolKeyDown(var key: Word): TRect;
954 begin
955   result := EmptyRect;
956   //defined later
957 end;
958 
DoToolKeyUpnull959 function TGenericTool.DoToolKeyUp(var key: Word): TRect;
960 begin
961   result := EmptyRect;
962   //defined later
963 end;
964 
965 {$hints on}
966 
967 constructor TGenericTool.Create(AManager: TToolManager);
968 begin
969   inherited Create;
970   FManager := AManager;
971   FAction := nil;
972   FShiftState:= [];
973   Cursor := crDefault;
974 end;
975 
976 destructor TGenericTool.Destroy;
977 begin
978   FAction.Free;
979   inherited Destroy;
980 end;
981 
982 procedure TGenericTool.ReleaseUniversalBrushes;
983 begin
984   FreeAndNil(FForeFillScan);
985   FreeAndNil(FForeFill);
986   FreeAndNil(FBackFillScan);
987   FreeAndNil(FBackFill);
988 end;
989 
990 procedure TGenericTool.ValidateAction;
991 begin
992   if Assigned(FAction) then
993   begin
994     FValidating := true;
995     FAction.Validate;
996     FValidating := false;
997     FreeAndNil(FAction);
998   end;
999 end;
1000 
1001 procedure TGenericTool.ValidateActionPartially;
1002 begin
1003   if Assigned(FAction) then
1004   begin
1005     FValidating := true;
1006     FAction.PartialValidate;
1007     FValidating := false;
1008   end;
1009 end;
1010 
1011 procedure TGenericTool.CancelAction;
1012 begin
1013   if FAction <> nil then
1014   begin
1015     FCanceling := true;
1016     FreeAndNil(FAction);
1017     FCanceling := false;
1018   end;
1019 end;
1020 
1021 procedure TGenericTool.CancelActionPartially;
1022 begin
1023   if Assigned(FAction) then
1024   begin
1025     FCanceling := true;
1026     FAction.PartialCancel;
1027     FCanceling := false;
1028   end;
1029 end;
1030 
HasPennull1031 function TGenericTool.HasPen: boolean;
1032 begin
1033   result := (toDrawShape in Manager.ShapeOptions) or not (ctShape in GetContextualToolbars);
1034 end;
1035 
TGenericTool.DoToolUpdatenull1036 function TGenericTool.DoToolUpdate(toolDest: TBGRABitmap): TRect;
1037 begin
1038   result := EmptyRect;
1039   //nothing
1040 end;
1041 
1042 procedure TGenericTool.OnTryStop(sender: TCustomLayerAction);
1043 begin
1044   Manager.ToolCloseAndReopenImmediatly;
1045 end;
1046 
SelectionMaxPointDistancenull1047 function TGenericTool.SelectionMaxPointDistance: single;
1048 begin
1049   result := DoScaleX(10,OriginalDPI);
1050   result /= Manager.Image.ZoomFactor;
1051 end;
1052 
TGenericTool.ToolUpdatenull1053 function TGenericTool.ToolUpdate: TRect;
1054 var toolDest :TBGRABitmap;
1055 begin
1056   toolDest := GetToolDrawingLayer;
1057   if toolDest = nil then
1058   begin
1059     result := EmptyRect;
1060     exit;
1061   end;
1062   toolDest.JoinStyle := Manager.JoinStyle;
1063   toolDest.LineCap := Manager.LineCap;
1064   toolDest.PenStyle := Manager.PenStyle;
1065   result := DoToolUpdate(toolDest);
1066 end;
1067 
ToolDownnull1068 function TGenericTool.ToolDown(X, Y: single; rightBtn: boolean): TRect;
1069 var
1070   toolDest: TBGRABitmap;
1071   ptF: TPointF;
1072 begin
1073   result := EmptyRect;
1074   toolDest := GetToolDrawingLayer;
1075   if toolDest = nil then exit;
1076   toolDest.JoinStyle := Manager.JoinStyle;
1077   toolDest.LineCap := Manager.LineCap;
1078   toolDest.PenStyle := Manager.PenStyle;
1079   ptF := PointF(x,y);
1080   if toolDest = Manager.Image.CurrentLayerReadOnly then
1081   begin
1082     if FixLayerOffset then
1083     begin
1084       ptF.x -= LayerOffset.x;
1085       ptF.y -= LayerOffset.y;
1086     end;
1087   end else if FixSelectionTransform and ((toolDest = Manager.Image.SelectionMaskReadonly)
1088     or (toolDest = Manager.Image.SelectionLayerReadonly)) and
1089       IsAffineMatrixInversible(Manager.Image.SelectionTransform) then
1090     ptF := AffineMatrixInverse(Manager.Image.SelectionTransform)*ptF;
1091 
1092   result := DoToolDown(toolDest,ptF.Round,ptF,rightBtn);
1093 end;
1094 
TGenericTool.ToolMovenull1095 function TGenericTool.ToolMove(X, Y: single): TRect;
1096 var
1097   toolDest: TBGRABitmap;
1098   ptF: TPointF;
1099 begin
1100   ptF := PointF(x,y);
1101   Manager.FToolCurrentCursorPos := ptF;
1102   result := EmptyRect;
1103   toolDest := GetToolDrawingLayer;
1104   if toolDest = nil then exit;
1105   toolDest.JoinStyle := Manager.JoinStyle;
1106   toolDest.LineCap := Manager.LineCap;
1107   toolDest.PenStyle := Manager.PenStyle;
1108   if toolDest = Manager.Image.CurrentLayerReadOnly then
1109   begin
1110     if FixLayerOffset then
1111     begin
1112       ptF.x -= LayerOffset.x;
1113       ptF.y -= LayerOffset.y;
1114     end;
1115   end else if FixSelectionTransform and ((toolDest = Manager.Image.SelectionMaskReadonly)
1116     or (toolDest = Manager.Image.SelectionLayerReadonly)) and
1117       IsAffineMatrixInversible(Manager.Image.SelectionTransform) then
1118     ptF := AffineMatrixInverse(Manager.Image.SelectionTransform)*ptF;
1119 
1120   result := DoToolMove(toolDest,ptF.Round,ptF);
1121 end;
1122 
1123 {$hints off}
TGenericTool.ToolKeyDownnull1124 function TGenericTool.ToolKeyDown(var key: Word): TRect;
1125 var
1126   key2: Word;
1127 begin
1128   if key = VK_SHIFT then
1129   begin
1130     Include(FShiftState, ssShift);
1131     //do not reset Key to preserve typing ^o or "o
1132   end else
1133   if (key = VK_MENU) then
1134     Include(FShiftState, ssAlt);
1135 
1136   if (Key = VK_SNAP) or (Key = VK_SNAP2) then
1137   begin
1138     key2 := VK_CONTROL;
1139     Include(FShiftState, ssSnap);
1140     result := DoToolKeyDown(key2);
1141     if key2 = 0 then key := 0;
1142   end else
1143     result := DoToolKeyDown(key);
1144 end;
1145 
TGenericTool.ToolKeyUpnull1146 function TGenericTool.ToolKeyUp(var key: Word): TRect;
1147 var
1148   key2: word;
1149 begin
1150   if (key = VK_SHIFT) and (ssShift in FShiftState) then
1151   begin
1152     Exclude(FShiftState, ssShift);
1153     //do not reset key to preserve typing ^o or "o
1154   end else
1155   if (key = VK_MENU) and (ssAlt in FShiftState) then
1156     Exclude(FShiftState, ssAlt);
1157 
1158   //propagate in all cases to know when keys are released for unicode input
1159   if (Key = VK_SNAP) or (Key = VK_SNAP2) then
1160   begin
1161     key2 := VK_CONTROL;
1162     Exclude(FShiftState, ssSnap);
1163     result := DoToolKeyUp(key2);
1164     if key2 = 0 then key := 0;
1165   end else
1166     result := DoToolKeyUp(key);
1167 end;
1168 
ToolKeyPressnull1169 function TGenericTool.ToolKeyPress(var key: TUTF8Char): TRect;
1170 begin
1171   result := EmptyRect;
1172   //defined later
1173 end;
1174 
1175 {$hints on}
1176 
ToolUpnull1177 function TGenericTool.ToolUp: TRect;
1178 begin
1179   result := EmptyRect;
1180   //defined later
1181 end;
1182 
TGenericTool.ToolCommandnull1183 function TGenericTool.ToolCommand(ACommand: TToolCommand): boolean;
1184 begin
1185   result := false;
1186 end;
1187 
TGenericTool.ToolProvideCommandnull1188 function TGenericTool.ToolProvideCommand(ACommand: TToolCommand): boolean;
1189 begin
1190   result := false;
1191 end;
1192 
SuggestGradientBoxnull1193 function TGenericTool.SuggestGradientBox: TAffineBox;
1194 var
1195   m: TAffineMatrix;
1196 begin
1197   result := TAffineBox.AffineBox(RectF(PointF(0,0),PointF(Manager.Image.Width,Manager.Image.Height)));
1198   if not IsSelectingTool and Manager.Image.SelectionMaskEmpty then
1199   begin
1200     m := Manager.Image.LayerOriginalMatrix[Manager.Image.CurrentLayerIndex];
1201     result := AffineMatrixInverse(m)*result;
1202   end;
1203 end;
1204 
GetContextualToolbarsnull1205 function TGenericTool.GetContextualToolbars: TContextualToolbars;
1206 begin
1207   result := [ctPenFill, ctBackFill];
1208 end;
1209 
GetToolDrawingLayernull1210 function TGenericTool.GetToolDrawingLayer: TBGRABitmap;
1211 begin
1212   result := DoGetToolDrawingLayer;
1213   FLastToolDrawingLayer := result;
1214 end;
1215 
1216 procedure TGenericTool.RestoreBackupDrawingLayer;
1217 begin
1218   if Assigned(FAction) then
1219   begin
1220     if IsSelectingTool then
1221       Action.RestoreSelectionMask
1222     else
1223       Action.RestoreDrawingLayer;
1224   end;
1225 end;
1226 
TGenericTool.GetBackupLayerIfExistsnull1227 function TGenericTool.GetBackupLayerIfExists: TBGRABitmap;
1228 begin
1229   if Action = nil then
1230   begin
1231     result := nil;
1232     exit;
1233   end;
1234   if IsSelectingTool then
1235     result := Action.BackupSelection
1236   else
1237     result := Action.BackupDrawingLayer;
1238 end;
1239 
1240 {$hints off}
Rendernull1241 function TGenericTool.Render(VirtualScreen: TBGRABitmap; VirtualScreenWidth, VirtualScreenHeight: integer; BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect;
1242 begin
1243   result := EmptyRect;
1244 end;
1245 
1246 {$hints on}
1247 
1248 { TToolManager }
1249 
TToolManager.GetCurrentToolTypenull1250 function TToolManager.GetCurrentToolType: TPaintToolType;
1251 begin
1252   result := FCurrentToolType;
1253 end;
1254 
SetCurrentToolTypenull1255 function TToolManager.SetCurrentToolType(tool: TPaintToolType): boolean;
1256 begin
1257   if not ToolSleeping then
1258   begin
1259     InternalSetCurrentToolType(tool);
1260     result := true;
1261   end
1262   else result := false;
1263 end;
1264 
TToolManager.SetControlsVisiblenull1265 function TToolManager.SetControlsVisible(AControls: TList; AVisible: Boolean; AName: string): boolean;
1266   procedure SetVisibility(AControl: TControl; AVisible: boolean);
1267   begin
1268     if AControl.Visible <> AVisible then
1269     begin
1270       AControl.Visible := AVisible;
1271       result := true;
1272     end;
1273   end;
1274 
1275 var i: integer;
1276 begin
1277   result := false;
1278   if AName <> '' then
1279   begin
1280     for i := AControls.Count-1 downto 0 do
1281       if (TObject(AControls[i]) as TControl).Name <> AName then
1282         SetVisibility(TObject(AControls[i]) as TControl, False);
1283     for i := 0 to AControls.Count-1 do
1284       if (TObject(AControls[i]) as TControl).Name = AName then
1285         SetVisibility(TObject(AControls[i]) as TControl, True);
1286   end else
1287   begin
1288     if AVisible then
1289     begin
1290       for i := 0 to AControls.Count-1 do
1291         SetVisibility(TObject(AControls[i]) as TControl, True);
1292     end else
1293       for i := AControls.Count-1 downto 0 do
1294         SetVisibility(TObject(AControls[i]) as TControl, False);
1295   end;
1296 end;
1297 
1298 procedure TToolManager.SetArrowEnd(AValue: TArrowKind);
1299 begin
1300   if FArrowEnd=AValue then Exit;
1301   FArrowEnd:=AValue;
1302   ToolUpdate;
1303   if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
1304 end;
1305 
1306 procedure TToolManager.SetArrowSize(AValue: TPointF);
1307 begin
1308   if AValue.x < MinArrowSize then AValue.x := MinArrowSize;
1309   if AValue.x > MaxArrowSize then AValue.x := MaxArrowSize;
1310   if AValue.y < MinArrowSize then AValue.y := MinArrowSize;
1311   if AValue.y > MaxArrowSize then AValue.y := MaxArrowSize;
1312   if FArrowSize=AValue then Exit;
1313   FArrowSize:=AValue;
1314   ToolUpdate;
1315   if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
1316 end;
1317 
1318 procedure TToolManager.SetArrowStart(AValue: TArrowKind);
1319 begin
1320   if FArrowStart=AValue then Exit;
1321   FArrowStart:=AValue;
1322   ToolUpdate;
1323   if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
1324 end;
1325 
1326 procedure TToolManager.SetBackColor(AValue: TBGRAPixel);
1327 begin
1328   FBackFill.SolidColor := AValue;
1329 end;
1330 
1331 procedure TToolManager.SetDeformationGridMode(AValue: TDeformationGridMode);
1332 begin
1333   if FDeformationGridMode=AValue then Exit;
1334   FDeformationGridMode:=AValue;
1335   ToolUpdate;
1336   if Assigned(FOnDeformationGridChanged) then FOnDeformationGridChanged(self);
1337 end;
1338 
1339 procedure TToolManager.SetEraserAlpha(AValue: byte);
1340 begin
1341   if FEraserAlpha=AValue then Exit;
1342   FEraserAlpha:=AValue;
1343   ToolUpdate;
1344   if Assigned(FOnEraserChanged) then FOnEraserChanged(self);
1345 end;
1346 
1347 procedure TToolManager.SetEraserMode(AValue: TEraserMode);
1348 begin
1349   if FEraserMode=AValue then Exit;
1350   FEraserMode:=AValue;
1351   ToolUpdate;
1352   if Assigned(FOnEraserChanged) then FOnEraserChanged(self);
1353 end;
1354 
1355 procedure TToolManager.SetFloodFillOptions(AValue: TFloodFillOptions);
1356 begin
1357   if FFloodFillOptions=AValue then Exit;
1358   FFloodFillOptions:=AValue;
1359   ToolUpdate;
1360   if Assigned(FOnFloodFillOptionChanged) then FOnFloodFillOptionChanged(self);
1361 end;
1362 
1363 procedure TToolManager.SetForeColor(AValue: TBGRAPixel);
1364 begin
1365   FForeFill.SolidColor := AValue;
1366 end;
1367 
1368 procedure TToolManager.SetJoinStyle(AValue: TPenJoinStyle);
1369 begin
1370   if FJoinStyle=AValue then Exit;
1371   FJoinStyle:=AValue;
1372   ToolUpdate;
1373   if Assigned(FOnJoinStyleChanged) then FOnJoinStyleChanged(self);
1374 end;
1375 
1376 procedure TToolManager.SetLightAltitude(AValue: integer);
1377 begin
1378   if FLightAltitude=AValue then Exit;
1379   FLightAltitude:=AValue;
1380   ToolUpdate;
1381   if Assigned(FOnLightChanged) then FOnLightChanged(self);
1382 end;
1383 
1384 procedure TToolManager.SetLightPosition(AValue: TPointF);
1385 begin
1386   if FLightPosition=AValue then Exit;
1387   FLightPosition:=AValue;
1388   ToolUpdate;
1389   if Assigned(FOnLightChanged) then FOnLightChanged(self);
1390 end;
1391 
1392 procedure TToolManager.SetLineCap(AValue: TPenEndCap);
1393 begin
1394   if FLineCap=AValue then Exit;
1395   FLineCap:=AValue;
1396   ToolUpdate;
1397   if Assigned(FOnLineCapChanged) then FOnLineCapChanged(self);
1398 end;
1399 
1400 procedure TToolManager.SetOnQueryColorTarget(AValue: TOnQueryColorTargetHandler);
1401 begin
1402   if FOnQueryColorTarget=AValue then Exit;
1403   FOnQueryColorTarget:=AValue;
1404 end;
1405 
1406 procedure TToolManager.SetOutlineColor(AValue: TBGRAPixel);
1407 begin
1408   FOutlineFill.SolidColor := AValue;
1409 end;
1410 
1411 procedure TToolManager.SetPerspectiveOptions(AValue: TPerspectiveOptions);
1412 begin
1413   if FPerspectiveOptions=AValue then Exit;
1414   FPerspectiveOptions:=AValue;
1415   ToolUpdate;
1416   if Assigned(FOnPerspectiveOptionChanged) then FOnPerspectiveOptionChanged(self);
1417 end;
1418 
1419 procedure TToolManager.SetPhongShapeAltitude(AValue: integer);
1420 begin
1421   if AValue < MinPhongShapeAltitude then AValue := MinPhongShapeAltitude;
1422   if AValue > MaxPhongShapeAltitude then AValue := MaxPhongShapeAltitude;
1423   if FPhongShapeAltitude=AValue then Exit;
1424   FPhongShapeAltitude:=AValue;
1425   ToolUpdate;
1426   if Assigned(FOnPhongShapeChanged) then FOnPhongShapeChanged(self);
1427 end;
1428 
1429 procedure TToolManager.SetPhongShapeBorderSize(AValue: integer);
1430 begin
1431   if AValue < MinPhongBorderSize then AValue := MinPhongBorderSize;
1432   if AValue > MaxPhongBorderSize then AValue := MaxPhongBorderSize;
1433   if FPhongShapeBorderSize=AValue then Exit;
1434   FPhongShapeBorderSize:=AValue;
1435   ToolUpdate;
1436   if Assigned(FOnPhongShapeChanged) then FOnPhongShapeChanged(self);
1437 end;
1438 
1439 procedure TToolManager.SetPhongShapeKind(AValue: TPhongShapeKind);
1440 begin
1441   if FPhongShapeKind=AValue then Exit;
1442   FPhongShapeKind:=AValue;
1443   ToolUpdate;
1444   if Assigned(FOnPhongShapeChanged) then FOnPhongShapeChanged(self);
1445 end;
1446 
1447 procedure TToolManager.SetShapeOptions(AValue: TShapeOptions);
1448 begin
1449   if FShapeOptions=AValue then Exit;
1450   FShapeOptions:=AValue;
1451   ToolUpdate;
1452   if Assigned(FOnShapeOptionChanged) then FOnShapeOptionChanged(self);
1453 end;
1454 
1455 procedure TToolManager.SetPenStyle(AValue: TPenStyle);
1456 begin
1457   if FPenStyle=AValue then Exit;
1458   FPenStyle:=AValue;
1459   ToolUpdate;
1460   if Assigned(FOnPenStyleChanged) then FOnPenStyleChanged(self);
1461 end;
1462 
1463 procedure TToolManager.SetPenWidth(AValue: single);
1464 begin
1465   if AValue < MinPenWidth then AValue := MinPenWidth;
1466   if AValue > MaxPenWidth then AValue := MaxPenWidth;
1467   if GetCurrentToolType = ptEraser then
1468   begin
1469     if FEraserWidth <> AValue then
1470     begin
1471       FEraserWidth := AValue;
1472       ToolUpdate;
1473       if Assigned(FOnPenWidthChanged) then FOnPenWidthChanged(self);
1474     end;
1475   end else
1476   begin
1477     if FNormalPenWidth <> AValue then
1478     begin
1479       FNormalPenWidth := AValue;
1480       ToolUpdate;
1481       if Assigned(FOnPenWidthChanged) then FOnPenWidthChanged(self);
1482     end;
1483   end;
1484 end;
1485 
1486 procedure TToolManager.SetShapeRatio(AValue: Single);
1487 begin
1488   if FShapeRatio=AValue then Exit;
1489   FShapeRatio:=AValue;
1490   ToolUpdate;
1491   if Assigned(FOnShapeRatioChanged) then FOnShapeRatioChanged(self);
1492 end;
1493 
1494 procedure TToolManager.SetSplineStyle(AValue: TSplineStyle);
1495 begin
1496   if FSplineStyle=AValue then Exit;
1497   FSplineStyle:=AValue;
1498   ToolUpdate;
1499   if Assigned(FOnSplineStyleChanged) then FOnSplineStyleChanged(self);
1500 end;
1501 
1502 procedure TToolManager.SetTextAlign(AValue: TAlignment);
1503 begin
1504   if FTextAlign=AValue then Exit;
1505   FTextAlign:=AValue;
1506   ToolUpdate;
1507   if Assigned(FOnTextAlignChanged) then FOnTextAlignChanged(self);
1508 end;
1509 
1510 procedure TToolManager.SetTextPhong(AValue: boolean);
1511 begin
1512   if FTextPhong=AValue then Exit;
1513   FTextPhong:=AValue;
1514   ToolUpdate;
1515   if Assigned(FOnTextPhongChanged) then FOnTextPhongChanged(self);
1516 end;
1517 
1518 procedure TToolManager.SetTextShadow(AValue: boolean);
1519 begin
1520   if FTextShadow=AValue then Exit;
1521   FTextShadow:=AValue;
1522   ToolUpdate;
1523   if Assigned(FOnTextShadowChanged) then FOnTextShadowChanged(self);
1524 end;
1525 
1526 procedure TToolManager.SetTextShadowBlurRadius(AValue: single);
1527 begin
1528   if FTextShadowBlurRadius=AValue then Exit;
1529   FTextShadowBlurRadius:=AValue;
1530   ToolUpdate;
1531   if Assigned(FOnTextShadowChanged) then FOnTextShadowChanged(self);
1532 end;
1533 
1534 procedure TToolManager.SetTextShadowOffset(AValue: TPoint);
1535 begin
1536   if FTextShadowOffset=AValue then Exit;
1537   FTextShadowOffset:=AValue;
1538   ToolUpdate;
1539   if Assigned(FOnTextShadowChanged) then FOnTextShadowChanged(self);
1540 end;
1541 
1542 procedure TToolManager.SetTolerance(AValue: byte);
1543 begin
1544   if FTolerance=AValue then Exit;
1545   FTolerance:=AValue;
1546   ToolUpdate;
1547   if Assigned(FOnToleranceChanged) then FOnToleranceChanged(self);
1548 end;
1549 
CheckExitToolnull1550 function TToolManager.CheckExitTool: boolean;
1551 begin
1552   if FShouldExitTool then
1553   begin
1554     FShouldExitTool:= false;
1555     if FCurrentToolType in[ptRect,ptEllipse,ptPolygon,ptSpline,ptText,ptPhong,ptGradient] then
1556       SetCurrentToolType(ptEditShape)
1557     else
1558       SetCurrentToolType(ptHand);
1559     result := true;
1560   end else
1561     result := false;
1562 end;
1563 
1564 procedure TToolManager.NotifyImageOrSelectionChanged(ALayer: TBGRABitmap; ARect: TRect);
1565 begin
1566   if (CurrentTool <> nil) and not IsRectEmpty(ARect) then
1567   begin
1568     if Assigned(CurrentTool.FAction) then
1569       if not IsOnlyRenderChange(ARect) then
1570         CurrentTool.FAction.NotifyChange(ALayer, ARect);
1571 
1572     if Assigned(ALayer) then
1573     begin
1574       if ALayer = Image.CurrentLayerReadOnly then
1575         Image.ImageMayChange(AddLayerOffset(ARect))
1576       else
1577         Image.LayerMayChange(ALayer, ARect);
1578     end
1579   end;
1580 end;
1581 
ToolCanBeUsednull1582 function TToolManager.ToolCanBeUsed: boolean;
1583 begin
1584   result := (FCurrentToolType = ptHand) or ((CurrentTool <> nil) and (CurrentTool.IsSelectingTool or Image.CurrentLayerVisible));
1585 end;
1586 
ToolHasLineCapnull1587 function TToolManager.ToolHasLineCap: boolean;
1588 var
1589   contextualToolbars: TContextualToolbars;
1590 begin
1591   contextualToolbars := GetContextualToolbars;
1592   result := (ctLineCap in contextualToolbars) and CurrentTool.HasPen and
1593             (not (toCloseShape in ShapeOptions) or not (ctCloseShape in contextualToolbars));
1594 end;
1595 
GetBackColornull1596 function TToolManager.GetBackColor: TBGRAPixel;
1597 begin
1598   if BlackAndWhite then
1599     result := BGRAToGrayscale(FBackFill.AverageColor)
1600   else
1601     result := FBackFill.AverageColor;
1602 end;
1603 
GetBrushAtnull1604 function TToolManager.GetBrushAt(AIndex: integer): TLazPaintBrush;
1605 begin
1606   if (FBrushInfoList = nil) or (AIndex < 0) or (AIndex >= FBrushInfoList.Count) then
1607     result := nil
1608   else
1609     result := TObject(FBrushInfoList[AIndex]) as TLazPaintBrush;
1610 end;
1611 
TToolManager.GetBrushCountnull1612 function TToolManager.GetBrushCount: integer;
1613 begin
1614   if Assigned(FBrushInfoList) then
1615     result := FBrushInfoList.Count
1616   else
1617     result := 0;
1618 end;
1619 
TToolManager.GetBrushInfonull1620 function TToolManager.GetBrushInfo: TLazPaintBrush;
1621 begin
1622   if (FBrushIndex < 0) or (FBrushIndex > FBrushInfoList.Count) then
1623     FBrushIndex := 0;
1624   if FBrushIndex > FBrushInfoList.Count then
1625     result := nil
1626   else
1627     result := TObject(FBrushInfoList[FBrushIndex]) as TLazPaintBrush;
1628 end;
1629 
TToolManager.GetCursornull1630 function TToolManager.GetCursor: TCursor;
1631 var toolCursor: TCursor;
1632 begin
1633   case GetCurrentToolType of
1634   ptHand, ptMoveSelection, ptZoomLayer: result := crSizeAll;
1635   ptRotateSelection,ptRotateLayer: result := crCustomRotate;
1636   ptPen,ptBrush,ptClone: result := crCustomCrosshair;
1637   ptRect,ptEllipse,ptSelectRect,ptSelectEllipse: result := crCustomCrosshair;
1638   ptColorPicker: result := crCustomColorPicker;
1639   ptFloodFill: result := crCustomFloodfill;
1640   ptSelectPen: result := crHandPoint;
1641   ptEraser: result := crDefault;
1642   else result := crDefault;
1643   end;
1644 
1645   if CurrentTool <> nil then
1646     toolCursor := CurrentTool.Cursor
1647   else
1648     toolCursor := crDefault;
1649   if toolCursor <> crDefault then result := toolCursor;
1650 end;
1651 
1652 procedure TToolManager.FillChange(ASender: TObject;
1653   var ADiff: TCustomVectorialFillDiff);
1654 begin
1655   if FInToolUpdate or FInSwapFill then exit;
1656   ToolUpdate;
1657   if Assigned(FOnFillChanged) then FOnFillChanged(self);
1658   if (ASender = FBackFill) and (FBackFill.FillType = vftGradient) then
1659   begin
1660     FBackLastGradient.Free;
1661     FBackLastGradient := FBackFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
1662   end else
1663   if (ASender = FForeFill) and (FForeFill.FillType = vftGradient) then
1664   begin
1665     FForeLastGradient.Free;
1666     FForeLastGradient := FForeFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
1667   end else
1668   if (ASender = FOutlineFill) and (FOutlineFill.FillType = vftGradient) then
1669   begin
1670     FOutlineLastGradient.Free;
1671     FOutlineLastGradient := FOutlineFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
1672   end;
1673 end;
1674 
TToolManager.GetAllowedBackFillTypesnull1675 function TToolManager.GetAllowedBackFillTypes: TVectorialFillTypes;
1676 begin
1677   if Assigned(CurrentTool) then result := CurrentTool.AllowedBackFillTypes
1678   else result := [vftSolid,vftGradient,vftTexture];
1679 end;
1680 
TToolManager.GetAllowedForeFillTypesnull1681 function TToolManager.GetAllowedForeFillTypes: TVectorialFillTypes;
1682 begin
1683   if Assigned(CurrentTool) then result := CurrentTool.AllowedForeFillTypes
1684   else result := [vftSolid,vftGradient,vftTexture];
1685 end;
1686 
GetAllowedOutlineFillTypesnull1687 function TToolManager.GetAllowedOutlineFillTypes: TVectorialFillTypes;
1688 begin
1689   if Assigned(CurrentTool) then result := CurrentTool.AllowedOutlineFillTypes
1690   else result := [vftSolid,vftGradient,vftTexture];
1691 end;
1692 
GetForeColornull1693 function TToolManager.GetForeColor: TBGRAPixel;
1694 begin
1695   if BlackAndWhite then
1696     result := BGRAToGrayscale(FForeFill.AverageColor)
1697   else
1698     result := FForeFill.AverageColor;
1699 end;
1700 
GetMaxDeformationGridSizenull1701 function TToolManager.GetMaxDeformationGridSize: TSize;
1702 begin
1703   result.cx := Max(MinDeformationGridSize,Min(image.Width div 2,50)+1);
1704   result.cy := Max(MinDeformationGridSize,Min(image.Height div 2,50)+1);
1705 end;
1706 
TToolManager.GetOutlineColornull1707 function TToolManager.GetOutlineColor: TBGRAPixel;
1708 begin
1709   if BlackAndWhite then
1710     result := BGRAToGrayscale(FOutlineFill.AverageColor)
1711   else
1712     result := FOutlineFill.AverageColor;
1713 end;
1714 
TToolManager.GetShapeOptionAliasingnull1715 function TToolManager.GetShapeOptionAliasing: boolean;
1716 begin
1717   result := toAliasing in FShapeOptions;
1718 end;
1719 
TToolManager.GetPenWidthnull1720 function TToolManager.GetPenWidth: single;
1721 begin
1722   if GetCurrentToolType = ptEraser then
1723     result := FEraserWidth else result := FNormalPenWidth;
1724 end;
1725 
GetToolSleepingnull1726 function TToolManager.GetToolSleeping: boolean;
1727 begin
1728   result := FSleepingTool <> nil;
1729 end;
1730 
GetTextFontNamenull1731 function TToolManager.GetTextFontName: string;
1732 begin
1733   result := FTextFontName;
1734 end;
1735 
GetTextFontSizenull1736 function TToolManager.GetTextFontSize: single;
1737 begin
1738   result := FTextFontSize;
1739 end;
1740 
TToolManager.GetTextFontStylenull1741 function TToolManager.GetTextFontStyle: TFontStyles;
1742 begin
1743   result := FTextFontStyle;
1744 end;
1745 
ScriptGetAliasingnull1746 function TToolManager.ScriptGetAliasing(AVars: TVariableSet): TScriptResult;
1747 begin
1748   AVars.Booleans['Result'] := toAliasing in ShapeOptions;
1749   result := srOk;
1750 end;
1751 
TToolManager.ScriptGetArrowEndnull1752 function TToolManager.ScriptGetArrowEnd(AVars: TVariableSet): TScriptResult;
1753 begin
1754   AVars.Strings['Result'] := CSSToPascalCase(ArrowKindToStr[ArrowEnd]);
1755   result := srOk;
1756 end;
1757 
ScriptGetArrowSizenull1758 function TToolManager.ScriptGetArrowSize(AVars: TVariableSet): TScriptResult;
1759 begin
1760   AVars.Points2D['Result'] := ArrowSize;
1761   result := srOk;
1762 end;
1763 
TToolManager.ScriptGetArrowStartnull1764 function TToolManager.ScriptGetArrowStart(AVars: TVariableSet): TScriptResult;
1765 begin
1766   AVars.Strings['Result'] := CSSToPascalCase(ArrowKindToStr[ArrowStart]);
1767   result := srOk;
1768 end;
1769 
ScriptGetBackColornull1770 function TToolManager.ScriptGetBackColor(AVars: TVariableSet): TScriptResult;
1771 begin
1772   AVars.Pixels['Result'] := BackColor;
1773   result := srOk;
1774 end;
1775 
ScriptGetOutlineColornull1776 function TToolManager.ScriptGetOutlineColor(AVars: TVariableSet): TScriptResult;
1777 begin
1778   AVars.Pixels['Result'] := OutlineColor;
1779   result := srOk;
1780 end;
1781 
ScriptGetBrushCountnull1782 function TToolManager.ScriptGetBrushCount(AVars: TVariableSet): TScriptResult;
1783 begin
1784   AVars.Integers['Result'] := BrushCount;
1785   result := srOk;
1786 end;
1787 
ScriptGetBrushIndexnull1788 function TToolManager.ScriptGetBrushIndex(AVars: TVariableSet): TScriptResult;
1789 begin
1790   AVars.Integers['Result'] := BrushIndex;
1791   result := srOk;
1792 end;
1793 
ScriptGetBrushSpacingnull1794 function TToolManager.ScriptGetBrushSpacing(AVars: TVariableSet): TScriptResult;
1795 begin
1796   AVars.Integers['Result'] := BrushSpacing;
1797   result := srOk;
1798 end;
1799 
ScriptGetDeformationGridModenull1800 function TToolManager.ScriptGetDeformationGridMode(AVars: TVariableSet): TScriptResult;
1801 begin
1802   result := srOk;
1803   case DeformationGridMode of
1804   gmDeform: AVars.Strings['Result'] := 'Deform';
1805   gmMovePointWithoutDeformation: AVars.Strings['Result'] := 'MovePointWithoutDeformation';
1806   else result := srException;
1807   end;
1808 end;
1809 
TToolManager.ScriptGetDeformationGridSizenull1810 function TToolManager.ScriptGetDeformationGridSize(AVars: TVariableSet): TScriptResult;
1811 begin
1812   result := srOk;
1813   with DeformationGridSize do
1814     AVars.Points2D['Result'] := PointF(cx,cy);
1815 end;
1816 
ScriptGetEraserAlphanull1817 function TToolManager.ScriptGetEraserAlpha(AVars: TVariableSet): TScriptResult;
1818 begin
1819   AVars.Integers['Result'] := EraserAlpha;
1820   result := srOk;
1821 end;
1822 
TToolManager.ScriptGetEraserModenull1823 function TToolManager.ScriptGetEraserMode(AVars: TVariableSet): TScriptResult;
1824 begin
1825   result := srOk;
1826   case EraserMode of
1827   emEraseAlpha: AVars.Strings['Result'] := 'EraseAlpha';
1828   emSharpen: AVars.Strings['Result'] := 'Sharpen';
1829   emSoften: AVars.Strings['Result'] := 'Soften';
1830   emLighten: AVars.Strings['Result'] := 'Lighten';
1831   emDarken: AVars.Strings['Result'] := 'Darken';
1832   else result := srException;
1833   end;
1834 end;
1835 
TToolManager.ScriptGetFloodFillOptionsnull1836 function TToolManager.ScriptGetFloodFillOptions(AVars: TVariableSet): TScriptResult;
1837 var
1838   optionsVar: TScriptVariableReference;
1839   option: TFloodFillOption;
1840 begin
1841   optionsVar := AVars.AddStringList('Result');
1842   for option := low(TFloodFillOption) to high(TFloodFillOption) do
1843     if option in FloodFillOptions then
1844     case option of
1845     ffProgressive: AVars.AppendString(optionsVar, 'Progressive');
1846     ffFillAll: Avars.AppendString(optionsVar, 'FillAll');
1847     end;
1848   result := srOk;
1849 end;
1850 
ScriptGetFontNamenull1851 function TToolManager.ScriptGetFontName(AVars: TVariableSet): TScriptResult;
1852 begin
1853   AVars.Strings['Name'] := TextFontName;
1854   result := srOk;
1855 end;
1856 
ScriptGetFontSizenull1857 function TToolManager.ScriptGetFontSize(AVars: TVariableSet): TScriptResult;
1858 begin
1859   AVars.Floats['Result'] := TextFontSize;
1860   result := srOk;
1861 end;
1862 
ScriptGetFontStylenull1863 function TToolManager.ScriptGetFontStyle(AVars: TVariableSet): TScriptResult;
1864 var
1865   styles: TScriptVariableReference;
1866   style: TFontStyle;
1867 begin
1868   styles := AVars.AddStringList('Result');
1869   for style := low(TFontStyle) to high(TFontStyle) do
1870     if style in TextFontStyle then
1871     case style of
1872     fsBold: AVars.AppendString(styles, 'Bold');
1873     fsItalic: Avars.AppendString(styles, 'Italic');
1874     fsUnderline: Avars.AppendString(styles, 'Underline');
1875     fsStrikeOut: Avars.AppendString(styles, 'StrikeOut');
1876     end;
1877   result := srOk;
1878 end;
1879 
ScriptGetGradientInterpolationnull1880 function TToolManager.ScriptGetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
1881 begin
1882   result := srOk;
1883   if AFill.FillType <> vftGradient then result := srException else
1884   AVars.Strings['Result'] := GradientInterpolationToStr(AFill.Gradient.ColorInterpolation);
1885 end;
1886 
TToolManager.ScriptGetGradientRepetitionnull1887 function TToolManager.ScriptGetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
1888 begin
1889   result := srOk;
1890   if AFill.FillType <> vftGradient then result := srException else
1891   AVars.Strings['Result'] := GradientRepetitionToStr(AFill.Gradient.Repetition);
1892 end;
1893 
TToolManager.ScriptGetGradientTypenull1894 function TToolManager.ScriptGetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
1895 begin
1896   result := srOk;
1897   if AFill.FillType <> vftGradient then result := srException else
1898   AVars.Strings['Result'] := GradientTypeStr[AFill.Gradient.GradientType];
1899 end;
1900 
ScriptGetGradientColorsnull1901 function TToolManager.ScriptGetGradientColors(AVars: TVariableSet;
1902   AFill: TVectorialFill): TScriptResult;
1903 var
1904   colors: TScriptVariableReference;
1905 begin
1906   result := srOk;
1907   if AFill.FillType <> vftGradient then result := srException else
1908   begin
1909     colors := AVars.AddPixelList('Result');
1910     TVariableSet.AppendPixel(colors, AFill.Gradient.StartColor);
1911     TVariableSet.AppendPixel(colors, AFill.Gradient.EndColor);
1912   end;
1913 end;
1914 
ScriptGetBackGradientInterpolationnull1915 function TToolManager.ScriptGetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
1916 begin
1917   result := ScriptGetGradientInterpolation(AVars, FBackFill);
1918 end;
1919 
TToolManager.ScriptGetBackGradientRepetitionnull1920 function TToolManager.ScriptGetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
1921 begin
1922   result := ScriptGetGradientRepetition(AVars, FBackFill);
1923 end;
1924 
ScriptGetBackGradientTypenull1925 function TToolManager.ScriptGetBackGradientType(AVars: TVariableSet): TScriptResult;
1926 begin
1927   result := ScriptGetGradientType(AVars, FBackFill);
1928 end;
1929 
TToolManager.ScriptGetBackGradientColorsnull1930 function TToolManager.ScriptGetBackGradientColors(AVars: TVariableSet): TScriptResult;
1931 begin
1932   result := ScriptGetGradientColors(AVars, FBackFill);
1933 end;
1934 
ScriptGetForeGradientInterpolationnull1935 function TToolManager.ScriptGetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
1936 begin
1937   result := ScriptGetGradientInterpolation(AVars, FForeFill);
1938 end;
1939 
ScriptGetForeGradientRepetitionnull1940 function TToolManager.ScriptGetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
1941 begin
1942   result := ScriptGetGradientRepetition(AVars, FForeFill);
1943 end;
1944 
ScriptGetForeGradientTypenull1945 function TToolManager.ScriptGetForeGradientType(AVars: TVariableSet): TScriptResult;
1946 begin
1947   result := ScriptGetGradientType(AVars, FForeFill);
1948 end;
1949 
TToolManager.ScriptGetForeGradientColorsnull1950 function TToolManager.ScriptGetForeGradientColors(AVars: TVariableSet): TScriptResult;
1951 begin
1952   result := ScriptGetGradientColors(AVars, FForeFill);
1953 end;
1954 
TToolManager.ScriptGetOutlineGradientInterpolationnull1955 function TToolManager.ScriptGetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
1956 begin
1957   result := ScriptGetGradientInterpolation(AVars, FOutlineFill);
1958 end;
1959 
TToolManager.ScriptGetOutlineGradientRepetitionnull1960 function TToolManager.ScriptGetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
1961 begin
1962   result := ScriptGetGradientRepetition(AVars, FOutlineFill);
1963 end;
1964 
ScriptGetOutlineGradientTypenull1965 function TToolManager.ScriptGetOutlineGradientType(AVars: TVariableSet): TScriptResult;
1966 begin
1967   result := ScriptGetGradientType(AVars, FOutlineFill);
1968 end;
1969 
TToolManager.ScriptGetOutlineGradientColorsnull1970 function TToolManager.ScriptGetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
1971 begin
1972   result := ScriptGetGradientColors(AVars, FOutlineFill);
1973 end;
1974 
TToolManager.ScriptGetTextureRepetitionnull1975 function TToolManager.ScriptGetTextureRepetition(AVars: TVariableSet;
1976   AFill: TVectorialFill): TScriptResult;
1977 begin
1978   if AFill.FillType <> vftTexture then exit(srException);
1979   result := srOk;
1980   case AFill.TextureRepetition of
1981   trNone: AVars.Strings['Result'] := 'None';
1982   trRepeatX: AVars.Strings['Result'] := 'RepeatX';
1983   trRepeatY: AVars.Strings['Result'] := 'RepeatY';
1984   trRepeatBoth: AVars.Strings['Result'] := 'RepeatBoth';
1985   else
1986     result := srException;
1987   end;
1988 end;
1989 
TToolManager.ScriptGetTextureOpacitynull1990 function TToolManager.ScriptGetTextureOpacity(AVars: TVariableSet;
1991   AFill: TVectorialFill): TScriptResult;
1992 begin
1993   if AFill.FillType <> vftTexture then exit(srException);
1994   AVars.Integers['Result'] := AFill.TextureOpacity;
1995   result := srOk;
1996 end;
1997 
ScriptGetBackTextureRepetitionnull1998 function TToolManager.ScriptGetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
1999 begin
2000   result := ScriptGetTextureRepetition(AVars, BackFill);
2001 end;
2002 
ScriptGetBackTextureOpacitynull2003 function TToolManager.ScriptGetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
2004 begin
2005   result := ScriptGetTextureOpacity(AVars, BackFill);
2006 end;
2007 
TToolManager.ScriptGetForeTextureRepetitionnull2008 function TToolManager.ScriptGetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
2009 begin
2010   result := ScriptGetTextureRepetition(AVars, ForeFill);
2011 end;
2012 
ScriptGetForeTextureOpacitynull2013 function TToolManager.ScriptGetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
2014 begin
2015   result := ScriptGetTextureOpacity(AVars, ForeFill);
2016 end;
2017 
ScriptGetOutlineTextureRepetitionnull2018 function TToolManager.ScriptGetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
2019 begin
2020   result := ScriptGetTextureRepetition(AVars, OutlineFill);
2021 end;
2022 
TToolManager.ScriptGetOutlineTextureOpacitynull2023 function TToolManager.ScriptGetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
2024 begin
2025   result := ScriptGetTextureOpacity(AVars, OutlineFill);
2026 end;
2027 
TToolManager.ScriptGetJoinStylenull2028 function TToolManager.ScriptGetJoinStyle(AVars: TVariableSet): TScriptResult;
2029 begin
2030   result := srOk;
2031   case JoinStyle of
2032   pjsBevel: AVars.Strings['Result'] := 'Bevel';
2033   pjsRound: AVars.Strings['Result'] := 'Round';
2034   pjsMiter: AVars.Strings['Result'] := 'Miter';
2035   else result := srException;
2036   end;
2037 end;
2038 
ScriptGetLightPositionnull2039 function TToolManager.ScriptGetLightPosition(AVars: TVariableSet): TScriptResult;
2040 begin
2041   AVars.Points2D['Result'] := LightPosition;
2042   result := srOk;
2043 end;
2044 
TToolManager.ScriptGetLineCapnull2045 function TToolManager.ScriptGetLineCap(AVars: TVariableSet): TScriptResult;
2046 begin
2047   case LineCap of
2048   pecSquare: AVars.Strings['Result'] := 'Square';
2049   pecRound: AVars.Strings['Result'] := 'Round';
2050   pecFlat: AVars.Strings['Result'] := 'Flat';
2051   else exit(srException);
2052   end;
2053   result := srOk;
2054 end;
2055 
ScriptGetForeColornull2056 function TToolManager.ScriptGetForeColor(AVars: TVariableSet): TScriptResult;
2057 begin
2058   AVars.Pixels['Result'] := ForeColor;
2059   result := srOk;
2060 end;
2061 
ScriptGetPenStylenull2062 function TToolManager.ScriptGetPenStyle(AVars: TVariableSet): TScriptResult;
2063 begin
2064   result := srOk;
2065   case PenStyle of
2066   psSolid: AVars.Strings['Result'] := 'Solid';
2067   psDash: AVars.Strings['Result'] := 'Dash';
2068   psDot: AVars.Strings['Result'] := 'Dot';
2069   psDashDot: AVars.Strings['Result'] := 'DashDot';
2070   psDashDotDot: AVars.Strings['Result'] := 'DashDotDot';
2071   else result := srException;
2072   end;
2073 end;
2074 
TToolManager.ScriptGetPenWidthnull2075 function TToolManager.ScriptGetPenWidth(AVars: TVariableSet): TScriptResult;
2076 begin
2077   AVars.Floats['Result'] := PenWidth;
2078   result := srOk;
2079 end;
2080 
ScriptGetPerspectiveOptionsnull2081 function TToolManager.ScriptGetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
2082 var
2083   optionsVar: TScriptVariableReference;
2084   option: TPerspectiveOption;
2085 begin
2086   optionsVar := AVars.AddStringList('Result');
2087   for option := low(TPerspectiveOption) to high(TPerspectiveOption) do
2088     if option in PerspectiveOptions then
2089     case option of
2090     poRepeat: Avars.AppendString(optionsVar, 'Repeat');
2091     poTwoPlanes: Avars.AppendString(optionsVar, 'TwoPlanes');
2092     end;
2093   result := srOk;
2094 end;
2095 
ScriptGetPhongShapeAltitudenull2096 function TToolManager.ScriptGetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
2097 begin
2098   result := srOk;
2099   AVars.Integers['Result'] := PhongShapeAltitude;
2100 end;
2101 
TToolManager.ScriptGetPhongShapeBorderSizenull2102 function TToolManager.ScriptGetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
2103 begin
2104   result := srOk;
2105   AVars.Integers['Result'] := PhongShapeBorderSize;
2106 end;
2107 
TToolManager.ScriptGetPhongShapeKindnull2108 function TToolManager.ScriptGetPhongShapeKind(AVars: TVariableSet): TScriptResult;
2109 begin
2110   result := srOk;
2111   case PhongShapeKind of
2112   pskRectangle: AVars.Strings['Result'] := 'Rectangle';
2113   pskRoundRectangle: AVars.Strings['Result'] := 'RoundRectangle';
2114   pskHalfSphere: AVars.Strings['Result'] := 'HalfSphere';
2115   pskConeTop: AVars.Strings['Result'] := 'ConeTop';
2116   pskConeSide: AVars.Strings['Result'] := 'ConeSide';
2117   pskHorizCylinder: AVars.Strings['Result'] := 'HorizCylinder';
2118   pskVertCylinder: AVars.Strings['Result'] := 'VertCylinder';
2119   else result := srException;
2120   end;
2121 end;
2122 
TToolManager.ScriptGetShapeOptionsnull2123 function TToolManager.ScriptGetShapeOptions(AVars: TVariableSet): TScriptResult;
2124 var
2125   options: TScriptVariableReference;
2126   opt: TShapeOption;
2127 begin
2128   options := AVars.AddStringList('Result');
2129   for opt := low(TShapeOption) to high(TShapeOption) do
2130     if opt in ShapeOptions then
2131     case opt of
2132     toDrawShape: Avars.AppendString(options, 'DrawShape');
2133     toFillShape: Avars.AppendString(options, 'FillShape');
2134     toCloseShape: Avars.AppendString(options, 'CloseShape');
2135     end;
2136   result := srOk;
2137 end;
2138 
ScriptGetShapeRationull2139 function TToolManager.ScriptGetShapeRatio(AVars: TVariableSet): TScriptResult;
2140 begin
2141   AVars.Floats['Result'] := ShapeRatio;
2142   result := srOk;
2143 end;
2144 
TToolManager.ScriptGetSplineStylenull2145 function TToolManager.ScriptGetSplineStyle(AVars: TVariableSet): TScriptResult;
2146 var
2147   s: String;
2148 begin
2149   case SplineStyle of
2150     ssInside: s := 'Inside';
2151     ssInsideWithEnds: s := 'InsideWithEnds';
2152     ssCrossing: s := 'Crossing';
2153     ssCrossingWithEnds: s := 'CrossingWithEnds';
2154     ssOutside: s := 'Outside';
2155     ssRoundOutside: s := 'RoundOutside';
2156     ssVertexToSide: s := 'VertexToSide';
2157     ssEasyBezier: s := 'EasyBezier';
2158   else
2159     exit(srException);
2160   end;
2161   AVars.Strings['Result'] := s;
2162   result := srOk;
2163 end;
2164 
ScriptGetTextAlignnull2165 function TToolManager.ScriptGetTextAlign(AVars: TVariableSet): TScriptResult;
2166 begin
2167   case TextAlign of
2168   taLeftJustify: AVars.Strings['Result'] := 'Left';
2169   taCenter: AVars.Strings['Result'] := 'Center';
2170   taRightJustify: AVars.Strings['Result'] := 'Right';
2171   else exit(srException);
2172   end;
2173   result := srOk;
2174 end;
2175 
ScriptGetTextOutlinenull2176 function TToolManager.ScriptGetTextOutline(AVars: TVariableSet): TScriptResult;
2177 begin
2178   if TextOutline then
2179     AVars.Floats['Result'] := TextOutlineWidth
2180   else
2181     AVars.Floats['Result'] := 0;
2182   result := srOk;
2183 end;
2184 
ScriptGetTextPhongnull2185 function TToolManager.ScriptGetTextPhong(AVars: TVariableSet): TScriptResult;
2186 begin
2187   AVars.Booleans['Result'] := TextPhong;
2188   result := srOk;
2189 end;
2190 
ScriptGetTolerancenull2191 function TToolManager.ScriptGetTolerance(AVars: TVariableSet): TScriptResult;
2192 begin
2193   AVars.Integers['Result'] := Tolerance;
2194   result := srOk;
2195 end;
2196 
TToolManager.ScriptSetAliasingnull2197 function TToolManager.ScriptSetAliasing(AVars: TVariableSet): TScriptResult;
2198 begin
2199   if AVars.Booleans['Enabled'] then
2200     ShapeOptions:= ShapeOptions + [toAliasing]
2201   else
2202     ShapeOptions:= ShapeOptions - [toAliasing];
2203   result := srOk;
2204 end;
2205 
ScriptSetArrowEndnull2206 function TToolManager.ScriptSetArrowEnd(AVars: TVariableSet): TScriptResult;
2207 var ak: TArrowKind;
2208   kindStr: String;
2209 begin
2210   kindStr := PascalToCSSCase(AVars.Strings['Kind']);
2211   ak := StrToArrowKind(kindStr);
2212   if (ak = akNone) and (kindStr <> ArrowKindToStr[akNone]) then
2213     exit(srInvalidParameters);
2214   ArrowEnd := ak;
2215   result := srOk;
2216 end;
2217 
TToolManager.ScriptSetArrowSizenull2218 function TToolManager.ScriptSetArrowSize(AVars: TVariableSet): TScriptResult;
2219 var
2220   s: TPointF;
2221 begin
2222   s := AVars.Points2D['Size'];
2223   if isEmptyPointF(s) then exit(srInvalidParameters);
2224   ArrowSize := s;
2225   result := srOk;
2226 end;
2227 
ScriptSetArrowStartnull2228 function TToolManager.ScriptSetArrowStart(AVars: TVariableSet): TScriptResult;
2229 var ak: TArrowKind;
2230   kindStr: String;
2231 begin
2232   kindStr := PascalToCSSCase(AVars.Strings['Kind']);
2233   ak := StrToArrowKind(kindStr);
2234   if (ak = akNone) and (kindStr <> ArrowKindToStr[akNone]) then
2235     exit(srInvalidParameters);
2236   ArrowStart := ak;
2237   result := srOk;
2238 end;
2239 
TToolManager.ScriptSetBackColornull2240 function TToolManager.ScriptSetBackColor(AVars: TVariableSet): TScriptResult;
2241 begin
2242   BackColor := AVars.Pixels['Color'];
2243   result := srOk;
2244 end;
2245 
ScriptSetOutlineColornull2246 function TToolManager.ScriptSetOutlineColor(AVars: TVariableSet): TScriptResult;
2247 begin
2248   OutlineColor := AVars.Pixels['Color'];
2249   result := srOk;
2250 end;
2251 
TToolManager.ScriptSetBrushIndexnull2252 function TToolManager.ScriptSetBrushIndex(AVars: TVariableSet): TScriptResult;
2253 var
2254   index: Int64;
2255 begin
2256   index := AVars.Integers['Index'];
2257   if (index < 0) or (index >= BrushCount) then exit(srException);
2258   BrushIndex:= index;
2259   result := srOk;
2260 end;
2261 
TToolManager.ScriptSetBrushSpacingnull2262 function TToolManager.ScriptSetBrushSpacing(AVars: TVariableSet): TScriptResult;
2263 begin
2264   BrushSpacing := AVars.Integers['Spacing'];
2265   result := srOk;
2266 end;
2267 
ScriptSetDeformationGridModenull2268 function TToolManager.ScriptSetDeformationGridMode(AVars: TVariableSet): TScriptResult;
2269 begin
2270   result := srOk;
2271   case AVars.Strings['Mode'] of
2272   'Deform': DeformationGridMode := gmDeform;
2273   'MovePointWithoutDeformation': DeformationGridMode := gmMovePointWithoutDeformation;
2274   else result := srInvalidParameters;
2275   end;
2276 end;
2277 
TToolManager.ScriptSetDeformationGridSizenull2278 function TToolManager.ScriptSetDeformationGridSize(AVars: TVariableSet): TScriptResult;
2279 var
2280   s: TPointF;
2281 begin
2282   s := AVars.Points2D['Size'];
2283   if s.x < MinDeformationGridSize then exit(srInvalidParameters);
2284   if s.y < MinDeformationGridSize then exit(srInvalidParameters);
2285   DeformationGridSize := Size(round(s.x),round(s.y));
2286   result := srOk;
2287 end;
2288 
TToolManager.ScriptSetEraserAlphanull2289 function TToolManager.ScriptSetEraserAlpha(AVars: TVariableSet): TScriptResult;
2290 var
2291   alpha: Int64;
2292 begin
2293   alpha := AVars.Integers['Alpha'];
2294   if alpha < 0 then alpha := 0;
2295   if alpha > 255 then alpha := 255;
2296   EraserAlpha:= alpha;
2297   result := srOk;
2298 end;
2299 
TToolManager.ScriptSetEraserModenull2300 function TToolManager.ScriptSetEraserMode(AVars: TVariableSet): TScriptResult;
2301 begin
2302   result := srOk;
2303   case AVars.Strings['Mode'] of
2304   'EraseAlpha': EraserMode:= emEraseAlpha;
2305   'Soften': EraserMode := emSoften;
2306   else result := srInvalidParameters;
2307   end;
2308 end;
2309 
ScriptSetFloodFillOptionsnull2310 function TToolManager.ScriptSetFloodFillOptions(AVars: TVariableSet): TScriptResult;
2311 var optionsSet: TFloodFillOptions;
2312   optionsVar: TScriptVariableReference;
2313   i: Integer;
2314   optionStr: string;
2315 begin
2316   optionsSet := [];
2317   optionsVar := AVars.GetVariable('Options');
2318   for i := 0 to AVars.GetListCount(optionsVar)-1 do
2319   begin
2320     optionStr := AVars.GetStringAt(optionsVar, i);
2321     case optionStr of
2322     'Progressive': include(optionsSet, ffProgressive);
2323     'FillAll': include(optionsSet, ffFillAll);
2324     else exit(srInvalidParameters);
2325     end;
2326   end;
2327   FloodFillOptions:= optionsSet;
2328   result := srOk;
2329 end;
2330 
ScriptSetFontNamenull2331 function TToolManager.ScriptSetFontName(AVars: TVariableSet): TScriptResult;
2332 begin
2333   SetTextFont(AVars.Strings['Name'], TextFontSize, TextFontStyle);
2334   result := srOk;
2335 end;
2336 
ScriptSetFontSizenull2337 function TToolManager.ScriptSetFontSize(AVars: TVariableSet): TScriptResult;
2338 begin
2339   SetTextFont(TextFontName, AVars.Floats['Size'], TextFontStyle);
2340   result := srOk;
2341 end;
2342 
TToolManager.ScriptSetFontStylenull2343 function TToolManager.ScriptSetFontStyle(AVars: TVariableSet): TScriptResult;
2344 var style: TFontStyles;
2345   styles: TScriptVariableReference;
2346   i: Integer;
2347   styleStr: string;
2348 begin
2349   style := [];
2350   styles := AVars.GetVariable('Style');
2351   for i := 0 to AVars.GetListCount(styles)-1 do
2352   begin
2353     styleStr := AVars.GetStringAt(styles, i);
2354     case styleStr of
2355     'Bold': include(style, fsBold);
2356     'Italic': include(style, fsItalic);
2357     'Underline': include(style, fsUnderline);
2358     'StrikeOut': include(style, fsStrikeOut);
2359     else exit(srInvalidParameters);
2360     end;
2361   end;
2362   SetTextFont(TextFontName, TextFontSize, style);
2363   result := srOk;
2364 end;
2365 
TToolManager.ScriptSetGradientInterpolationnull2366 function TToolManager.ScriptSetGradientInterpolation(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
2367 var
2368   ci: TBGRAColorInterpolation;
2369 begin
2370   if AFill.FillType <> vftGradient then exit(srException);
2371   result := srOk;
2372   ci := StrToGradientInterpolation(AVars.Strings['Interpolation']);
2373   if GradientInterpolationToStr(ci) <> AVars.Strings['Interpolation'] then
2374     result := srInvalidParameters
2375   else AFill.Gradient.ColorInterpolation:= ci;
2376 end;
2377 
ScriptSetGradientRepetitionnull2378 function TToolManager.ScriptSetGradientRepetition(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
2379 var
2380   gr: TBGRAGradientRepetition;
2381 begin
2382   if AFill.FillType <> vftGradient then exit(srException);
2383   result := srOk;
2384   gr := StrToGradientRepetition(AVars.Strings['Repetition']);
2385   if GradientRepetitionToStr(gr) <> AVars.Strings['Repetition'] then
2386     result := srInvalidParameters
2387   else AFill.Gradient.Repetition:= gr;
2388 end;
2389 
TToolManager.ScriptSetGradientTypenull2390 function TToolManager.ScriptSetGradientType(AVars: TVariableSet; AFill: TVectorialFill): TScriptResult;
2391 var
2392   gt: TGradientType;
2393   b: TAffineBox;
2394   lastGrad: TBGRALayerGradientOriginal;
2395 begin
2396   result := srOk;
2397   gt := StrToGradientType(AVars.Strings['GradientType']);
2398   if GradientTypeStr[gt] <> AVars.Strings['GradientType'] then
2399     exit(srInvalidParameters);
2400   if AFill.FillType = vftGradient then
2401     AFill.Gradient.GradientType:= gt
2402   else
2403   begin
2404     if AFill = BackFill then lastGrad := FBackLastGradient
2405     else if AFill = OutlineFill then lastGrad := FOutlineLastGradient
2406     else lastGrad := FForeLastGradient;
2407 
2408     lastGrad.GradientType:= gt;
2409     b := SuggestGradientBox;
2410     if gt = gtLinear then lastGrad.Origin := b.TopLeft else
2411       lastGrad.Origin := (b.TopLeft+b.BottomRight)*0.5;
2412     lastGrad.XAxis := b.BottomRight;
2413     lastGrad.YAxis := EmptyPointF;
2414     lastGrad.FocalPoint := EmptyPointF;
2415     lastGrad.Radius := 1;
2416     lastGrad.FocalRadius := 0;
2417     AFill.SetGradient(lastGrad, False);
2418   end;
2419 end;
2420 
TToolManager.ScriptSetGradientColorsnull2421 function TToolManager.ScriptSetGradientColors(AVars: TVariableSet;
2422   AFill: TVectorialFill): TScriptResult;
2423 var
2424   colors: TScriptVariableReference;
2425   lastGrad: TBGRALayerGradientOriginal;
2426   b: TAffineBox;
2427 begin
2428   result := srOk;
2429   colors := AVars.GetVariable('Colors');
2430   if TVariableSet.GetListCount(colors) <> 2 then
2431     exit(srInvalidParameters);
2432 
2433   if AFill.FillType = vftGradient then
2434     AFill.Gradient.SetColors(TVariableSet.GetPixelAt(colors, 0), TVariableSet.GetPixelAt(colors, 1))
2435   else
2436   begin
2437     if AFill = BackFill then lastGrad := FBackLastGradient
2438     else if AFill = OutlineFill then lastGrad := FOutlineLastGradient
2439     else lastGrad := FForeLastGradient;
2440 
2441     b := SuggestGradientBox;
2442     if lastGrad.GradientType = gtLinear then lastGrad.Origin := b.TopLeft else
2443       lastGrad.Origin := (b.TopLeft+b.BottomRight)*0.5;
2444     lastGrad.XAxis := b.BottomRight;
2445     lastGrad.YAxis := EmptyPointF;
2446     lastGrad.FocalPoint := EmptyPointF;
2447     lastGrad.Radius := 1;
2448     lastGrad.FocalRadius := 0;
2449     lastGrad.SetColors(TVariableSet.GetPixelAt(colors, 0), TVariableSet.GetPixelAt(colors, 1));
2450     AFill.SetGradient(lastGrad, False);
2451   end;
2452 end;
2453 
ScriptSetBackGradientInterpolationnull2454 function TToolManager.ScriptSetBackGradientInterpolation(AVars: TVariableSet): TScriptResult;
2455 begin
2456   result := ScriptSetGradientInterpolation(AVars, FBackFill);
2457 end;
2458 
ScriptSetBackGradientRepetitionnull2459 function TToolManager.ScriptSetBackGradientRepetition(AVars: TVariableSet): TScriptResult;
2460 begin
2461   result := ScriptSetGradientRepetition(AVars, FBackFill);
2462 end;
2463 
ScriptSetBackGradientTypenull2464 function TToolManager.ScriptSetBackGradientType(AVars: TVariableSet): TScriptResult;
2465 begin
2466   result := ScriptSetGradientType(AVars, FBackFill);
2467 end;
2468 
TToolManager.ScriptSetBackGradientColorsnull2469 function TToolManager.ScriptSetBackGradientColors(AVars: TVariableSet): TScriptResult;
2470 begin
2471   result := ScriptSetGradientColors(AVars, FBackFill);
2472 end;
2473 
ScriptSetOutlineGradientInterpolationnull2474 function TToolManager.ScriptSetOutlineGradientInterpolation(AVars: TVariableSet): TScriptResult;
2475 begin
2476   result := ScriptSetGradientInterpolation(AVars, FOutlineFill);
2477 end;
2478 
TToolManager.ScriptSetOutlineGradientRepetitionnull2479 function TToolManager.ScriptSetOutlineGradientRepetition(AVars: TVariableSet): TScriptResult;
2480 begin
2481   result := ScriptSetGradientRepetition(AVars, FOutlineFill);
2482 end;
2483 
TToolManager.ScriptSetOutlineGradientTypenull2484 function TToolManager.ScriptSetOutlineGradientType(AVars: TVariableSet): TScriptResult;
2485 begin
2486   result := ScriptSetGradientType(AVars, FOutlineFill);
2487 end;
2488 
TToolManager.ScriptSetOutlineGradientColorsnull2489 function TToolManager.ScriptSetOutlineGradientColors(AVars: TVariableSet): TScriptResult;
2490 begin
2491   result := ScriptSetGradientColors(AVars, FOutlineFill);
2492 end;
2493 
ScriptSetForeGradientInterpolationnull2494 function TToolManager.ScriptSetForeGradientInterpolation(AVars: TVariableSet): TScriptResult;
2495 begin
2496   result := ScriptSetGradientInterpolation(AVars, FForeFill);
2497 end;
2498 
TToolManager.ScriptSetForeGradientRepetitionnull2499 function TToolManager.ScriptSetForeGradientRepetition(AVars: TVariableSet): TScriptResult;
2500 begin
2501   result := ScriptSetGradientRepetition(AVars, FForeFill);
2502 end;
2503 
ScriptSetForeGradientTypenull2504 function TToolManager.ScriptSetForeGradientType(AVars: TVariableSet): TScriptResult;
2505 begin
2506   result := ScriptSetGradientType(AVars, FForeFill);
2507 end;
2508 
ScriptSetForeGradientColorsnull2509 function TToolManager.ScriptSetForeGradientColors(AVars: TVariableSet): TScriptResult;
2510 begin
2511   result := ScriptSetGradientColors(AVars, FForeFill);
2512 end;
2513 
ScriptSetTexturenull2514 function TToolManager.ScriptSetTexture(AVars: TVariableSet;
2515   AFill: TVectorialFill): TScriptResult;
2516 var
2517   fileName: String;
2518   flatImg: TBGRABitmap;
2519 begin
2520   fileName := trim(AVars.Strings['FileName']);
2521   if fileName='' then exit(srInvalidParameters);
2522   flatImg := LoadFlatImageUTF8(fileName).bmp;
2523   if flatImg = nil then exit(srException);
2524   try
2525     if AFill.FillType <> vftTexture then
2526       AFill.SetTexture(flatImg, AffineMatrixIdentity)
2527     else
2528       AFill.SetTexture(flatImg, AffineMatrixIdentity, AFill.TextureOpacity, AFill.TextureRepetition);
2529     result := srOk;
2530   finally
2531     flatImg.FreeReference;
2532   end;
2533 end;
2534 
ScriptSetTextureRepetitionnull2535 function TToolManager.ScriptSetTextureRepetition(AVars: TVariableSet;
2536   AFill: TVectorialFill): TScriptResult;
2537 begin
2538   if AFill.FillType <> vftTexture then exit(srException);
2539   case AVars.Strings['Repetition'] of
2540   'None': AFill.TextureRepetition:= trNone;
2541   'RepeatX': AFill.TextureRepetition:= trRepeatX;
2542   'RepeatY': AFill.TextureRepetition:= trRepeatY;
2543   'RepeatBoth': AFill.TextureRepetition:= trRepeatBoth;
2544   else exit(srInvalidParameters);
2545   end;
2546   result := srOk;
2547 end;
2548 
TToolManager.ScriptSetTextureOpacitynull2549 function TToolManager.ScriptSetTextureOpacity(AVars: TVariableSet;
2550   AFill: TVectorialFill): TScriptResult;
2551 begin
2552   if AFill.FillType <> vftTexture then exit(srException);
2553   AFill.TextureOpacity := min(255, max(0, AVars.Integers['Opacity']));
2554   result := srOk;
2555 end;
2556 
TToolManager.ScriptSetBackTexturenull2557 function TToolManager.ScriptSetBackTexture(AVars: TVariableSet): TScriptResult;
2558 begin
2559   result := ScriptSetTexture(AVars, BackFill);
2560 end;
2561 
TToolManager.ScriptSetBackTextureRepetitionnull2562 function TToolManager.ScriptSetBackTextureRepetition(AVars: TVariableSet): TScriptResult;
2563 begin
2564   result := ScriptSetTextureRepetition(AVars, BackFill);
2565 end;
2566 
TToolManager.ScriptSetBackTextureOpacitynull2567 function TToolManager.ScriptSetBackTextureOpacity(AVars: TVariableSet): TScriptResult;
2568 begin
2569   result := ScriptSetTextureOpacity(AVars, BackFill);
2570 end;
2571 
ScriptSetForeTexturenull2572 function TToolManager.ScriptSetForeTexture(AVars: TVariableSet): TScriptResult;
2573 begin
2574   result := ScriptSetTexture(AVars, ForeFill);
2575 end;
2576 
TToolManager.ScriptSetForeTextureRepetitionnull2577 function TToolManager.ScriptSetForeTextureRepetition(AVars: TVariableSet): TScriptResult;
2578 begin
2579   result := ScriptSetTextureRepetition(AVars, ForeFill);
2580 end;
2581 
TToolManager.ScriptSetForeTextureOpacitynull2582 function TToolManager.ScriptSetForeTextureOpacity(AVars: TVariableSet): TScriptResult;
2583 begin
2584   result := ScriptSetTextureOpacity(AVars, ForeFill);
2585 end;
2586 
TToolManager.ScriptSetOutlineTexturenull2587 function TToolManager.ScriptSetOutlineTexture(AVars: TVariableSet): TScriptResult;
2588 begin
2589   result := ScriptSetTexture(AVars, OutlineFill);
2590 end;
2591 
TToolManager.ScriptSetOutlineTextureRepetitionnull2592 function TToolManager.ScriptSetOutlineTextureRepetition(AVars: TVariableSet): TScriptResult;
2593 begin
2594   result := ScriptSetTextureRepetition(AVars, OutlineFill);
2595 end;
2596 
ScriptSetOutlineTextureOpacitynull2597 function TToolManager.ScriptSetOutlineTextureOpacity(AVars: TVariableSet): TScriptResult;
2598 begin
2599   result := ScriptSetTextureOpacity(AVars, OutlineFill);
2600 end;
2601 
ScriptSetJoinStylenull2602 function TToolManager.ScriptSetJoinStyle(AVars: TVariableSet): TScriptResult;
2603 begin
2604   result := srOk;
2605   case AVars.Strings['Style'] of
2606   'Bevel': JoinStyle := pjsBevel;
2607   'Miter': JoinStyle := pjsMiter;
2608   'Round': JoinStyle := pjsRound;
2609   else result := srInvalidParameters;
2610   end;
2611 end;
2612 
ScriptSetLightPositionnull2613 function TToolManager.ScriptSetLightPosition(AVars: TVariableSet): TScriptResult;
2614 var
2615   ptF: TPointF;
2616 begin
2617   ptF := AVars.Points2D['Position'];
2618   if IsEmptyPointF(ptF) then exit(srInvalidParameters);
2619   LightPosition := ptF;
2620   result := srOk;
2621 end;
2622 
ScriptSetLineCapnull2623 function TToolManager.ScriptSetLineCap(AVars: TVariableSet): TScriptResult;
2624 var
2625   capStr: String;
2626 begin
2627   capStr := AVars.Strings['Cap'];
2628   case capStr of
2629   'Round': LineCap := pecRound;
2630   'Square': LineCap := pecSquare;
2631   'Flat': LineCap := pecFlat;
2632   else exit(srInvalidParameters);
2633   end;
2634   result := srOk;
2635 end;
2636 
TToolManager.ScriptSetForeColornull2637 function TToolManager.ScriptSetForeColor(AVars: TVariableSet): TScriptResult;
2638 begin
2639   ForeColor := AVars.Pixels['Color'];
2640   ToolUpdate;
2641   result := srOk;
2642 end;
2643 
ScriptSetPenStylenull2644 function TToolManager.ScriptSetPenStyle(AVars: TVariableSet): TScriptResult;
2645 begin
2646   result := srOk;
2647   case AVars.Strings['Style'] of
2648   'Solid': PenStyle := psSolid;
2649   'Dash': PenStyle := psDash;
2650   'Dot': PenStyle := psDot;
2651   'DashDot': PenStyle := psDashDot;
2652   'DashDotDot': PenStyle := psDashDotDot;
2653   else result := srInvalidParameters;
2654   end;
2655 end;
2656 
ScriptSetPenWidthnull2657 function TToolManager.ScriptSetPenWidth(AVars: TVariableSet): TScriptResult;
2658 begin
2659   PenWidth:= AVars.Floats['Width'];
2660   result := srOk;
2661 end;
2662 
ScriptSetPerspectiveOptionsnull2663 function TToolManager.ScriptSetPerspectiveOptions(AVars: TVariableSet): TScriptResult;
2664 var optionsSet: TPerspectiveOptions;
2665   optionsVar: TScriptVariableReference;
2666   i: Integer;
2667   optionStr: string;
2668 begin
2669   optionsSet := [];
2670   optionsVar := AVars.GetVariable('Options');
2671   for i := 0 to AVars.GetListCount(optionsVar)-1 do
2672   begin
2673     optionStr := AVars.GetStringAt(optionsVar, i);
2674     case optionStr of
2675     'Repeat': include(optionsSet, poRepeat);
2676     'TwoPlanes': include(optionsSet, poTwoPlanes);
2677     else exit(srInvalidParameters);
2678     end;
2679   end;
2680   PerspectiveOptions := optionsSet;
2681   result := srOk;
2682 end;
2683 
TToolManager.ScriptSetPhongShapeAltitudenull2684 function TToolManager.ScriptSetPhongShapeAltitude(AVars: TVariableSet): TScriptResult;
2685 begin
2686   if (AVars.Floats['Size'] < MinPhongShapeAltitude) or
2687      (AVars.Floats['Size'] > MaxPhongShapeAltitude) then exit(srInvalidParameters);
2688   result := srOk;
2689   PhongShapeAltitude := AVars.Integers['Altitude'];
2690 end;
2691 
ScriptSetPhongShapeBorderSizenull2692 function TToolManager.ScriptSetPhongShapeBorderSize(AVars: TVariableSet): TScriptResult;
2693 begin
2694   if (AVars.Floats['Size'] < MinPhongBorderSize) or
2695      (AVars.Floats['Size'] > MaxPhongBorderSize) then exit(srInvalidParameters);
2696   result := srOk;
2697   PhongShapeBorderSize := AVars.Integers['Size'];
2698 end;
2699 
TToolManager.ScriptSetPhongShapeKindnull2700 function TToolManager.ScriptSetPhongShapeKind(AVars: TVariableSet): TScriptResult;
2701 begin
2702   result := srOk;
2703   case AVars.Strings['Kind'] of
2704   'Rectangle': PhongShapeKind := pskRectangle;
2705   'RoundRectangle': PhongShapeKind := pskRoundRectangle;
2706   'HalfSphere': PhongShapeKind := pskHalfSphere;
2707   'ConeTop': PhongShapeKind := pskConeTop;
2708   'ConeSide': PhongShapeKind := pskConeSide;
2709   'HorizCylinder': PhongShapeKind := pskHorizCylinder;
2710   'VertCylinder': PhongShapeKind := pskVertCylinder;
2711   else result := srInvalidParameters;
2712   end;
2713 end;
2714 
TToolManager.ScriptSetShapeOptionsnull2715 function TToolManager.ScriptSetShapeOptions(AVars: TVariableSet): TScriptResult;
2716 var so: TShapeOptions;
2717   options: TScriptVariableReference;
2718   i: Integer;
2719   opt: String;
2720 begin
2721   so := [];
2722   if toAliasing in ShapeOptions then include(so, toAliasing);
2723   options := AVars.GetVariable('Options');
2724   for i := 0 to AVars.GetListCount(options)-1 do
2725   begin
2726     opt := AVars.GetStringAt(options, i);
2727     case opt of
2728     'DrawShape': include(so, toDrawShape);
2729     'FillShape': include(so, toFillShape);
2730     'CloseShape': include(so, toCloseShape);
2731     else exit(srInvalidParameters);
2732     end;
2733   end;
2734   if [toDrawShape,toFillShape]*so = [] then
2735     so := so + [toDrawShape,toFillShape]*ShapeOptions;
2736   ShapeOptions := so;
2737   result := srOk;
2738 end;
2739 
ScriptSetShapeRationull2740 function TToolManager.ScriptSetShapeRatio(AVars: TVariableSet): TScriptResult;
2741 var
2742   ratio: single;
2743 begin
2744   ratio := AVars.Floats['Ratio'];
2745   if ratio <= 0 then result := srException else
2746   begin
2747     ShapeRatio := ratio;
2748     result := srOk;
2749   end;
2750 end;
2751 
TToolManager.ScriptSetSplineStylenull2752 function TToolManager.ScriptSetSplineStyle(AVars: TVariableSet): TScriptResult;
2753 var
2754   s: TSplineStyle;
2755 begin
2756   case AVars.Strings['Style'] of
2757     'Inside': s := ssInside;
2758     'InsideWithEnds': s := ssInsideWithEnds;
2759     'Crossing': s := ssCrossing;
2760     'CrossingWithEnds': s := ssCrossingWithEnds;
2761     'Outside': s := ssOutside;
2762     'RoundOutside': s := ssRoundOutside;
2763     'VertexToSide': s := ssVertexToSide;
2764     'EasyBezier': s := ssEasyBezier;
2765   else
2766     exit(srInvalidParameters);
2767   end;
2768   SplineStyle := s;
2769   result := srOk;
2770 end;
2771 
ScriptSetTextAlignnull2772 function TToolManager.ScriptSetTextAlign(AVars: TVariableSet): TScriptResult;
2773 begin
2774   case AVars.Strings['Align'] of
2775   'Left': TextAlign:= taLeftJustify;
2776   'Center': TextAlign:= taCenter;
2777   'Right': TextAlign:= taRightJustify;
2778   else exit(srInvalidParameters);
2779   end;
2780   result := srOk;
2781 end;
2782 
ScriptSetTextOutlinenull2783 function TToolManager.ScriptSetTextOutline(AVars: TVariableSet): TScriptResult;
2784 begin
2785   if AVars.IsDefined('Width') and (AVars.Floats['Width'] > 0) then
2786     SetTextOutline(true, AVars.Floats['Width'])
2787   else
2788     SetTextOutline(false, TextOutlineWidth);
2789   result := srOk;
2790 end;
2791 
TToolManager.ScriptSetTextPhongnull2792 function TToolManager.ScriptSetTextPhong(AVars: TVariableSet): TScriptResult;
2793 begin
2794   TextPhong:= AVars.Booleans['Enabled'];
2795   result := srOk;
2796 end;
2797 
ScriptSetTolerancenull2798 function TToolManager.ScriptSetTolerance(AVars: TVariableSet): TScriptResult;
2799 var
2800   alpha: Int64;
2801 begin
2802   alpha := AVars.Integers['Tolerance'];
2803   if alpha < 0 then alpha := 0;
2804   if alpha > 255 then alpha := 255;
2805   Tolerance:= alpha;
2806   result := srOk;
2807 end;
2808 
2809 procedure TToolManager.SetBrushIndex(AValue: integer);
2810 begin
2811   if FBrushIndex=AValue then Exit;
2812   FBrushIndex:=AValue;
2813   ToolUpdate;
2814   if Assigned(FOnBrushChanged) then FOnBrushChanged(self);
2815 end;
2816 
2817 procedure TToolManager.SetBrushSpacing(AValue: integer);
2818 begin
2819   if AValue < 0 then AValue := 0;
2820   if AValue > MaxBrushSpacing then AValue := MaxBrushSpacing;
2821   if FBrushSpacing=AValue then Exit;
2822   FBrushSpacing:=AValue;
2823   ToolUpdate;
2824   if Assigned(FOnBrushChanged) then FOnBrushChanged(self);
2825 end;
2826 
2827 constructor TToolManager.Create(AImage: TLazPaintImage; AConfigProvider: IConfigProvider;
2828   ABitmapToVirtualScreen: TBitmapToVirtualScreenFunction;
2829   ABlackAndWhite : boolean; AScriptContext: TScriptContext);
2830 begin
2831   FImage:= AImage;
2832   CanvasScale := 1;
2833   BitmapToVirtualScreen := ABitmapToVirtualScreen;
2834   FShouldExitTool:= false;
2835   FConfigProvider := AConfigProvider;
2836   FBlackAndWhite := ABlackAndWhite;
2837   FScriptContext := AScriptContext;
2838   RegisterScriptFunctions(True);
2839 
2840   FForeFill := TVectorialFill.Create;
2841   FForeFill.TransparentMode := tmAlphaZeroOnly;
2842   FForeFill.SolidColor := BGRABlack;
2843   FForeFill.OnChange:= @FillChange;
2844   FForeLastGradient:= TBGRALayerGradientOriginal.Create;
2845   FForeLastGradient.ColorInterpolation:= ciLinearRGB;
2846 
2847   FBackFill := TVectorialFill.Create;
2848   FBackFill.TransparentMode := tmAlphaZeroOnly;
2849   FBackFill.SolidColor := CSSSkyBlue;
2850   FBackFill.OnChange:= @FillChange;
2851   FBackLastGradient:= TBGRALayerGradientOriginal.Create;
2852   FBackLastGradient.ColorInterpolation:= ciLinearRGB;
2853 
2854   FOutlineFill := TVectorialFill.Create;
2855   FOutlineFill.TransparentMode := tmAlphaZeroOnly;
2856   FOutlineFill.SolidColor := CSSRed;
2857   FOutlineFill.OnChange:= @FillChange;
2858   FOutlineLastGradient:= TBGRALayerGradientOriginal.Create;
2859   FOutlineLastGradient.ColorInterpolation:= ciLinearRGB;
2860 
2861   FNormalPenWidth := 5;
2862   FEraserWidth := 10;
2863   FEraserAlpha := 255;
2864   FEraserMode := emEraseAlpha;
2865   ReloadBrushes;
2866   FBrushSpacing := 1;
2867   FShapeOptions := [toDrawShape, toFillShape, toCloseShape];
2868   FPenStyle := psSolid;
2869   FLineCap := pecRound;
2870   FJoinStyle := pjsRound;
2871   FArrowStart := akNone;
2872   FArrowEnd := akNone;
2873   FArrowSize := PointF(2,2);
2874   FSplineStyle := ssEasyBezier;
2875   FFloodFillOptions := [ffProgressive];
2876   FTolerance := 64;
2877   FTextOutline := False;
2878   FTextOutlineWidth := 2;
2879   FTextShadow := false;
2880   FTextFontSize := 10;
2881   FTextFontName := TTextShape.DefaultFontName;
2882   FTextFontStyle:= [];
2883   FTextAlign := taLeftJustify;
2884   FTextPhong := False;
2885   FTextShadowBlurRadius := 4;
2886   FTextShadowOffset := Point(5,5);
2887   FLightPosition := PointF(0,0);
2888   FLightAltitude := 100;
2889   FPhongShapeKind := pskRectangle;
2890   FPhongShapeAltitude := 50;
2891   FPhongShapeBorderSize := 20;
2892   FPerspectiveOptions:= [];
2893   FDeformationGridNbX := 5;
2894   FDeformationGridNbY := 5;
2895   FDeformationGridMode := gmDeform;
2896 
2897   PenWidthControls := TList.Create;
2898   AliasingControls := TList.Create;
2899   ShapeControls := TList.Create;
2900   PenStyleControls := TList.Create;
2901   CloseShapeControls := TList.Create;
2902   LineCapControls := TList.Create;
2903   JoinStyleControls := TList.Create;
2904   SplineStyleControls := TList.Create;
2905   EraserControls := TList.Create;
2906   ToleranceControls := TList.Create;
2907   DeformationControls := TList.Create;
2908   TextControls := TList.Create;
2909   TextShadowControls := TList.Create;
2910   PhongControls := TList.Create;
2911   AltitudeControls := TList.Create;
2912   PerspectiveControls := TList.Create;
2913   FillControls := TList.Create;
2914   OutlineFillControls := TList.Create;
2915   BrushControls := TList.Create;
2916   RatioControls := TList.Create;
2917   DonateControls := TList.Create;
2918 
2919   FCurrentToolType := ptHand;
2920   FCurrentTool := PaintTools[ptHand].Create(Self);
2921 end;
2922 
2923 destructor TToolManager.Destroy;
2924 var
2925   i: Integer;
2926 begin
2927   SaveBrushes;
2928   CurrentTool.Free;
2929 
2930   PenWidthControls.Free;
2931   AliasingControls.Free;
2932   ShapeControls.Free;
2933   PenStyleControls.Free;
2934   CloseShapeControls.Free;
2935   LineCapControls.Free;
2936   JoinStyleControls.Free;
2937   SplineStyleControls.Free;
2938   EraserControls.Free;
2939   ToleranceControls.Free;
2940   DeformationControls.Free;
2941   TextControls.Free;
2942   TextShadowControls.Free;
2943   PhongControls.Free;
2944   AltitudeControls.Free;
2945   PerspectiveControls.Free;
2946   FillControls.Free;
2947   OutlineFillControls.Free;
2948   BrushControls.Free;
2949   RatioControls.Free;
2950   DonateControls.Free;
2951 
2952   for i := 0 to BrushCount do
2953     BrushAt[i].Free;
2954   FBrushInfoList.Free;
2955 
2956   FForeFill.Free;
2957   FBackFill.Free;
2958   FOutlineFill.Free;
2959   FForeLastGradient.Free;
2960   FBackLastGradient.Free;
2961   FOutlineLastGradient.Free;
2962 
2963   RegisterScriptFunctions(False);
2964   inherited Destroy;
2965 end;
2966 
2967 procedure TToolManager.LoadFromConfig;
2968 var
2969   Config: TLazPaintConfig;
2970   opt: TShapeOptions;
2971 begin
2972   if Assigned(FConfigProvider) then
2973     Config := FConfigProvider.GetConfig
2974   else
2975     exit;
2976   ForeColor := Config.DefaultToolForeColor;
2977   BackColor := Config.DefaultToolBackColor;
2978   OutlineColor := Config.DefaultToolOutlineColor;
2979   AssignGradientFromConfigStr(FForeLastGradient, Config.DefaultToolForeGradient);
2980   AssignGradientFromConfigStr(FBackLastGradient, Config.DefaultToolBackGradient);
2981   AssignGradientFromConfigStr(FOutlineLastGradient, Config.DefaultToolOutlineGradient);
2982   FNormalPenWidth := Config.DefaultToolPenWidth;
2983   FEraserWidth := Config.DefaultToolEraserWidth;
2984   if Assigned(FOnPenWidthChanged) then FOnPenWidthChanged(self);
2985   ReloadBrushes;
2986   opt := [];
2987   if Config.DefaultToolOptionDrawShape then include(opt, toDrawShape);
2988   if Config.DefaultToolOptionFillShape then include(opt, toFillShape);
2989   if Config.DefaultToolOptionCloseShape then include(opt, toCloseShape);
2990   ShapeOptions:= opt;
2991   Tolerance := Config.DefaultToolTolerance;
2992 
2993   //TextShadow := Config.DefaultToolTextShadow;
2994   SetTextOutline(Config.DefaultToolTextOutline, Config.DefaultToolTextOutlineWidth);
2995   TextPhong := Config.DefaultToolTextPhong;
2996   with Config.DefaultToolTextFont do
2997     SetTextFont(Name, Size, Style);
2998   TextShadowBlurRadius := Config.DefaultToolTextBlur;
2999   TextShadowOffset := Config.DefaultToolTextShadowOffset;
3000 
3001   LightPosition := Config.DefaultToolLightPosition;
3002   LightAltitude := Config.DefaultToolLightAltitude;
3003   PhongShapeAltitude := Config.DefaultToolShapeAltitude;
3004   PhongShapeBorderSize := Config.DefaultToolShapeBorderSize;
3005   PhongShapeKind := Config.DefaultToolShapeType;
3006 end;
3007 
3008 procedure TToolManager.SaveToConfig;
3009 var
3010   Config: TLazPaintConfig;
3011 begin
3012   if Assigned(FConfigProvider) then
3013     Config := FConfigProvider.GetConfig
3014   else
3015     exit;
3016   if ForeFill.FillType = vftSolid then Config.SetDefaultToolForeColor(ForeColor);
3017   if BackFill.FillType = vftSolid then Config.SetDefaultToolBackColor(BackColor);
3018   if OutlineFill.FillType = vftSolid then Config.SetDefaultToolOutlineColor(OutlineColor);
3019   Config.SetDefaultToolForeGradient(GradientToConfigStr(FForeLastGradient));
3020   Config.SetDefaultToolBackGradient(GradientToConfigStr(FBackLastGradient));
3021   Config.SetDefaultToolOutlineGradient(GradientToConfigStr(FOutlineLastGradient));
3022   Config.SetDefaultToolPenWidth(FNormalPenWidth);
3023   Config.SetDefaultToolEraserWidth(FEraserWidth);
3024   Config.SetDefaultToolOptionDrawShape(toDrawShape in ShapeOptions);
3025   Config.SetDefaultToolOptionFillShape(toFillShape in ShapeOptions);
3026   Config.SetDefaultToolOptionCloseShape(toCloseShape in ShapeOptions);
3027   Config.SetDefaultToolTolerance(Tolerance);
3028 
3029   Config.SetDefaultToolTextFont(FTextFontName, FTextFontSize, FTextFontStyle);
3030   Config.SetDefaultToolTextShadow(TextShadow);
3031   Config.SetDefaultToolTextOutline(TextOutline);
3032   Config.SetDefaultToolTextOutlineWidth(TextOutlineWidth);
3033   Config.SetDefaultToolTextBlur(TextShadowBlurRadius);
3034   Config.SetDefaultToolTextShadowOffset(TextShadowOffset);
3035   Config.SetDefaultToolTextPhong(TextPhong);
3036 
3037   Config.SetDefaultToolLightPosition(LightPosition);
3038   Config.SetDefaultToolLightAltitude(LightAltitude);
3039   Config.SetDefaultToolShapeBorderSize(PhongShapeBorderSize);
3040   Config.SetDefaultToolShapeAltitude(PhongShapeAltitude);
3041   Config.SetDefaultToolShapeType(PhongShapeKind);
3042 end;
3043 
3044 procedure TToolManager.ReloadBrushes;
3045 var
3046   i: Integer;
3047   bi: TLazPaintBrush;
3048 begin
3049   If Assigned(FBrushInfoList) then
3050   begin
3051     for i := 0 to FBrushInfoList.Count-1 do
3052       TObject(FBrushInfoList[i]).Free;
3053     FBrushInfoList.Clear;
3054   end else
3055     FBrushInfoList := TList.Create;
3056   if Assigned(FConfigProvider) and (FConfigProvider.GetConfig <> nil) then
3057   begin
3058     for i := 0 to FConfigProvider.GetConfig.BrushCount-1 do
3059     begin
3060       bi := TLazPaintBrush.Create;
3061       try
3062         bi.AsString := FConfigProvider.GetConfig.BrushInfo[i];
3063       except
3064         continue;
3065       end;
3066       FBrushInfoList.Add(bi);
3067     end;
3068   end;
3069   if FBrushInfoList.Count = 0 then
3070   begin
3071     FBrushInfoList.Add(TLazPaintBrush.Create(0,True));
3072     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'));
3073   end;
3074   FBrushInfoListChanged := false;
3075 end;
3076 
3077 procedure TToolManager.SaveBrushes;
3078 var
3079   i: Integer;
3080   infos: TStringList;
3081 begin
3082   if Assigned(FConfigProvider) and FBrushInfoListChanged then
3083   begin
3084     infos := TStringList.Create;
3085     try
3086       for i := 0 to BrushCount-1 do
3087         infos.Add(BrushAt[i].AsString);
3088       FConfigProvider.GetConfig.SetBrushes(infos);
3089     except
3090     end;
3091     infos.Free;
3092   end;
3093   FBrushInfoListChanged := false;
3094 end;
3095 
ApplyPressurenull3096 function TToolManager.ApplyPressure(AColor: TBGRAPixel): TBGRAPixel;
3097 var alpha: integer;
3098 begin
3099   alpha := round(AColor.alpha*FToolPressure);
3100   if alpha <= 0 then
3101     result := BGRAPixelTransparent
3102   else if alpha >= 255 then
3103     result := AColor
3104   else
3105   begin
3106     result := AColor;
3107     result.alpha := alpha;
3108   end;
3109 end;
3110 
ApplyPressurenull3111 function TToolManager.ApplyPressure(AOpacity: byte): byte;
3112 begin
3113   result := round(AOpacity*FToolPressure);
3114 end;
3115 
3116 procedure TToolManager.SetPressure(APressure: single);
3117 begin
3118   if APressure <= 0 then
3119     FToolPressure := 0
3120   else if APressure >= 1 then
3121     FToolPressure := 1
3122   else
3123     FToolPressure:= APressure;
3124 end;
3125 
TToolManager.GetPressureBnull3126 function TToolManager.GetPressureB: Byte;
3127 begin
3128   result := round(FToolPressure*255);
3129 end;
3130 
3131 procedure TToolManager.StepPenSize(ADecrease: boolean);
SizeDeltanull3132   function SizeDelta: single;
3133   var v: single;
3134   begin
3135     v := PenWidth;
3136     if ADecrease then v := v - 0.1;
3137     if v < 10 then result := 1 else
3138     if v < 20 then result := 2 else
3139     if v < 50 then result := 5 else
3140     if v < 100 then result := 10 else
3141     if v < 200 then result := 20 else
3142     if v < 500 then result := 50 else
3143       result := 100;
3144   end;
3145 begin
3146   if ADecrease then
3147     PenWidth := PenWidth - SizeDelta
3148     else PenWidth := PenWidth + SizeDelta;
3149 end;
3150 
3151 procedure TToolManager.InternalSetCurrentToolType(tool: TPaintToolType);
3152 begin
3153   if (tool <> FCurrentToolType) or (FCurrentTool=nil) then
3154   begin
3155     FreeAndNil(FCurrentTool);
3156     if PaintTools[tool] <> nil then
3157       FCurrentTool := PaintTools[tool].Create(self)
3158     else
3159       FCurrentTool := nil;
3160 
3161     FCurrentToolType:= tool;
3162 
3163     if not IsSelectingTool then
3164       Image.ReleaseEmptySelection;
3165 
3166     UpdateContextualToolbars;
3167     If Assigned(FOnToolChangedHandler) then
3168       FOnToolChangedHandler(self, FCurrentToolType);
3169     If Assigned(FOnToolRenderChanged) then
3170       FOnToolRenderChanged(self);
3171   end;
3172   FShouldExitTool:= false;
3173 end;
3174 
TToolManager.UpdateContextualToolbarsnull3175 function TToolManager.UpdateContextualToolbars: boolean;
3176 var
3177   contextualToolbars: TContextualToolbars;
3178   hasPen: Boolean;
3179 
3180   procedure OrResult(AValue: boolean);
3181   begin
3182     if AValue then result := true;
3183   end;
3184 
3185 begin
3186   result := false;
3187   contextualToolbars := GetContextualToolbars;
3188   if Assigned(FCurrentTool) then
3189     hasPen := FCurrentTool.HasPen
3190     else hasPen := false;
3191 
3192   if (ctBackFill in contextualToolbars) and not (ctPenFill in contextualToolbars) then
3193     OrResult(SetControlsVisible(FillControls, True, 'Panel_BackFill')) else
3194   if (ctPenFill in contextualToolbars) and not (ctBackFill in contextualToolbars) then
3195     OrResult(SetControlsVisible(FillControls, True, 'Panel_PenFill'))
3196   else
3197     OrResult(SetControlsVisible(FillControls, (ctPenFill in contextualToolbars) and (ctBackFill in contextualToolbars)));
3198 
3199   OrResult(SetControlsVisible(BrushControls, ctBrush in contextualToolbars));
3200   OrResult(SetControlsVisible(ShapeControls, ctShape in contextualToolbars));
3201   OrResult(SetControlsVisible(PenWidthControls, (ctPenWidth in contextualToolbars) and hasPen));
3202   OrResult(SetControlsVisible(JoinStyleControls, (ctJoinStyle in contextualToolbars) and hasPen));
3203   OrResult(SetControlsVisible(PenStyleControls, (ctPenStyle in contextualToolbars) and hasPen));
3204   OrResult(SetControlsVisible(CloseShapeControls, ctCloseShape in contextualToolbars));
3205   OrResult(SetControlsVisible(LineCapControls, ToolHasLineCap));
3206   OrResult(SetControlsVisible(AliasingControls, ctAliasing in contextualToolbars));
3207   OrResult(SetControlsVisible(SplineStyleControls, ctSplineStyle in contextualToolbars));
3208   OrResult(SetControlsVisible(EraserControls, ctEraserOption in contextualToolbars));
3209   OrResult(SetControlsVisible(ToleranceControls, ctTolerance in contextualToolbars));
3210   OrResult(SetControlsVisible(DeformationControls, ctDeformation in contextualToolbars));
3211   if (ctText in contextualToolbars) and not (ctOutlineWidth in contextualToolbars) then
3212     OrResult(SetControlsVisible(TextControls, True, 'Panel_Text')) else
3213   if (ctOutlineWidth in contextualToolbars) and not (ctText in contextualToolbars) then
3214     OrResult(SetControlsVisible(TextControls, True, 'Panel_TextOutline'))
3215   else
3216     OrResult(SetControlsVisible(TextControls, (ctText in contextualToolbars) and (ctOutlineWidth in contextualToolbars)));
3217   OrResult(SetControlsVisible(OutlineFillControls, ctOutlineFill in contextualToolbars));
3218   OrResult(SetControlsVisible(TextShadowControls, ctTextShadow in contextualToolbars));
3219   OrResult(SetControlsVisible(PhongControls, ctPhong in contextualToolbars));
3220   OrResult(SetControlsVisible(AltitudeControls, ctAltitude in contextualToolbars));
3221   OrResult(SetControlsVisible(PerspectiveControls, ctPerspective in contextualToolbars));
3222   OrResult(SetControlsVisible(RatioControls, ctRatio in contextualToolbars));
3223   OrResult(SetControlsVisible(DonateControls, FCurrentToolType = ptHand));
3224 
3225   if result and Assigned(FOnToolbarChanged) then FOnToolbarChanged(self);
3226 end;
3227 
GetContextualToolbarsnull3228 function TToolManager.GetContextualToolbars: TContextualToolbars;
3229 begin
3230   if Assigned(FCurrentTool) then
3231     result := FCurrentTool.GetContextualToolbars
3232   else
3233     result := [ctPenFill, ctBackFill];
3234 end;
3235 
InternalBitmapToVirtualScreennull3236 function TToolManager.InternalBitmapToVirtualScreen(PtF: TPointF): TPointF;
3237 begin
3238   if Assigned(FCurrentTool) then
3239   begin
3240     ptF.x += FCurrentTool.LayerOffset.X;
3241     ptF.y += FCurrentTool.LayerOffset.Y;
3242   end;
3243   result := BitmapToVirtualScreen(ptF);
3244 end;
3245 
TToolManager.AddLayerOffsetnull3246 function TToolManager.AddLayerOffset(ARect: TRect): TRect;
3247 begin
3248   result := ARect;
3249   if (result.Left = OnlyRenderChange.Left) and
3250     (result.Top = OnlyRenderChange.Top) and
3251     (result.Right = OnlyRenderChange.Right) and
3252     (result.Bottom = OnlyRenderChange.Bottom) then exit;
3253   if Assigned(FCurrentTool) then
3254     OffsetRect(result, FCurrentTool.LayerOffset.X,FCurrentTool.LayerOffset.Y);
3255 end;
3256 
3257 procedure TToolManager.RegisterScriptFunctions(ARegister: boolean);
3258 begin
3259   if not Assigned(FScriptContext) then exit;
3260   FScriptContext.RegisterScriptFunction('ToolSetForeColor', @ScriptSetForeColor, ARegister);
3261   FScriptContext.RegisterScriptFunction('ToolGetForeColor', @ScriptGetForeColor, ARegister);
3262   FScriptContext.RegisterScriptFunction('ToolSetBackColor', @ScriptSetBackColor, ARegister);
3263   FScriptContext.RegisterScriptFunction('ToolGetBackColor', @ScriptGetBackColor, ARegister);
3264   FScriptContext.RegisterScriptFunction('ToolSetOutlineColor', @ScriptSetOutlineColor, ARegister);
3265   FScriptContext.RegisterScriptFunction('ToolGetOutlineColor', @ScriptGetOutlineColor, ARegister);
3266   FScriptContext.RegisterScriptFunction('ToolSetEraserMode', @ScriptSetEraserMode, ARegister);
3267   FScriptContext.RegisterScriptFunction('ToolGetEraserMode', @ScriptGetEraserMode, ARegister);
3268   FScriptContext.RegisterScriptFunction('ToolSetEraserAlpha', @ScriptSetEraserAlpha, ARegister);
3269   FScriptContext.RegisterScriptFunction('ToolGetEraserAlpha', @ScriptGetEraserAlpha, ARegister);
3270   FScriptContext.RegisterScriptFunction('ToolSetPenWidth', @ScriptSetPenWidth, ARegister);
3271   FScriptContext.RegisterScriptFunction('ToolGetPenWidth', @ScriptGetPenWidth, ARegister);
3272   FScriptContext.RegisterScriptFunction('ToolSetPenStyle', @ScriptSetPenStyle, ARegister);
3273   FScriptContext.RegisterScriptFunction('ToolGetPenStyle', @ScriptGetPenStyle, ARegister);
3274   FScriptContext.RegisterScriptFunction('ToolSetJoinStyle', @ScriptSetJoinStyle, ARegister);
3275   FScriptContext.RegisterScriptFunction('ToolGetJoinStyle', @ScriptGetJoinStyle, ARegister);
3276   FScriptContext.RegisterScriptFunction('ToolSetShapeOptions', @ScriptSetShapeOptions, ARegister);
3277   FScriptContext.RegisterScriptFunction('ToolGetShapeOptions', @ScriptGetShapeOptions, ARegister);
3278   FScriptContext.RegisterScriptFunction('ToolSetAliasing', @ScriptSetAliasing, ARegister);
3279   FScriptContext.RegisterScriptFunction('ToolGetAliasing', @ScriptGetAliasing, ARegister);
3280   FScriptContext.RegisterScriptFunction('ToolSetShapeRatio', @ScriptSetShapeRatio, ARegister);
3281   FScriptContext.RegisterScriptFunction('ToolGetShapeRatio', @ScriptGetShapeRatio, ARegister);
3282   FScriptContext.RegisterScriptFunction('ToolSetBrushIndex', @ScriptSetBrushIndex, ARegister);
3283   FScriptContext.RegisterScriptFunction('ToolGetBrushIndex', @ScriptGetBrushIndex, ARegister);
3284   FScriptContext.RegisterScriptFunction('ToolGetBrushCount', @ScriptGetBrushCount, ARegister);
3285   FScriptContext.RegisterScriptFunction('ToolSetBrushSpacing', @ScriptSetBrushSpacing, ARegister);
3286   FScriptContext.RegisterScriptFunction('ToolGetBrushSpacing', @ScriptGetBrushSpacing, ARegister);
3287   FScriptContext.RegisterScriptFunction('ToolSetFontName', @ScriptSetFontName, ARegister);
3288   FScriptContext.RegisterScriptFunction('ToolGetFontName', @ScriptGetFontName, ARegister);
3289   FScriptContext.RegisterScriptFunction('ToolSetFontSize', @ScriptSetFontSize, ARegister);
3290   FScriptContext.RegisterScriptFunction('ToolGetFontSize', @ScriptGetFontSize, ARegister);
3291   FScriptContext.RegisterScriptFunction('ToolSetFontStyle', @ScriptSetFontStyle, ARegister);
3292   FScriptContext.RegisterScriptFunction('ToolGetFontStyle', @ScriptGetFontStyle, ARegister);
3293   FScriptContext.RegisterScriptFunction('ToolSetTextAlign', @ScriptSetTextAlign, ARegister);
3294   FScriptContext.RegisterScriptFunction('ToolGetTextAlign', @ScriptGetTextAlign, ARegister);
3295   FScriptContext.RegisterScriptFunction('ToolSetTextOutline', @ScriptSetTextOutline, ARegister);
3296   FScriptContext.RegisterScriptFunction('ToolGetTextOutline', @ScriptGetTextOutline, ARegister);
3297   FScriptContext.RegisterScriptFunction('ToolSetTextPhong', @ScriptSetTextPhong, ARegister);
3298   FScriptContext.RegisterScriptFunction('ToolGetTextPhong', @ScriptGetTextPhong, ARegister);
3299   FScriptContext.RegisterScriptFunction('ToolSetLightPosition', @ScriptSetLightPosition, ARegister);
3300   FScriptContext.RegisterScriptFunction('ToolGetLightPosition', @ScriptGetLightPosition, ARegister);
3301 {  FScriptContext.RegisterScriptFunction('ToolSetLightAltitude', @ScriptSetLightAltitude, ARegister);
3302   FScriptContext.RegisterScriptFunction('ToolGetLightAltitude', @ScriptGetLightAltitude, ARegister);}
3303   FScriptContext.RegisterScriptFunction('ToolSetLineCap', @ScriptSetLineCap, ARegister);
3304   FScriptContext.RegisterScriptFunction('ToolGetLineCap', @ScriptGetLineCap, ARegister);
3305   FScriptContext.RegisterScriptFunction('ToolSetArrowStart', @ScriptSetArrowStart, ARegister);
3306   FScriptContext.RegisterScriptFunction('ToolGetArrowStart', @ScriptGetArrowStart, ARegister);
3307   FScriptContext.RegisterScriptFunction('ToolSetArrowEnd', @ScriptSetArrowEnd, ARegister);
3308   FScriptContext.RegisterScriptFunction('ToolGetArrowEnd', @ScriptGetArrowEnd, ARegister);
3309   FScriptContext.RegisterScriptFunction('ToolSetArrowSize', @ScriptSetArrowSize, ARegister);
3310   FScriptContext.RegisterScriptFunction('ToolGetArrowSize', @ScriptGetArrowSize, ARegister);
3311   FScriptContext.RegisterScriptFunction('ToolSetSplineStyle', @ScriptSetSplineStyle, ARegister);
3312   FScriptContext.RegisterScriptFunction('ToolGetSplineStyle', @ScriptGetSplineStyle, ARegister);
3313   FScriptContext.RegisterScriptFunction('ToolSetForeGradientType', @ScriptSetForeGradientType, ARegister);
3314   FScriptContext.RegisterScriptFunction('ToolGetForeGradientType', @ScriptGetForeGradientType, ARegister);
3315   FScriptContext.RegisterScriptFunction('ToolSetForeGradientRepetition', @ScriptSetForeGradientRepetition, ARegister);
3316   FScriptContext.RegisterScriptFunction('ToolGetForeGradientRepetition', @ScriptGetForeGradientRepetition, ARegister);
3317   FScriptContext.RegisterScriptFunction('ToolSetForeGradientInterpolation', @ScriptSetForeGradientInterpolation, ARegister);
3318   FScriptContext.RegisterScriptFunction('ToolGetForeGradientInterpolation', @ScriptGetForeGradientInterpolation, ARegister);
3319   FScriptContext.RegisterScriptFunction('ToolSetForeGradientColors', @ScriptSetForeGradientColors, ARegister);
3320   FScriptContext.RegisterScriptFunction('ToolGetForeGradientColors', @ScriptGetForeGradientColors, ARegister);
3321   FScriptContext.RegisterScriptFunction('ToolSetBackGradientType', @ScriptSetBackGradientType, ARegister);
3322   FScriptContext.RegisterScriptFunction('ToolGetBackGradientType', @ScriptGetBackGradientType, ARegister);
3323   FScriptContext.RegisterScriptFunction('ToolSetBackGradientRepetition', @ScriptSetBackGradientRepetition, ARegister);
3324   FScriptContext.RegisterScriptFunction('ToolGetBackGradientRepetition', @ScriptGetBackGradientRepetition, ARegister);
3325   FScriptContext.RegisterScriptFunction('ToolSetBackGradientInterpolation', @ScriptSetBackGradientInterpolation, ARegister);
3326   FScriptContext.RegisterScriptFunction('ToolGetBackGradientInterpolation', @ScriptGetBackGradientInterpolation, ARegister);
3327   FScriptContext.RegisterScriptFunction('ToolSetBackGradientColors', @ScriptSetBackGradientColors, ARegister);
3328   FScriptContext.RegisterScriptFunction('ToolGetBackGradientColors', @ScriptGetBackGradientColors, ARegister);
3329   FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientType', @ScriptSetOutlineGradientType, ARegister);
3330   FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientType', @ScriptGetOutlineGradientType, ARegister);
3331   FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientRepetition', @ScriptSetOutlineGradientRepetition, ARegister);
3332   FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientRepetition', @ScriptGetOutlineGradientRepetition, ARegister);
3333   FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientInterpolation', @ScriptSetOutlineGradientInterpolation, ARegister);
3334   FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientInterpolation', @ScriptGetOutlineGradientInterpolation, ARegister);
3335   FScriptContext.RegisterScriptFunction('ToolSetOutlineGradientColors', @ScriptSetOutlineGradientColors, ARegister);
3336   FScriptContext.RegisterScriptFunction('ToolGetOutlineGradientColors', @ScriptGetOutlineGradientColors, ARegister);
3337   FScriptContext.RegisterScriptFunction('ToolSetForeTexture', @ScriptSetForeTexture, ARegister);
3338   FScriptContext.RegisterScriptFunction('ToolSetForeTextureRepetition', @ScriptSetForeTextureRepetition, ARegister);
3339   FScriptContext.RegisterScriptFunction('ToolGetForeTextureRepetition', @ScriptGetForeTextureRepetition, ARegister);
3340   FScriptContext.RegisterScriptFunction('ToolSetForeTextureOpacity', @ScriptSetForeTextureOpacity, ARegister);
3341   FScriptContext.RegisterScriptFunction('ToolGetForeTextureOpacity', @ScriptGetForeTextureOpacity, ARegister);
3342   FScriptContext.RegisterScriptFunction('ToolSetBackTexture', @ScriptSetBackTexture, ARegister);
3343   FScriptContext.RegisterScriptFunction('ToolSetBackTextureRepetition', @ScriptSetBackTextureRepetition, ARegister);
3344   FScriptContext.RegisterScriptFunction('ToolGetBackTextureRepetition', @ScriptGetBackTextureRepetition, ARegister);
3345   FScriptContext.RegisterScriptFunction('ToolSetBackTextureOpacity', @ScriptSetBackTextureOpacity, ARegister);
3346   FScriptContext.RegisterScriptFunction('ToolGetBackTextureOpacity', @ScriptGetBackTextureOpacity, ARegister);
3347   FScriptContext.RegisterScriptFunction('ToolSetOutlineTexture', @ScriptSetOutlineTexture, ARegister);
3348   FScriptContext.RegisterScriptFunction('ToolSetOutlineTextureRepetition', @ScriptSetOutlineTextureRepetition, ARegister);
3349   FScriptContext.RegisterScriptFunction('ToolGetOutlineTextureRepetition', @ScriptGetOutlineTextureRepetition, ARegister);
3350   FScriptContext.RegisterScriptFunction('ToolSetOutlineTextureOpacity', @ScriptSetOutlineTextureOpacity, ARegister);
3351   FScriptContext.RegisterScriptFunction('ToolGetOutlineTextureOpacity', @ScriptGetOutlineTextureOpacity, ARegister);
3352   FScriptContext.RegisterScriptFunction('ToolSetPhongShapeAltitude', @ScriptSetPhongShapeAltitude, ARegister);
3353   FScriptContext.RegisterScriptFunction('ToolGetPhongShapeAltitude', @ScriptGetPhongShapeAltitude, ARegister);
3354   FScriptContext.RegisterScriptFunction('ToolSetPhongShapeBorderSize', @ScriptSetPhongShapeBorderSize, ARegister);
3355   FScriptContext.RegisterScriptFunction('ToolGetPhongShapeBorderSize', @ScriptGetPhongShapeBorderSize, ARegister);
3356   FScriptContext.RegisterScriptFunction('ToolSetPhongShapeKind', @ScriptSetPhongShapeKind, ARegister);
3357   FScriptContext.RegisterScriptFunction('ToolGetPhongShapeKind', @ScriptGetPhongShapeKind, ARegister);
3358   FScriptContext.RegisterScriptFunction('ToolSetDeformationGridSize', @ScriptSetDeformationGridSize, ARegister);
3359   FScriptContext.RegisterScriptFunction('ToolGetDeformationGridSize', @ScriptGetDeformationGridSize, ARegister);
3360   FScriptContext.RegisterScriptFunction('ToolSetDeformationGridMode', @ScriptSetDeformationGridMode, ARegister);
3361   FScriptContext.RegisterScriptFunction('ToolGetDeformationGridMode', @ScriptGetDeformationGridMode, ARegister);
3362   FScriptContext.RegisterScriptFunction('ToolSetTolerance', @ScriptSetTolerance, ARegister);
3363   FScriptContext.RegisterScriptFunction('ToolGetTolerance', @ScriptGetTolerance, ARegister);
3364   FScriptContext.RegisterScriptFunction('ToolSetFloodFillOptions', @ScriptSetFloodFillOptions, ARegister);
3365   FScriptContext.RegisterScriptFunction('ToolGetFloodFillOptions', @ScriptGetFloodFillOptions, ARegister);
3366   FScriptContext.RegisterScriptFunction('ToolSetPerspectiveOptions', @ScriptSetPerspectiveOptions, ARegister);
3367   FScriptContext.RegisterScriptFunction('ToolGetPerspectiveOptions', @ScriptGetPerspectiveOptions, ARegister);
3368 end;
3369 
3370 procedure TToolManager.ToolWakeUp;
3371 begin
3372   if FSleepingTool <> nil then
3373   begin
3374     FreeAndNil(FCurrentTool);
3375     FCurrentTool := FSleepingTool;
3376     FSleepingTool := nil;
3377     FCurrentToolType := FSleepingToolType;
3378     UpdateContextualToolbars;
3379     If Assigned(FOnToolChangedHandler) then
3380       FOnToolChangedHandler(self, FCurrentToolType);
3381     If Assigned(FOnToolRenderChanged) then
3382       FOnToolRenderChanged(self);
3383   end;
3384 end;
3385 
3386 procedure TToolManager.ToolSleep;
3387 begin
3388   if (FSleepingTool = nil) and (FCurrentToolType <> ptHand) then
3389   begin
3390     FSleepingTool := FCurrentTool;
3391     FSleepingToolType := FCurrentToolType;
3392     FCurrentTool := nil;
3393     InternalSetCurrentToolType(ptHand);
3394   end;
3395 end;
3396 
3397 { tool implementation }
3398 
3399 procedure TToolManager.SetDeformationGridSize(ASize: TSize);
3400 begin
3401   if ASize.cx < 3 then ASize.cx := 3;
3402   if ASize.cy < 3 then ASize.cy := 3;
3403   if (ASize.cx <> DeformationGridNbX) or (ASize.cy <> DeformationGridNbY) then
3404   begin
3405     FDeformationGridNbX := ASize.cx;
3406     FDeformationGridNbY := ASize.cy;
3407     if ToolUpdate then
3408       Image.OnImageChanged.NotifyObservers;
3409     if Assigned(FOnDeformationGridChanged) then FOnDeformationGridChanged(self);
3410   end;
3411 end;
3412 
SwapToolColorsnull3413 function TToolManager.SwapToolColors: boolean;
3414 var
3415   tmpFill: TVectorialFill;
3416 begin
3417   result := false;
3418   if FInSwapFill then exit;
3419   if FForeFill.Equals(FBackFill) then exit;
3420   FInSwapFill:= true;
3421   tmpFill := FForeFill.Duplicate;
3422   FForeFill.Assign(FBackFill);
3423   FBackFill.Assign(tmpFill);
3424   tmpFill.Free;
3425   if FForeFill.FillType = vftGradient then
3426   begin
3427     FForeLastGradient.Free;
3428     FForeLastGradient := FForeFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
3429   end;
3430   if FBackFill.FillType = vftGradient then
3431   begin
3432     FBackLastGradient.Free;
3433     FBackLastGradient := FBackFill.Gradient.Duplicate as TBGRALayerGradientOriginal;
3434   end;
3435   if Assigned(FOnFillChanged) then FOnFillChanged(self);
3436   FInSwapFill:= false;
3437   result := true;
3438 end;
3439 
3440 procedure TToolManager.NeedBackGradient;
3441 var
3442   tempFill: TVectorialFill;
3443 begin
3444   if BackFill.FillType <> vftGradient then
3445   begin
3446     tempFill := TVectorialFill.Create;
3447     tempFill.SetGradient(FBackLastGradient, False);
3448     tempFill.FitGeometry(SuggestGradientBox);
3449     BackFill.Assign(tempFill);
3450     tempFill.Free;
3451   end;
3452 end;
3453 
3454 procedure TToolManager.NeedForeGradient;
3455 var
3456   tempFill: TVectorialFill;
3457 begin
3458   if ForeFill.FillType <> vftGradient then
3459   begin
3460     tempFill := TVectorialFill.Create;
3461     tempFill.SetGradient(FForeLastGradient, False);
3462     tempFill.FitGeometry(SuggestGradientBox);
3463     ForeFill.Assign(tempFill);
3464     tempFill.Free;
3465   end;
3466 end;
3467 
3468 procedure TToolManager.NeedOutlineGradient;
3469 var
3470   tempFill: TVectorialFill;
3471 begin
3472   if OutlineFill.FillType <> vftGradient then
3473   begin
3474     tempFill := TVectorialFill.Create;
3475     tempFill.SetGradient(FOutlineLastGradient, False);
3476     tempFill.FitGeometry(SuggestGradientBox);
3477     OutlineFill.Assign(tempFill);
3478     tempFill.Free;
3479   end;
3480 end;
3481 
3482 procedure TToolManager.AddBrush(brush: TLazPaintBrush);
3483 begin
3484   FBrushIndex := FBrushInfoList.Add(brush);
3485   FBrushInfoListChanged := true;
3486   if Assigned(FOnBrushListChanged) then FOnBrushListChanged(self);
3487 end;
3488 
3489 procedure TToolManager.RemoveBrushAt(index: integer);
3490 begin
3491   if Assigned(FBrushInfoList) then
3492   begin
3493     if (index >= 1) and (index < BrushCount) then
3494     begin
3495       BrushAt[index].Free;
3496       FBrushInfoList.Delete(index);
3497       if index < FBrushIndex then dec(FBrushIndex)
3498       else if index = FBrushIndex then
3499         begin
3500           if FBrushIndex >= BrushCount then
3501             dec(FBrushIndex);
3502         end;
3503       FBrushInfoListChanged := true;
3504       if Assigned(FOnBrushListChanged) then FOnBrushListChanged(self);
3505     end;
3506   end;
3507 end;
3508 
3509 procedure TToolManager.SetTextFont(AName: string; ASize: single;
3510   AStyle: TFontStyles);
3511 begin
3512   if AName = '' then AName := FTextFontName;
3513   if (FTextFontName <> AName) or
3514     (FTextFontSize <> ASize) or
3515     (FTextFontStyle <> AStyle) then
3516   begin
3517     FTextFontName := AName;
3518     if ASize >= 0 then FTextFontSize := ASize;
3519     FTextFontStyle := AStyle;
3520     ToolUpdate;
3521     if Assigned(FOnTextFontChanged) then FOnTextFontChanged(self);
3522   end;
3523 end;
3524 
3525 procedure TToolManager.SetTextFont(AFont: TFont);
3526 begin
3527   SetTextFont(AFont.Name, AFont.Size, AFont.Style);
3528 end;
3529 
3530 procedure TToolManager.SetTextOutline(AEnabled: boolean; AWidth: single);
3531 begin
3532   if (FTextOutline <> AEnabled) or
3533     (FTextOutlineWidth <> AWidth) then
3534   begin
3535     FTextOutlineWidth := AWidth;
3536     FTextOutline := AEnabled;
3537     ToolUpdate;
3538     if Assigned(FOnTextOutlineChanged) then FOnTextOutlineChanged(self);
3539   end;
3540 end;
3541 
TToolManager.ToolDownnull3542 function TToolManager.ToolDown(X, Y: single; ARightBtn: boolean;
3543   APressure: single): boolean;
3544 var changed: TRect;
3545 begin
3546   if FInTool then exit(false);
3547   FInTool := true;
3548   try
3549     SetPressure(APressure);
3550     if ToolCanBeUsed and Assigned(CurrentTool) then
3551       changed := CurrentTool.ToolDown(X,Y,ARightBtn)
3552     else
3553       changed := EmptyRect;
3554     result := not IsRectEmpty(changed);
3555     if IsOnlyRenderChange(changed) then changed := EmptyRect;
3556 
3557     if CheckExitTool then result := true;
3558     if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
3559   finally
3560     FInTool := false;
3561   end;
3562 end;
3563 
TToolManager.ToolMovenull3564 function TToolManager.ToolMove(X, Y: single; APressure: single): boolean;
3565 var changed: TRect;
3566 begin
3567   if FInTool then exit(false);
3568   FInTool := true;
3569   try
3570     SetPressure(APressure);
3571     if ToolCanBeUsed and Assigned(CurrentTool) then
3572       changed := CurrentTool.ToolMove(X,Y)
3573     else
3574       changed := EmptyRect;
3575     result := not IsRectEmpty(changed);
3576     if IsOnlyRenderChange(changed) then changed := EmptyRect;
3577 
3578     if CheckExitTool then result := true;
3579     if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
3580   finally
3581     FInTool := false;
3582   end;
3583 end;
3584 
TToolManager.ToolKeyDownnull3585 function TToolManager.ToolKeyDown(var key: Word): boolean;
3586 var changed: TRect;
3587 begin
3588   if FInTool then exit(false);
3589   FInTool := true;
3590   try
3591     if ToolCanBeUsed and Assigned(CurrentTool) then
3592       changed := CurrentTool.ToolKeyDown(key)
3593     else
3594       changed := EmptyRect;
3595     result := not IsRectEmpty(changed);
3596     if IsOnlyRenderChange(changed) then changed := EmptyRect;
3597 
3598     if CheckExitTool then result := true;
3599     if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
3600   finally
3601     FInTool := false;
3602   end;
3603 end;
3604 
TToolManager.ToolKeyUpnull3605 function TToolManager.ToolKeyUp(var key: Word): boolean;
3606 var changed: TRect;
3607 begin
3608   if FInTool then exit(false);
3609   FInTool := true;
3610   try
3611     if ToolCanBeUsed and Assigned(CurrentTool) then
3612       changed := CurrentTool.ToolKeyUp(key)
3613     else
3614       changed := EmptyRect;
3615     result := not IsRectEmpty(changed);
3616     if IsOnlyRenderChange(changed) then changed := EmptyRect;
3617 
3618     if CheckExitTool then result := true;
3619     if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
3620   finally
3621     FInTool := false;
3622   end;
3623 end;
3624 
TToolManager.ToolKeyPressnull3625 function TToolManager.ToolKeyPress(var key: TUTF8Char): boolean;
3626 var changed: TRect;
3627 begin
3628   if FInTool then exit(false);
3629   FInTool := true;
3630   try
3631     if ToolCanBeUsed and Assigned(CurrentTool) then
3632       changed := CurrentTool.ToolKeyPress(key)
3633     else
3634       changed := EmptyRect;
3635     result := not IsRectEmpty(changed);
3636     if IsOnlyRenderChange(changed) then changed := EmptyRect;
3637 
3638     if CheckExitTool then result := true;
3639     if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
3640   finally
3641     FInTool := false;
3642   end;
3643 end;
3644 
TToolManager.ToolCommandnull3645 function TToolManager.ToolCommand(ACommand: TToolCommand): boolean;
3646 begin
3647   if FInTool then exit(false);
3648   FInTool := true;
3649   try
3650     if Assigned(FCurrentTool) then
3651     begin
3652       result := FCurrentTool.ToolCommand(ACommand);
3653       CheckExitTool;
3654     end
3655     else
3656       result := false;
3657   finally
3658     FInTool := false;
3659   end;
3660 end;
3661 
TToolManager.ToolProvideCommandnull3662 function TToolManager.ToolProvideCommand(ACommand: TToolCommand): boolean;
3663 begin
3664   if Assigned(FCurrentTool) then
3665     result := FCurrentTool.ToolProvideCommand(ACommand)
3666   else
3667     result := false;
3668 end;
3669 
ToolUpnull3670 function TToolManager.ToolUp: boolean;
3671 var changed: TRect;
3672 begin
3673   if FInTool then exit(false);
3674   FInTool := true;
3675   try
3676     if ToolCanBeUsed and Assigned(CurrentTool) then
3677       changed := CurrentTool.ToolUp
3678     else
3679       changed := EmptyRect;
3680     result := not IsRectEmpty(changed);
3681     if IsOnlyRenderChange(changed) then changed := EmptyRect;
3682 
3683     if CheckExitTool then result := true;
3684     if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
3685   finally
3686     FInTool := false;
3687   end;
3688 end;
3689 
3690 procedure TToolManager.ToolCloseDontReopen;
3691 begin
3692   if CurrentTool <> nil then
3693   begin
3694     if FInTool then raise exception.Create('Cannot close active tool');
3695     FreeAndNil(FCurrentTool);
3696   end;
3697 end;
3698 
3699 procedure TToolManager.ToolCloseAndReopenImmediatly;
3700 begin
3701   if CurrentTool <> nil then
3702   begin
3703     if FInTool then raise exception.Create('Cannot close active tool');
3704     FInTool := true;
3705     try
3706       FreeAndNil(FCurrentTool);
3707     finally
3708       FInTool := false;
3709     end;
3710     ToolOpen;
3711   end;
3712 end;
3713 
3714 procedure TToolManager.ToolOpen;
3715 begin
3716   if (FCurrentTool = nil) and (PaintTools[FCurrentToolType] <> nil) then
3717   begin
3718     if FInTool then raise exception.Create('Internal error');
3719     FInTool := true;
3720     try
3721       FCurrentTool := PaintTools[FCurrentToolType].Create(self);
3722       UpdateContextualToolbars;
3723       If Assigned(FOnToolRenderChanged) then
3724         FOnToolRenderChanged(self);
3725     finally
3726       FInTool := false;
3727     end;
3728   end;
3729 end;
3730 
TToolManager.ToolUpdatenull3731 function TToolManager.ToolUpdate: boolean;
3732 var changed: TRect;
3733 begin
3734   if FInTool then exit(false);
3735   FInTool := true;
3736   FInToolUpdate := true;
3737   try
3738     if ToolCanBeUsed and Assigned(CurrentTool) then
3739       changed := CurrentTool.ToolUpdate
3740     else
3741       changed := EmptyRect;
3742     result := not IsRectEmpty(changed);
3743     if IsOnlyRenderChange(changed) then changed := EmptyRect;
3744 
3745     if CheckExitTool then result := true;
3746     if result then NotifyImageOrSelectionChanged(CurrentTool.LastToolDrawingLayer, changed);
3747   finally
3748     FInTool := false;
3749     FInToolUpdate := false;
3750   end;
3751 end;
3752 
ToolUpdateNeedednull3753 function TToolManager.ToolUpdateNeeded: boolean;
3754 begin
3755   if ToolCanBeUsed and Assigned(CurrentTool) then
3756     result := CurrentTool.ToolUpdateNeeded
3757   else
3758     result := false;
3759   if CheckExitTool then
3760     result := true;
3761 end;
3762 
3763 procedure TToolManager.ToolPopup(AMessage: TToolPopupMessage; AKey: Word = 0; AAlways: boolean = false);
3764 begin
3765   if Assigned(FOnPopupToolHandler) then
3766     FOnPopupToolHandler(self, AMessage, AKey, AAlways);
3767 end;
3768 
IsSelectingToolnull3769 function TToolManager.IsSelectingTool: boolean;
3770 begin
3771   if CurrentTool <> nil then
3772     result := CurrentTool.IsSelectingTool
3773   else
3774     result := false;
3775 end;
3776 
DisplayFilledSelectionnull3777 function TToolManager.DisplayFilledSelection: boolean;
3778 begin
3779   result := IsSelectingTool or (FCurrentToolType = ptEditShape);
3780 end;
3781 
IsForeEditGradTexPointsnull3782 function TToolManager.IsForeEditGradTexPoints: boolean;
3783 begin
3784   if Assigned(CurrentTool) then result := CurrentTool.IsForeEditGradTexPoints
3785   else result := false;
3786 end;
3787 
TToolManager.IsBackEditGradTexPointsnull3788 function TToolManager.IsBackEditGradTexPoints: boolean;
3789 begin
3790   if Assigned(CurrentTool) then result := CurrentTool.IsBackEditGradTexPoints
3791   else result := false;
3792 end;
3793 
IsOutlineEditGradTexPointsnull3794 function TToolManager.IsOutlineEditGradTexPoints: boolean;
3795 begin
3796   if Assigned(CurrentTool) then result := CurrentTool.IsOutlineEditGradTexPoints
3797   else result := false;
3798 end;
3799 
3800 procedure TToolManager.QueryExitTool;
3801 begin
3802   FShouldExitTool:= true;
3803 end;
3804 
3805 procedure TToolManager.QueryColorTarget(ATarget: TVectorialFill);
3806 begin
3807   if Assigned(OnQueryColorTarget) then
3808     OnQueryColorTarget(self, ATarget);
3809 end;
3810 
RenderToolnull3811 function TToolManager.RenderTool(formBitmap: TBGRABitmap): TRect;
3812 begin
3813   if ToolCanBeUsed and Assigned(CurrentTool) and not FInTool then
3814   begin
3815     FInTool := true;
3816     try
3817       result := CurrentTool.Render(formBitmap,formBitmap.Width,formBitmap.Height, @InternalBitmapToVirtualScreen);
3818     finally
3819       FInTool := false;
3820     end;
3821   end else
3822     result := EmptyRect;
3823 end;
3824 
GetRenderBoundsnull3825 function TToolManager.GetRenderBounds(VirtualScreenWidth, VirtualScreenHeight: integer): TRect;
3826 begin
3827   if ToolCanBeUsed and Assigned(CurrentTool) and not CurrentTool.Validating and not CurrentTool.Canceling then
3828     result := CurrentTool.Render(nil,VirtualScreenWidth,VirtualScreenHeight, @InternalBitmapToVirtualScreen)
3829   else
3830     result := EmptyRect;
3831 end;
3832 
SuggestGradientBoxnull3833 function TToolManager.SuggestGradientBox: TAffineBox;
3834 begin
3835   if Assigned(CurrentTool) then
3836     result := CurrentTool.SuggestGradientBox
3837   else
3838     result := TAffineBox.AffineBox(RectF(PointF(0,0),PointF(Image.Width,Image.Height)));
3839 end;
3840 
GetDeformationGridSizenull3841 function TToolManager.GetDeformationGridSize: TSize;
3842 begin
3843   result := Size(DeformationGridNbX, DeformationGridNbY);
3844 end;
3845 
TToolManager.ToolDownnull3846 function TToolManager.ToolDown(ACoord: TPointF; ARightBtn: boolean;
3847   APressure: single): boolean;
3848 begin
3849   result := ToolDown(ACoord.x,ACoord.y,ARightBtn,APressure)
3850 end;
3851 
TToolManager.ToolMovenull3852 function TToolManager.ToolMove(ACoord: TPointF; APressure: single): boolean;
3853 begin
3854   result := ToolMove(ACoord.x,ACoord.y,APressure)
3855 end;
3856 
3857 initialization
3858   fillchar({%H-}PaintTools,sizeof(PaintTools),0);
3859 
3860 end.
3861 
3862