1 // SPDX-License-Identifier: GPL-3.0-only
2 unit LazPaintType;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, Inifiles, BGRABitmap, BGRABitmapTypes, UConfig, UImage, UTool, Forms, BGRALayers, Graphics, Menus,
10 UScripting, Dialogs, Controls
11 {$IFDEF LINUX}, InterfaceBase{$ENDIF};
12
13 const
14 LazPaintVersion = 7010600;
15
LazPaintVersionStrnull16 function LazPaintVersionStr: string;
17
18 {
19
20 Improvements accepted:
21 ----------------------
22 Mac:
23 - combobox dropdown rect without scrollbar
24 Scripting
25 Color picker
26 - From final image
27 - With radius
28 Translation of curve modes (in dropdown)
29 Lasso
30 Utiliser les touches de direction
31 Mettre a jour le curseur quand on change d'outil (notamment avec Espace)
32
33 Possible improvements:
34 ----------------------
35 Integrate tools in window (partly done)
36 Hue/color blend mode
37 Acquisition (Twain)
38
39 Format:
40 - TIM image format
41 - load/save image DPI
42 - load/save RAW
43
44 Filters:
45 - filtre de vagues en translation
46 - filtre pontillisme
47 - G'MIC filters
48 - surface blur
49 - smart zoom using vectorization
50
51 Tools:
52 - 3D text
53 - erase tool in empty selection
54 - aliased selection
55 - antialiased magic wand
56
57 Known bugs:
58 - Puppy linx: title bar disappears sometimes
59 }
60
61 const
62 OriginalDPI = 96;
63 ToolWindowFixedSize = {$IFDEF LINUX}bsDialog{$ELSE}bsToolWindow{$ENDIF};
64 ToolWindowSizeable = {$IFDEF LINUX}bsSizeable{$ELSE}bsSizeToolWin{$ENDIF};
65 ToolWindowStyle = {$IF defined(LINUX) and defined(LCLqt5)}fsNormal{$ELSE}fsStayOnTop{$ENDIF};
66
LazPaintCurrentVersionnull67 function LazPaintCurrentVersion : String;
68
69 type
70 TPictureFilter = (pfNone,
71 pfBlurPrecise, pfBlurRadial, pfBlurFast, pfBlurBox, pfBlurCorona, pfBlurDisk, pfBlurMotion, pfBlurCustom,
72 pfSharpen, pfSmooth, pfMedian, pfNoise, pfPixelate, pfClearType, pfClearTypeInverse, pfFunction,
pfEmbossnull73 pfEmboss, pfPhong, pfContour, pfGrayscale, pfNegative, pfLinearNegative, pfComplementaryColor, pfNormalize,
74 pfSphere, pfTwirl, pfWaveDisplacement, pfCylinder, pfPlane,
75 pfPerlinNoise,pfCyclicPerlinNoise,pfClouds,pfCustomWater,pfWater,pfRain,pfWood,pfWoodVertical,pfPlastik,pfMetalFloor,pfCamouflage,
76 pfSnowPrint,pfStone,pfRoundStone,pfMarble);
77
78 const
79 PictureFilterStr : array[TPictureFilter] of string =
80 ('None',
81 'BlurPrecise', 'BlurRadial', 'BlurFast', 'BlurBox', 'BlurCorona', 'BlurDisk', 'BlurMotion', 'BlurCustom',
82 'Sharpen', 'Smooth', 'Median', 'Noise', 'Pixelate', 'ClearType', 'ClearTypeInverse', 'Function',
83 'Emboss', 'Phong', 'Contour', 'Grayscale', 'Negative', 'LinearNegative', 'ComplementaryColor', 'Normalize',
84 'Sphere', 'Twirl', 'WaveDisplacement', 'Cylinder', 'Plane',
85 'PerlinNoise','CyclicPerlinNoise','Clouds','CustomWater','Water','Rain','Wood','WoodVertical','Plastik','MetalFloor','Camouflage',
86 'SnowPrint','Stone','RoundStone','Marble');
87
88 IsColoredFilter: array[TPictureFilter] of boolean =
89 (false,
90 false, false, false, false, false, false, false, false,
91 false, false, false, false, false, true, true, true,
92 false, true, false, false, false, false, false, false,
93 false, false, false, false, false,
94 false,false,true,true,true,true,true,true,true,true,true,
95 true,true,true,true);
96
97 const
98 MinZoomForGrid = 4;
99
100 type
101 TVSCursorPosition = record
102 bounds: TRect;
103 c: TPointF;
104 rx,ry: single;
105 end;
106 ArrayOfLayerId = array of integer;
107
108 const
109 OnlyRenderChange : TRect = (left:-32768;top:-32768;right:0;bottom:0);
110
IsOnlyRenderChangenull111 function IsOnlyRenderChange(const ARect:TRect): boolean;
112
113 type
114 ArrayOfBGRABitmap = array of TBGRABitmap;
115 TColorTarget = (ctForeColorSolid, ctForeColorStartGrad, ctForeColorEndGrad,
116 ctBackColorSolid, ctBackColorStartGrad, ctBackColorEndGrad,
117 ctOutlineColorSolid, ctOutlineColorStartGrad, ctOutlineColorEndGrad);
118 TFlipOption = (foAuto, foWholePicture, foSelection, foCurrentLayer);
119
120 PImageEntry = ^TImageEntry;
121
122 { TImageEntry }
123
124 TImageEntry = object
125 bmp: TBGRABitmap;
126 bpp: integer;
127 frameIndex, frameCount: integer;
128 isDuplicate: boolean;
Emptynull129 class function Empty: TImageEntry; static;
NewFrameIndexnull130 class function NewFrameIndex: integer; static;
131 procedure FreeAndNil;
132 end;
133 ArrayOfImageEntry = array of TImageEntry;
134
135 type
136 TLatestVersionUpdateHandler = procedure(ANewVersion: string) of object;
137 TLazPaintCustomOnlineUpdater = class
138 OnLatestVersionUpdate: TLatestVersionUpdateHandler;
139 end;
140
141 type
142 TLazPaintCustomInstance = class;
143 TLazPaintInstanceEvent = procedure(AInstance : TLazPaintCustomInstance) of object;
144 TTopMostInfo = record
145 defined: boolean;
146 toolboxHidden, choosecolorHidden, layerstackHidden, imagelistHidden: NativeInt;
147 end;
148 TCheckFunction = function: boolean of object;
149
150 { TLazPaintCustomInstance }
151
152 TLazPaintCustomInstance = class(TInterfacedObject,IConfigProvider)
153 private
154 FBlackAndWhite: boolean;
GetDarkThemenull155 function GetDarkTheme: boolean;
156 procedure SetDarkTheme(AValue: boolean);
157 protected
158 FRestartQuery: boolean;
QueryInterfacenull159 function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
_AddRefnull160 function _AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
_Releasenull161 function _Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
162
GetIconsnull163 function GetIcons(ASize: integer): TImageList; virtual; abstract;
GetToolBoxWindowPopupnull164 function GetToolBoxWindowPopup: TPopupMenu; virtual; abstract;
165 procedure SetToolBoxWindowPopup(AValue: TPopupMenu); virtual; abstract;
GetFullscreennull166 function GetFullscreen: boolean; virtual; abstract;
167 procedure SetFullscreen(AValue: boolean); virtual; abstract;
GetDockLayersAndColorsnull168 function GetDockLayersAndColors: boolean; virtual; abstract;
169 procedure SetDockLayersAndColors(AValue: boolean); virtual; abstract;
GetScriptContextnull170 function GetScriptContext: TScriptContext; virtual; abstract;
GetShowSelectionNormalnull171 function GetShowSelectionNormal: boolean; virtual; abstract;
172 procedure SetShowSelectionNormal(AValue: boolean); virtual; abstract;
GetGridVisiblenull173 function GetGridVisible: boolean; virtual; abstract;
174 procedure SetGridVisible(const AValue: boolean); virtual; abstract;
GetEmbeddednull175 function GetEmbedded: boolean; virtual; abstract;
GetTopMostHasFocusnull176 function GetTopMostHasFocus: boolean; virtual; abstract;
GetTopMostVisiblenull177 function GetTopMostVisible: boolean; virtual; abstract;
GetTopMostOkToUnfocusnull178 function GetTopMostOkToUnfocus: boolean; virtual; abstract;
179
GetConfignull180 function GetConfig: TLazPaintConfig; virtual; abstract;
GetImagenull181 function GetImage: TLazPaintImage; virtual; abstract;
GetImageActionnull182 function GetImageAction: TObject; virtual; abstract;
GetToolManagernull183 function GetToolManager: TToolManager; virtual; abstract;
184 procedure SetBlackAndWhite(AValue: boolean); virtual;
GetZoomFactornull185 function GetZoomFactor: single; virtual;
186
GetUpdateStackOnTimernull187 function GetUpdateStackOnTimer: boolean; virtual; abstract;
188 procedure SetUpdateStackOnTimer(AValue: boolean); virtual; abstract;
189
GetChooseColorHeightnull190 function GetChooseColorHeight: integer; virtual; abstract;
GetChooseColorWidthnull191 function GetChooseColorWidth: integer; virtual; abstract;
192 procedure SetChooseColorHeight(AValue: integer); virtual; abstract;
193 procedure SetChooseColorWidth(AValue: integer); virtual; abstract;
GetChooseColorVisiblenull194 function GetChooseColorVisible: boolean; virtual; abstract;
195 procedure SetChooseColorVisible(const AValue: boolean); virtual; abstract;
GetChooseColorTargetnull196 function GetChooseColorTarget: TColorTarget; virtual; abstract;
197 procedure SetChooseColorTarget(const AValue: TColorTarget); virtual; abstract;
198
GetToolboxVisiblenull199 function GetToolboxVisible: boolean; virtual; abstract;
200 procedure SetToolboxVisible(const AValue: boolean); virtual; abstract;
GetToolboxHeightnull201 function GetToolboxHeight: integer; virtual; abstract;
GetToolboxWidthnull202 function GetToolboxWidth: integer; virtual; abstract;
203
GetImageListWindowVisiblenull204 function GetImageListWindowVisible: boolean; virtual; abstract;
205 procedure SetImageListWindowVisible(const AValue: boolean); virtual; abstract;
GetImageListWindowHeightnull206 function GetImageListWindowHeight: integer; virtual; abstract;
GetImageListWindowWidthnull207 function GetImageListWindowWidth: integer; virtual; abstract;
208 procedure SetImageListWindowHeight(AValue: integer); virtual; abstract;
209 procedure SetImageListWindowWidth(AValue: integer); virtual; abstract;
210
GetLayerWindowVisiblenull211 function GetLayerWindowVisible: boolean; virtual; abstract;
212 procedure SetLayerWindowVisible(AValue: boolean); virtual; abstract;
GetLayerWindowHeightnull213 function GetLayerWindowHeight: integer; virtual; abstract;
GetLayerWindowWidthnull214 function GetLayerWindowWidth: integer; virtual; abstract;
215 procedure SetLayerWindowHeight(AValue: integer); virtual; abstract;
216 procedure SetLayerWindowWidth(AValue: integer); virtual; abstract;
217
GetMainFormBoundsnull218 function GetMainFormBounds: TRect; virtual; abstract;
219 public
220 Title,AboutText: string;
221 EmbeddedResult: TModalResult;
222 EmbeddedImageBackup: TBGRABitmap;
223
224 constructor Create; virtual; abstract;
225 constructor Create(AEmbedded: boolean); virtual; abstract;
226 procedure RegisterThemeListener(AHandler: TNotifyEvent; ARegister: boolean); virtual; abstract;
227 procedure NotifyThemeChanged; virtual; abstract;
228 procedure StartLoadingImage(AFilename: string); virtual; abstract;
229 procedure EndLoadingImage; virtual; abstract;
230 procedure StartSavingImage(AFilename: string); virtual; abstract;
231 procedure EndSavingImage; virtual; abstract;
232 procedure ReportActionProgress(AProgressPercent: integer); virtual; abstract;
233 procedure SaveMainWindowPosition; virtual; abstract;
234 procedure RestoreMainWindowPosition; virtual; abstract;
235 procedure Donate; virtual; abstract;
236 procedure UseConfig(ini: TInifile); virtual; abstract;
237 procedure AssignBitmap(bmp: TBGRABitmap); virtual; abstract;
238 procedure EditBitmap(var bmp: TBGRABitmap; ConfigStream: TStream = nil; ATitle: String = ''; AOnRun: TLazPaintInstanceEvent = nil; AOnExit: TLazPaintInstanceEvent = nil; ABlackAndWhite : boolean = false); virtual; abstract;
EditTexturenull239 function EditTexture(ASource: TBGRABitmap): TBGRABitmap; virtual; abstract;
240 procedure EditSelection; virtual; abstract;
ProcessCommandLinenull241 function ProcessCommandLine: boolean; virtual; abstract;
ProcessCommandsnull242 function ProcessCommands(commands: TStringList): boolean; virtual; abstract;
243 procedure ChangeIconSize(size: integer); virtual; abstract;
244 procedure Show; virtual; abstract;
Hidenull245 function Hide: boolean; virtual; abstract;
246 procedure Run; virtual; abstract;
247 procedure Restart; virtual; abstract;
248 procedure CancelRestart; virtual; abstract;
249 procedure NotifyImageChange(RepaintNow: boolean; ARect: TRect); virtual; abstract;
250 procedure NotifyImageChangeCompletely(RepaintNow: boolean); virtual; abstract;
251 procedure NotifyImagePaint; virtual; abstract;
252 procedure NotifyStackChange; virtual; abstract;
TryOpenFileUTF8null253 function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; virtual; abstract;
ExecuteFilternull254 function ExecuteFilter(filter: TPictureFilter; skipDialog: boolean = false): TScriptResult; virtual; abstract;
RunScriptnull255 function RunScript(AFilename: string; ACaption: string = ''): boolean; virtual; abstract;
256 procedure AdjustChooseColorHeight; virtual; abstract;
257 procedure ColorFromFChooseColor; virtual; abstract;
258 procedure ColorToFChooseColor; virtual; abstract;
259 procedure ExitColorEditor; virtual; abstract;
ColorEditorActivenull260 function ColorEditorActive: boolean; virtual; abstract;
GetColornull261 function GetColor(ATarget: TColorTarget): TBGRAPixel;
262 procedure SetColor(ATarget: TColorTarget; AColor: TBGRAPixel);
ShowSaveOptionDlgnull263 function ShowSaveOptionDlg(AParameters: TVariableSet; AOutputFilenameUTF8: string;
264 ASkipOptions: boolean; AExport: boolean): boolean; virtual; abstract;
ShowColorIntensityDlgnull265 function ShowColorIntensityDlg(AParameters: TVariableSet): TScriptResult; virtual; abstract;
ShowColorLightnessDlgnull266 function ShowColorLightnessDlg(AParameters: TVariableSet): TScriptResult; virtual; abstract;
ShowShiftColorsDlgnull267 function ShowShiftColorsDlg(AParameters: TVariableSet): TScriptResult; virtual; abstract;
ShowColorizeDlgnull268 function ShowColorizeDlg(AParameters: TVariableSet): TScriptResult; virtual; abstract;
ShowColorCurvesDlgnull269 function ShowColorCurvesDlg(AParameters: TVariableSet): TScriptResult; virtual; abstract;
ShowRadialBlurDlgnull270 function ShowRadialBlurDlg(AFilterConnector: TObject; blurType:TRadialBlurType; ACaption: string = ''): TScriptResult; virtual; abstract;
ShowMotionBlurDlgnull271 function ShowMotionBlurDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowCustomBlurDlgnull272 function ShowCustomBlurDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowEmbossDlgnull273 function ShowEmbossDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowRainDlgnull274 function ShowRainDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowPixelateDlgnull275 function ShowPixelateDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowNoiseFilterDlgnull276 function ShowNoiseFilterDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowTwirlDlgnull277 function ShowTwirlDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowWaveDisplacementDlgnull278 function ShowWaveDisplacementDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowPhongFilterDlgnull279 function ShowPhongFilterDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowFunctionFilterDlgnull280 function ShowFunctionFilterDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowSharpenDlgnull281 function ShowSharpenDlg(AFilterConnector: TObject): TScriptResult; virtual; abstract;
ShowPosterizeDlgnull282 function ShowPosterizeDlg(AParameters: TVariableSet): TScriptResult; virtual; abstract;
283 procedure ShowPrintDlg; virtual; abstract;
OpenImagenull284 function OpenImage (FileName: string; AddToRecent: Boolean= True): boolean; virtual; abstract;
285 procedure AddToImageList(const FileNames: array of String); virtual; abstract;
286 procedure UpdateToolbar; virtual; abstract;
287 procedure UpdateEditPicture(ADelayed: boolean); virtual; abstract;
HideTopmostnull288 function HideTopmost: TTopMostInfo; virtual; abstract;
289 procedure ShowTopmost(AInfo: TTopMostInfo); virtual; abstract;
290 procedure ShowCanvasSizeDlg; virtual; abstract;
291 procedure ShowRepeatImageDlg; virtual; abstract;
292 procedure ShowAboutDlg; virtual; abstract;
293 procedure ShowMessage(ACaption: string; AMessage: string; ADlgType: TMsgDlgType = mtInformation);
294 procedure ShowError(ACaption: string; AMessage: string);
SaveQuestionnull295 function SaveQuestion(ATitle: string): integer;
ShowNewImageDlgnull296 function ShowNewImageDlg(out bitmap: TBGRABitmap):boolean; virtual; abstract;
ShowResampleDialognull297 function ShowResampleDialog(AParameters: TVariableSet):boolean; virtual; abstract;
298 procedure UpdateWindows; virtual; abstract;
299 procedure Wait(ACheckActive: TCheckFunction; ADelayMs: integer); virtual; abstract;
300 procedure AddColorToPalette(AColor: TBGRAPixel); virtual; abstract;
301 procedure RemoveColorFromPalette(AColor: TBGRAPixel); virtual; abstract;
302
303 property BlackAndWhite: boolean read FBlackAndWhite write SetBlackAndWhite;
304
305 procedure ScrollLayerStackOnItem(AIndex: integer; ADelayedUpdate: boolean = true); virtual; abstract;
306 procedure InvalidateLayerStack; virtual; abstract;
307 procedure UpdateLayerStackOnTimer; virtual; abstract;
MakeNewBitmapReplacementnull308 function MakeNewBitmapReplacement(AWidth, AHeight: integer; AColor: TBGRAPixel): TBGRABitmap; virtual; abstract;
309 procedure ChooseTool(Tool : TPaintToolType); virtual; abstract;
GetOnlineUpdaternull310 function GetOnlineUpdater: TLazPaintCustomOnlineUpdater; virtual;
311
312 property GridVisible: boolean read GetGridVisible write SetGridVisible;
313
314 procedure MoveToolboxTo(X,Y: integer); virtual; abstract;
315 property ToolboxVisible: boolean read GetToolboxVisible write SetToolboxVisible;
316 property ToolboxWidth: integer read GetToolboxWidth;
317 property ToolboxHeight: integer read GetToolboxHeight;
318 property ToolboxWindowPopup: TPopupMenu read GetToolBoxWindowPopup write SetToolBoxWindowPopup;
319
320 procedure MoveChooseColorTo(X,Y: integer); virtual; abstract;
321 property ChooseColorVisible: boolean read GetChooseColorVisible write SetChooseColorVisible;
322 property ChooseColorWidth: integer read GetChooseColorWidth write SetChooseColorWidth;
323 property ChooseColorHeight: integer read GetChooseColorHeight write SetChooseColorHeight;
324
325 procedure MoveLayerWindowTo(X,Y: integer); virtual; abstract;
326 property LayerWindowWidth: integer read GetLayerWindowWidth write SetLayerWindowWidth;
327 property LayerWindowHeight: integer read GetLayerWindowHeight write SetLayerWindowHeight;
328 property LayerWindowVisible: boolean read GetLayerWindowVisible write SetLayerWindowVisible;
329
330 procedure ImageListWindowVisibleKeyDown(var Key: Word; Shift: TShiftState); virtual; abstract;
331 procedure MoveImageListWindowTo(X,Y: integer); virtual; abstract;
332 property ImageListWindowWidth: integer read GetImageListWindowWidth write SetImageListWindowWidth;
333 property ImageListWindowHeight: integer read GetImageListWindowHeight write SetImageListWindowHeight;
334 property ImageListWindowVisible: boolean read GetImageListWindowVisible write SetImageListWindowVisible;
335
336 property ChooseColorTarget: TColorTarget read GetChooseColorTarget write setChooseColorTarget;
337 property Config: TLazPaintConfig read GetConfig;
338 property Image: TLazPaintImage read GetImage;
339 property ImageAction: TObject read GetImageAction;
340 property ZoomFactor: single read GetZoomFactor;
341 property ToolManager: TToolManager read GetToolManager;
342 property Embedded: boolean read GetEmbedded;
343 property TopMostHasFocus: boolean read GetTopMostHasFocus;
344 property TopMostOkToUnfocus: boolean read GetTopMostOkToUnfocus;
345 property TopMostVisible: boolean read GetTopMostVisible;
346
347 property ShowSelectionNormal: boolean read GetShowSelectionNormal write SetShowSelectionNormal;
348 property ScriptContext: TScriptContext read GetScriptContext;
349 property MainFormBounds: TRect read GetMainFormBounds;
350 property DockLayersAndColors: boolean read GetDockLayersAndColors write SetDockLayersAndColors;
351 property Fullscreen: boolean read GetFullscreen write SetFullscreen;
352 property RestartQuery: boolean read FRestartQuery;
353 property DarkTheme: boolean read GetDarkTheme write SetDarkTheme;
354 property UpdateStackOnTimer: boolean read GetUpdateStackOnTimer write SetUpdateStackOnTimer;
355
356 property Icons[ASize: integer]: TImageList read GetIcons;
357 end;
358
StrToPictureFilternull359 function StrToPictureFilter(const s: ansistring): TPictureFilter;
360 procedure SafeSetFocus(AControl: TWinControl);
WindowBorderWidthnull361 function WindowBorderWidth(AForm: TForm): integer;
WindowBorderTopHeightnull362 function WindowBorderTopHeight(AForm: TForm; {%H-}AIncludeTitle: boolean): integer;
WindowBorderBottomHeightnull363 function WindowBorderBottomHeight(AForm: TForm): integer;
WindowOutermostBorderWidthnull364 function WindowOutermostBorderWidth: integer;
WindowOutermostBorderHeightnull365 function WindowOutermostBorderHeight: integer;
GetWindowFullWidthnull366 function GetWindowFullWidth(AForm: TForm): integer;
367 procedure SetWindowFullWidth(AForm: TForm; AWidth: integer);
GetWindowFullHeightnull368 function GetWindowFullHeight(AForm: TForm): integer;
369 procedure SetWindowFullHeight(AForm: TForm; AHeight: integer);
370 procedure SetWindowFullSize(AForm: TForm; AWidth,AHeight: integer);
371 procedure SetWindowTopLeftCorner(AForm: TForm; X,Y: integer);
GetWindowTopLeftCornernull372 function GetWindowTopLeftCorner(AForm: TForm): TPoint;
PascalToCSSCasenull373 function PascalToCSSCase(AIdentifier: string): string;
CSSToPascalCasenull374 function CSSToPascalCase(AIdentifier: string): string;
375
376 implementation
377
378 uses LCLType, BGRAUTF8, LCLIntf, FileUtil, UResourceStrings, LCVectorialFill;
379
LazPaintVersionStrnull380 function LazPaintVersionStr: string;
381 var numbers: TStringList;
382 i,remaining: cardinal;
383 begin
384 numbers := TStringList.Create;
385 remaining := LazPaintVersion;
386 for i := 1 to 4 do
387 begin
388 numbers.Insert(0, IntToStr(remaining mod 100));
389 remaining := remaining div 100;
390 end;
391 while (numbers.Count > 1) and (numbers[numbers.Count-1]='0') do
392 numbers.Delete(numbers.Count-1);
393 numbers.Delimiter:= '.';
394 result := numbers.DelimitedText;
395 numbers.Free;
396 end;
397
LazPaintCurrentVersionnull398 function LazPaintCurrentVersion: String;
399 const
400 {$IFDEF CPU64}
401 LazPaintProcessorInfo = ' (64-bit)';
402 {$ELSE}
403 LazPaintProcessorInfo = ' (32-bit)';
404 {$ENDIF}
405 begin
406 result := LazPaintVersionStr {$IFDEF DEBUG} + ' Beta'{$ENDIF} + LazPaintProcessorInfo;
407 end;
408
IsOnlyRenderChangenull409 function IsOnlyRenderChange(const ARect: TRect): boolean;
410 begin
411 result := (ARect.left = OnlyRenderChange.left) and
412 (ARect.top = OnlyRenderChange.top) and
413 (ARect.right = OnlyRenderChange.right) and
414 (ARect.bottom = OnlyRenderChange.bottom);
415 end;
416
StrToPictureFilternull417 function StrToPictureFilter(const s: ansistring): TPictureFilter;
418 var pf: TPictureFilter;
419 ls: ansistring;
420 begin
421 result := pfNone;
422 ls:= UTF8LowerCase(s);
423 for pf := low(TPictureFilter) to high(TPictureFilter) do
424 if ls = UTF8LowerCase(PictureFilterStr[pf]) then
425 begin
426 result := pf;
427 break;
428 end;
429 end;
430
431 procedure SafeSetFocus(AControl: TWinControl);
432 begin
433 try
434 AControl.SetFocus;
435 except
436 end;
437 end;
438
WindowBorderWidthnull439 function WindowBorderWidth(AForm: TForm): integer;
440 begin
441 If AForm.BorderStyle = bsNone then
442 begin
443 result := 0;
444 exit;
445 end;
446 {$IFDEF LINUX}
447 result := (GetWindowFullWidth(AForm)-AForm.ClientWidth) div 2;
448 {$ELSE}
449 if AForm.BorderStyle in[bsSizeable,bsSizeToolWin] then
450 result := GetSystemMetrics(SM_CXSIZEFRAME)
451 else if AForm.BorderStyle in[bsSingle,bsDialog,bsToolWindow] then
452 result := GetSystemMetrics(SM_CXFIXEDFRAME)
453 else
454 result := 0;
455 {$ENDIF}
456 end;
457
WindowBorderTopHeightnull458 function WindowBorderTopHeight(AForm: TForm; AIncludeTitle: boolean): integer;
459 begin
460 if AForm.BorderStyle = bsNone then
461 begin
462 result := 0;
463 exit;
464 end;
465 {$IFDEF LINUX}
466 result := GetWindowFullHeight(AForm) - AForm.ClientHeight - WindowBorderBottomHeight(AForm);
467 {$ELSE}
468 result := WindowBorderBottomHeight(AForm);
469 if AIncludeTitle and (AForm.BorderStyle <> bsNone) then
470 begin
471 if AForm.BorderStyle in[bsToolWindow,bsSizeToolWin] then
472 begin
473 result += GetSystemMetrics(SM_CYSMCAPTION)
474 end
475 else result += GetSystemMetrics(SM_CYCAPTION);
476 end;
477 {$ENDIF}
478 end;
479
WindowBorderBottomHeightnull480 function WindowBorderBottomHeight(AForm: TForm): integer;
481 begin
482 {$IFDEF LINUX}
483 result := WindowBorderWidth(AForm);
484 {$ELSE}
485 if AForm.BorderStyle in[bsSizeable,bsSizeToolWin] then
486 result := GetSystemMetrics(SM_CYSIZEFRAME)
487 else if AForm.BorderStyle in[bsSingle,bsDialog,bsToolWindow] then
488 result := GetSystemMetrics(SM_CYFIXEDFRAME)
489 else
490 result := 0;
491 {$ENDIF}
492 end;
493
WindowOutermostBorderWidthnull494 function WindowOutermostBorderWidth: integer;
495 begin
496 result := {$IFDEF LINUX}1{$ELSE}GetSystemMetrics(SM_CXBORDER){$ENDIF};
497 end;
498
WindowOutermostBorderHeightnull499 function WindowOutermostBorderHeight: integer;
500 begin
501 result := {$IFDEF LINUX}1{$ELSE}GetSystemMetrics(SM_CYBORDER){$ENDIF};
502 end;
503
GetWindowFullWidthnull504 function GetWindowFullWidth(AForm: TForm): integer;
505 {$IFDEF LINUX}var r: TRect;{$ENDIF}
506 begin
507 {$IFDEF LINUX}
508 if AForm.BorderStyle <> bsNone then
509 begin
510 r := rect(0,0,AForm.Width,AForm.Height);
511 WidgetSet.GetWindowRect(AForm.Handle, r);
512 result := r.right-r.left;
513 end else
514 {$ENDIF}
515 result := AForm.Width + WindowBorderWidth(AForm)*2;
516 end;
517
518 procedure SetWindowFullWidth(AForm: TForm; AWidth: integer);
519 begin
520 AForm.Width := AWidth - WindowBorderWidth(AForm)*2;
521 end;
522
GetWindowFullHeightnull523 function GetWindowFullHeight(AForm: TForm): integer;
524 {$IFDEF LINUX}var r: TRect;{$ENDIF}
525 begin
526 {$IFDEF LINUX}
527 if AForm.BorderStyle <> bsNone then
528 begin
529 r := rect(0,0,AForm.Width,AForm.Height);
530 WidgetSet.GetWindowRect(AForm.Handle, r);
531 result := r.bottom-r.top;
532 end else
533 {$ENDIF}
534 result := AForm.Height + WindowBorderTopHeight(AForm,True) + WindowBorderBottomHeight(AForm);
535 end;
536
537 procedure SetWindowFullHeight(AForm: TForm; AHeight: integer);
538 begin
539 AForm.Height := AHeight - WindowBorderTopHeight(AForm,True) - WindowBorderBottomHeight(AForm);
540 end;
541
542 procedure SetWindowFullSize(AForm: TForm; AWidth, AHeight: integer);
543 begin
544 AForm.SetBounds(AForm.Left,AForm.Top, AWidth - WindowBorderWidth(AForm)*2,
545 AHeight - WindowBorderTopHeight(AForm,True) - WindowBorderBottomHeight(AForm));
546 end;
547
548 procedure SetWindowTopLeftCorner(AForm: TForm; X, Y: integer);
549 begin
550 AForm.SetBounds(X,Y,AForm.Width,AForm.Height);
551 end;
552
GetWindowTopLeftCornernull553 function GetWindowTopLeftCorner(AForm: TForm): TPoint;
554 begin
555 result := Point(AForm.Left,AForm.Top);
556 end;
557
PascalToCSSCasenull558 function PascalToCSSCase(AIdentifier: string): string;
559 var
560 i: Integer;
561 begin
562 result := AIdentifier;
563 for i := length(result) downto 1 do
564 if result[i] <> lowercase(result[i]) then
565 begin
566 result[i] := lowercase(result[i]);
567 if i > 1 then Insert('-', result, i);
568 end;
569 end;
570
CSSToPascalCasenull571 function CSSToPascalCase(AIdentifier: string): string;
572 var
573 i: Integer;
574 begin
575 result := AIdentifier;
576 for i := length(result) downto 1 do
577 begin
578 if (i = 1) or (result[i-1] = '-') then
579 result[i] := upcase(result[i]) else
580 if result[i] = '-' then delete(result, i, 1);
581 end;
582 end;
583
584 { TImageEntry }
585
TImageEntry.Emptynull586 class function TImageEntry.Empty: TImageEntry;
587 begin
588 result.bmp := nil;
589 result.bpp := 0;
590 result.frameIndex := -1;
591 result.frameCount := 0;
592 result.isDuplicate:= false;
593 end;
594
TImageEntry.NewFrameIndexnull595 class function TImageEntry.NewFrameIndex: integer;
596 begin
597 result := -1;
598 end;
599
600 procedure TImageEntry.FreeAndNil;
601 begin
602 SysUtils.FreeAndNil(bmp);
603 bpp := 0;
604 end;
605
TLazPaintCustomInstance.GetDarkThemenull606 function TLazPaintCustomInstance.GetDarkTheme: boolean;
607 begin
608 if Assigned(Config) then
609 result := Config.GetDarkTheme
610 else
611 result := false;
612 end;
613
614 procedure TLazPaintCustomInstance.SetDarkTheme(AValue: boolean);
615 begin
616 if Assigned(Config) then
617 begin
618 if AValue <> Config.GetDarkTheme then
619 begin
620 Config.SetDarkTheme(AValue);
621 NotifyThemeChanged;
622 end;
623 end;
624 end;
625
626 { Interface gateway }
QueryInterfacenull627 function TLazPaintCustomInstance.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
628 begin
629 if GetInterface(iid, obj) then
630 Result := S_OK
631 else
632 Result := longint(E_NOINTERFACE);
633 end;
634
635 { There is no automatic reference counting, but it is compulsory to define these functions }
_AddRefnull636 function TLazPaintCustomInstance._AddRef: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
637 begin
638 result := 0;
639 end;
640
_Releasenull641 function TLazPaintCustomInstance._Release: Integer; {$IF (not defined(WINDOWS)) AND (FPC_FULLVERSION>=20501)}cdecl{$ELSE}stdcall{$IFEND};
642 begin
643 result := 0;
644 end;
645
TLazPaintCustomInstance.SaveQuestionnull646 function TLazPaintCustomInstance.SaveQuestion(ATitle: string): integer;
647 var top: TTopMostInfo;
648 begin
649 top := HideTopmost;
650 result := QuestionDlg (ATitle,rsSaveChanges,mtWarning,[mrYes,rsYes,mrNo,rsNo,mrCancel,rsCancel],'');
651 ShowTopmost(top);
652 end;
653
GetOnlineUpdaternull654 function TLazPaintCustomInstance.GetOnlineUpdater: TLazPaintCustomOnlineUpdater;
655 begin
656 result := nil;
657 end;
658
GetZoomFactornull659 function TLazPaintCustomInstance.GetZoomFactor: single;
660 begin
661 result := 1;
662 end;
663
GetColornull664 function TLazPaintCustomInstance.GetColor(ATarget: TColorTarget): TBGRAPixel;
GetStartColornull665 function GetStartColor(AFill: TVectorialFill): TBGRAPixel;
666 begin
667 if AFill.FillType = vftGradient then
668 result := AFill.Gradient.StartColor
669 else result := AFill.AverageColor;
670 end;
GetEndColornull671 function GetEndColor(AFill: TVectorialFill): TBGRAPixel;
672 begin
673 if AFill.FillType = vftGradient then
674 result := AFill.Gradient.EndColor
675 else result := AFill.AverageColor;
676 end;
677
678 begin
679 case ATarget of
680 ctForeColorSolid: result := ToolManager.ForeFill.AverageColor;
681 ctForeColorStartGrad: result := GetStartColor(ToolManager.ForeFill);
682 ctForeColorEndGrad: result := GetEndColor(ToolManager.ForeFill);
683 ctBackColorSolid: result := ToolManager.BackFill.AverageColor;
684 ctBackColorStartGrad: result := GetStartColor(ToolManager.BackFill);
685 ctBackColorEndGrad: result := GetEndColor(ToolManager.BackFill);
686 ctOutlineColorSolid: result := ToolManager.OutlineFill.AverageColor;
687 ctOutlineColorStartGrad: result := GetStartColor(ToolManager.OutlineFill);
688 ctOutlineColorEndGrad: result := GetEndColor(ToolManager.OutlineFill);
689 else
690 result := BGRAPixelTransparent;
691 end;
692 if BlackAndWhite then result := BGRAToGrayscale(result);
693 end;
694
695 procedure TLazPaintCustomInstance.SetColor(ATarget: TColorTarget;
696 AColor: TBGRAPixel);
697 begin
698 if BlackAndWhite then AColor := BGRAToGrayscale(AColor);
699 case ATarget of
700 ctForeColorSolid: if ToolManager.ForeFill.FillType = vftSolid then
701 ToolManager.ForeColor := AColor;
702 ctForeColorStartGrad: if ToolManager.ForeFill.FillType = vftGradient then
703 ToolManager.ForeFill.Gradient.StartColor := AColor;
704 ctForeColorEndGrad: if ToolManager.ForeFill.FillType = vftGradient then
705 ToolManager.ForeFill.Gradient.EndColor := AColor;
706 ctBackColorSolid: if ToolManager.BackFill.FillType = vftSolid then
707 ToolManager.BackColor := AColor;
708 ctBackColorStartGrad: if ToolManager.BackFill.FillType = vftGradient then
709 ToolManager.BackFill.Gradient.StartColor := AColor;
710 ctBackColorEndGrad: if ToolManager.BackFill.FillType = vftGradient then
711 ToolManager.BackFill.Gradient.EndColor := AColor;
712 ctOutlineColorSolid: if ToolManager.OutlineFill.FillType = vftSolid then
713 ToolManager.OutlineColor := AColor;
714 ctOutlineColorStartGrad: if ToolManager.OutlineFill.FillType = vftGradient then
715 ToolManager.OutlineFill.Gradient.StartColor := AColor;
716 ctOutlineColorEndGrad: if ToolManager.OutlineFill.FillType = vftGradient then
717 ToolManager.OutlineFill.Gradient.EndColor := AColor;
718 end;
719 end;
720
721 procedure TLazPaintCustomInstance.SetBlackAndWhite(AValue: boolean);
722 begin
723 if FBlackAndWhite=AValue then Exit;
724 FBlackAndWhite:=AValue;
725 end;
726
727 procedure TLazPaintCustomInstance.ShowMessage(ACaption: string; AMessage: string; ADlgType: TMsgDlgType = mtInformation);
728 var top: TTopMostInfo;
729 elems: TStringList;
730 res: TModalResult;
731 begin
732 top := HideTopmost;
733 elems := TStringList.Create;
734 elems.Delimiter:= #9;
735 elems.StrictDelimiter:= true;
736 elems.DelimitedText:= AMessage;
737 if (elems.Count = 3) and (elems[1] = rsDownload) then
738 begin
739 res := QuestionDlg(ACaption,elems[0],ADlgType,[mrOk,rsDownload,mrCancel,rsCancel],'');
740 if res = mrOk then OpenURL(elems[2]);
741 end else
742 QuestionDlg(ACaption,AMessage,ADlgType,[mrOk,rsOkay],'');
743 elems.Free;
744 ShowTopmost(top);
745 end;
746
747 procedure TLazPaintCustomInstance.ShowError(ACaption: string; AMessage: string);
748 begin
749 ShowMessage(ACaption,AMessage,mtError);
750 end;
751
752 end.
753
754