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