lazpaintinstance.pas 74 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251
  1. // SPDX-License-Identifier: GPL-3.0-only
  2. unit LazpaintInstance;
  3. {$mode objfpc}{$H+}
  4. interface
  5. uses
  6. Classes, SysUtils, LazPaintType, BGRABitmap, BGRABitmapTypes, BGRALayers, LCVectorialFill,
  7. Menus, Forms, Controls, fgl, LCLType,
  8. LazPaintMainForm, UMainFormLayout,
  9. UToolbox, UChooseColor, ULayerstack, UCanvassize,
  10. UColorintensity, UShiftColors, UColorize, uadjustcurves,
  11. UCustomblur, uimagelist,
  12. ULoading, UImage, UImageAction, UTool, uconfig, IniFiles, UResourceStrings, UScripting,
  13. UScriptType;
  14. const
  15. MaxToolPopupShowCount = 3;
  16. type
  17. TImageListList = specialize TFPGObjectList<TImageList>;
  18. TListeners = specialize TFPGList<TNotifyEvent>;
  19. { TLazPaintInstance }
  20. TLazPaintInstance = class(TLazPaintCustomInstance)
  21. private
  22. FScriptName: String;
  23. FThemeListeners: TListeners;
  24. procedure ChooseColorHide(Sender: TObject);
  25. function GetFormAdjustCurves: TFAdjustCurves;
  26. function GetFormCanvasSize: TFCanvasSize;
  27. function GetFormColorIntensity: TFColorIntensity;
  28. function GetFormColorize: TFColorize;
  29. function GetFormCustomBlur: TFCustomBlur;
  30. function GetFormShiftColors: TFShiftColors;
  31. function GetInitialized: boolean;
  32. function GetMainFormVisible: boolean;
  33. procedure LayerStackHide(Sender: TObject);
  34. procedure OnImageActionProgress({%H-}ASender: TObject; AProgressPercent: integer);
  35. procedure OnLayeredBitmapLoadStartHandler(AFilenameUTF8: string);
  36. procedure OnLayeredBitmapLoadProgressHandler(APercentage: integer);
  37. procedure OnLayeredBitmapLoadedHandler;
  38. procedure OnLayeredBitmapSavedHandler();
  39. procedure OnLayeredBitmapSaveProgressHandler(APercentage: integer);
  40. procedure OnLayeredBitmapSaveStartHandler(AFilenameUTF8: string);
  41. procedure OnSizeChanged(Sender: TObject);
  42. procedure RegisterScripts(ARegister: Boolean);
  43. function ScriptColorColorize(AVars: TVariableSet): TScriptResult;
  44. function ScriptColorCurves(AVars: TVariableSet): TScriptResult;
  45. function ScriptColorIntensity(AVars: TVariableSet): TScriptResult;
  46. function ScriptColorLightness(AVars: TVariableSet): TScriptResult;
  47. function ScriptColorPosterize(AVars: TVariableSet): TScriptResult;
  48. function ScriptColorShiftColors(AVars: TVariableSet): TScriptResult;
  49. function ScriptFileGetTemporaryName(AVars: TVariableSet): TScriptResult;
  50. function ScriptFileNew(AVars: TVariableSet): TScriptResult;
  51. function ScriptGetName(AVars: TVariableSet): TScriptResult;
  52. function ScriptImageCanvasSize(AVars: TVariableSet): TScriptResult;
  53. function ScriptImageRepeat(AVars: TVariableSet): TScriptResult;
  54. function ScriptImageResample(AParams: TVariableSet): TScriptResult;
  55. function ScriptLazPaintGetVersion(AVars: TVariableSet): TScriptResult;
  56. function ScriptShowDirectoryDialog(AVars: TVariableSet): TScriptResult;
  57. function ScriptTranslateGetLanguage(AVars: TVariableSet): TScriptResult;
  58. function ScriptTranslateText(AVars: TVariableSet): TScriptResult;
  59. procedure SelectionInstanceOnRun(AInstance: TLazPaintCustomInstance);
  60. procedure ToolFillChanged(Sender: TObject);
  61. procedure PythonScriptCommand({%H-}ASender: TObject; ACommand, AParam: UTF8String; out
  62. AResult: UTF8String);
  63. procedure PythonBusy({%H-}Sender: TObject);
  64. procedure PythonWarning({%H-}Sender: TObject; AMessage: UTF8String; out AProceed: boolean);
  65. function ScriptShowMessage(AVars: TVariableSet): TScriptResult;
  66. function ScriptInputBox(AVars: TVariableSet): TScriptResult;
  67. procedure ToolQueryColorTarget({%H-}sender: TToolManager; ATarget: TVectorialFill);
  68. protected
  69. InColorFromFChooseColor: boolean;
  70. FMain: TFMain;
  71. FFormToolbox: TFToolbox;
  72. FFormToolboxInitialPopup: TPopupMenu;
  73. FFormToolboxInitialPosition: TPoint;
  74. FImageList: TFImageList;
  75. FChooseColor: TFChooseColor;
  76. FLayerStack: TFLayerStack;
  77. FFormCanvasSize: TFCanvasSize;
  78. FFormColorIntensity: TFColorIntensity;
  79. FFormShiftColors: TFShiftColors;
  80. FFormColorize: TFColorize;
  81. FFormAdjustCurves: TFAdjustCurves;
  82. FFormCustomBlur: TFCustomBlur;
  83. FLoadingLayers: TFLoading;
  84. FTopMostInfo: TTopMostInfo;
  85. FGridVisible: boolean;
  86. FConfig: TLazPaintConfig;
  87. FImage: TLazPaintImage;
  88. FImageAction: TImageActions;
  89. FToolManager : TToolManager;
  90. FEmbedded: boolean;
  91. FDestroying: boolean;
  92. FSelectionEditConfig: TStream;
  93. FTextureEditConfig: TStream;
  94. FScriptContext: TScriptContext;
  95. FInFormsNeeded: boolean;
  96. FLayerControlVisible, FChooseColorControlVisible: boolean;
  97. FDockLayersAndColors, FFullscreen: boolean;
  98. FPrevDockArea: TRect;
  99. FInSetToolboxVisible: boolean;
  100. FToolBoxPositionDefined,
  101. FChooseColorPositionDefined,
  102. FLayerStackPositionDefined,
  103. FImageListPositionDefined : boolean;
  104. FCustomImageList: TImageListList;
  105. FLoadingFilename, FSavingFilename: string;
  106. FInRunScript: boolean;
  107. FScriptTempFileNames: TStringList;
  108. FInCommandLine: boolean;
  109. FUpdateStackOnTimer: boolean;
  110. function GetIcons(ASize: integer): TImageList; override;
  111. function GetToolBoxWindowPopup: TPopupMenu; override;
  112. procedure SetToolBoxWindowPopup(AValue: TPopupMenu); override;
  113. function GetFullscreen: boolean; override;
  114. procedure SetFullscreen(AValue: boolean); override;
  115. function GetToolWindowVisible(AWindow: TForm; ADockedVisible: boolean = false): boolean;
  116. function GetDockLayersAndColors: boolean; override;
  117. procedure SetDockLayersAndColors(AValue: boolean); override;
  118. function GetScriptContext: TScriptContext; override;
  119. function GetShowSelectionNormal: boolean; override;
  120. procedure SetShowSelectionNormal(AValue: boolean); override;
  121. function GetEmbedded: boolean; override;
  122. function GetGridVisible: boolean; override;
  123. procedure SetGridVisible(const AValue: boolean); override;
  124. function GetChooseColorVisible: boolean; override;
  125. function GetToolboxVisible: boolean; override;
  126. function GetImageListWindowVisible: boolean; override;
  127. procedure SetChooseColorVisible(const AValue: boolean); override;
  128. procedure SetToolBoxVisible(const AValue: boolean); override;
  129. procedure SetImageListWindowVisible(const AValue: boolean); override;
  130. function GetChooseColorHeight: integer; override;
  131. function GetChooseColorWidth: integer; override;
  132. procedure SetChooseColorHeight(AValue: integer); override;
  133. procedure SetChooseColorWidth(AValue: integer); override;
  134. function GetToolboxHeight: integer; override;
  135. function GetToolboxWidth: integer; override;
  136. function GetTopMostHasFocus: boolean; override;
  137. function GetTopMostVisible: boolean; override;
  138. function GetTopMostOkToUnfocus: boolean; override;
  139. function GetChooseColorTarget: TColorTarget; override;
  140. procedure SetChooseColorTarget(const AValue: TColorTarget); override;
  141. function GetConfig: TLazPaintConfig; override;
  142. function GetImage: TLazPaintImage; override;
  143. function GetImageAction: TImageActions; override;
  144. function GetToolManager: TToolManager; override;
  145. function GetUpdateStackOnTimer: boolean; override;
  146. procedure SetUpdateStackOnTimer(AValue: boolean); override;
  147. procedure CreateLayerStack;
  148. procedure CreateToolBox;
  149. procedure FormsNeeded;
  150. procedure Init(AEmbedded: boolean);
  151. procedure SetBlackAndWhite(AValue: boolean); override;
  152. procedure OnStackChanged({%H-}sender: TLazPaintImage; AScrollIntoView: boolean);
  153. procedure OnToolPopup({%H-}sender: TToolManager; AMessage: TToolPopupMessage; AKey: Word;
  154. AAlways: boolean);
  155. function GetImageListWindowHeight: integer; override;
  156. function GetImageListWindowWidth: integer; override;
  157. procedure SetImageListWindowHeight(AValue: integer); override;
  158. procedure SetImageListWindowWidth(AValue: integer); override;
  159. function GetLayerWindowHeight: integer; override;
  160. function GetLayerWindowWidth: integer; override;
  161. procedure SetLayerWindowHeight(AValue: integer); override;
  162. procedure SetLayerWindowWidth(AValue: integer); override;
  163. function GetLayerWindowVisible: boolean; override;
  164. procedure SetLayerWindowVisible(AValue: boolean); override;
  165. procedure OnFunctionException(AFunctionName: string; AException: Exception);
  166. function GetMainFormBounds: TRect; override;
  167. procedure EditSelectionHandler(var AImage: TBGRABitmap);
  168. function GetZoomFactor: single; override;
  169. procedure UpdateLayerControlVisibility;
  170. procedure UpdateChooseColorControlVisibility;
  171. property FormCanvasSize: TFCanvasSize read GetFormCanvasSize;
  172. property FormColorIntensity: TFColorIntensity read GetFormColorIntensity;
  173. property FormShiftColors: TFShiftColors read GetFormShiftColors;
  174. property FormColorize: TFColorize read GetFormColorize;
  175. property FormAdjustCurves: TFAdjustCurves read GetFormAdjustCurves;
  176. property FormCustomBlur: TFCustomBlur read GetFormCustomBlur;
  177. public
  178. constructor Create; override;
  179. constructor Create(AEmbedded: boolean); override;
  180. procedure RegisterThemeListener(AHandler: TNotifyEvent; ARegister: boolean); override;
  181. procedure NotifyThemeChanged; override;
  182. procedure StartLoadingImage(AFilename: string); override;
  183. procedure EndLoadingImage; override;
  184. procedure StartSavingImage(AFilename: string); override;
  185. procedure EndSavingImage; override;
  186. procedure ReportActionProgress(AProgressPercent: integer); override;
  187. procedure Donate; override;
  188. procedure SaveMainWindowPosition; override;
  189. procedure RestoreMainWindowPosition; override;
  190. procedure UseConfig(ini: TInifile); override;
  191. procedure AssignBitmap(bmp: TBGRABitmap); override;
  192. procedure AssignBitmap(bmp: TBGRALayeredBitmap); override;
  193. function InternalEditBitmap(var bmp: TObject; ConfigStream: TStream = nil;
  194. ATitle: String = ''; AOnRun: TLazPaintInstanceEvent = nil;
  195. AOnExit: TLazPaintInstanceEvent = nil;
  196. ABlackAndWhite: boolean = false): boolean;
  197. function EditBitmap(var bmp: TBGRABitmap; ConfigStream: TStream = nil;
  198. ATitle: String = ''; AOnRun: TLazPaintInstanceEvent = nil;
  199. AOnExit: TLazPaintInstanceEvent = nil;
  200. ABlackAndWhite: boolean = false): boolean; override;
  201. function EditBitmap(var bmp: TBGRALayeredBitmap;
  202. ConfigStream: TStream = nil; ATitle: String = '';
  203. AOnRun: TLazPaintInstanceEvent = nil;
  204. AOnExit: TLazPaintInstanceEvent = nil;
  205. ABlackAndWhite : boolean = false): boolean; override;
  206. procedure EditSelection; override;
  207. function EditTexture(ASource: TBGRABitmap): TBGRABitmap; override;
  208. function ProcessCommandLine: boolean; override;
  209. function ProcessCommands(commands: TStringList): boolean; override;
  210. procedure ChangeIconSize(size: integer); override;
  211. procedure Show; override;
  212. function Hide: boolean; override;
  213. procedure Run; override;
  214. function Restart: boolean; override;
  215. procedure CancelRestart; override;
  216. destructor Destroy; override;
  217. procedure NotifyImageChange(RepaintNow: boolean; ARect: TRect); override;
  218. procedure NotifyImageChangeCompletely(RepaintNow: boolean); override;
  219. procedure NotifyImagePaint; override;
  220. function TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean = false): boolean; override;
  221. function ExecuteFilter(filter: TPictureFilter; skipDialog: boolean = false): TScriptResult; override;
  222. function RunScript(AFilename: string; ACaption: string = ''): boolean; override;
  223. procedure AdjustChooseColorHeight; override;
  224. procedure ColorFromFChooseColor; override;
  225. procedure ColorToFChooseColor; override;
  226. procedure ExitColorEditor; override;
  227. function ColorEditorActive: boolean; override;
  228. procedure NotifyColorBinding; override;
  229. function ShowSaveOptionDlg({%H-}AParameters: TVariableSet; AOutputFilenameUTF8: string;
  230. ASkipOptions: boolean; AExport: boolean): boolean; override;
  231. function ShowColorIntensityDlg(AParameters: TVariableSet): TScriptResult; override;
  232. function ShowColorLightnessDlg(AParameters: TVariableSet): TScriptResult; override;
  233. function ShowShiftColorsDlg(AParameters: TVariableSet): TScriptResult; override;
  234. function ShowColorizeDlg(AParameters: TVariableSet): TScriptResult; override;
  235. function ShowColorCurvesDlg(AParameters: TVariableSet): TScriptResult; override;
  236. function ShowRadialBlurDlg(AFilterConnector: TObject; blurType:TRadialBlurType; ACaption: string = ''): TScriptResult; override;
  237. function ShowMotionBlurDlg(AFilterConnector: TObject): TScriptResult; override;
  238. function ShowCustomBlurDlg(AFilterConnector: TObject): TScriptResult; override;
  239. function ShowEmbossDlg(AFilterConnector: TObject): TScriptResult; override;
  240. function ShowRainDlg(AFilterConnector: TObject): TScriptResult; override;
  241. function ShowPixelateDlg(AFilterConnector: TObject): TScriptResult; override;
  242. function ShowNoiseFilterDlg(AFilterConnector: TObject): TScriptResult; override;
  243. function ShowTwirlDlg(AFilterConnector: TObject): TScriptResult; override;
  244. function ShowWaveDisplacementDlg(AFilterConnector: TObject): TScriptResult; override;
  245. function ShowPhongFilterDlg(AFilterConnector: TObject): TScriptResult; override;
  246. function ShowFunctionFilterDlg(AFilterConnector: TObject): TScriptResult; override;
  247. function ShowSharpenDlg(AFilterConnector: TObject): TScriptResult; override;
  248. function ShowPosterizeDlg(AParameters: TVariableSet): TScriptResult; override;
  249. function ShowHypocycloidDlg(AInstance: TLazPaintCustomInstance; AParameters: TVariableSet): TScriptResult; override;
  250. function ShowSuperformulaDlg(AInstance: TLazPaintCustomInstance; AParameters: TVariableSet): TScriptResult; override;
  251. procedure ShowPrintDlg; override;
  252. function HideTopmost: TTopMostInfo; override;
  253. procedure ShowTopmost(AInfo: TTopMostInfo); override;
  254. procedure UpdateWindows; override;
  255. procedure Wait(ACheckActive: TCheckFunction; ADelayMs: integer); override;
  256. procedure ShowCanvasSizeDlg; override;
  257. procedure ShowRepeatImageDlg; override;
  258. procedure MoveToolboxTo(X,Y: integer); override;
  259. procedure MoveChooseColorTo(X,Y: integer); override;
  260. procedure MoveLayerWindowTo(X,Y: integer); override;
  261. procedure MoveImageListWindowTo(X,Y: integer); override;
  262. procedure ImageListWindowVisibleKeyDown(var Key: Word; Shift: TShiftState); override;
  263. procedure ShowAboutDlg; override;
  264. function ShowNewImageDlg(out bitmap: TBGRABitmap):boolean; override;
  265. function ShowResampleDialog(AParameters: TVariableSet):boolean; override;
  266. property MainFormVisible: boolean read GetMainFormVisible;
  267. procedure NotifyStackChange; override;
  268. procedure ScrollLayerStackOnItem(AIndex: integer; ADelayedUpdate: boolean = true); override;
  269. procedure InvalidateLayerStack; override;
  270. procedure UpdateLayerStackOnTimer; override;
  271. function MakeNewBitmapReplacement(AWidth, AHeight: integer; AColor: TBGRAPixel): TBGRABitmap; override;
  272. procedure ChooseTool(Tool : TPaintToolType; AAsFromGui: boolean); override;
  273. function OpenImage (FileName: string; AddToRecent: Boolean= True): boolean; override;
  274. procedure AddToImageList(const FileNames: array of String); override;
  275. procedure UpdateToolbar; override;
  276. procedure UpdateEditPicture(ADelayed: boolean); override;
  277. procedure AddColorToPalette(AColor: TBGRAPixel); override;
  278. procedure RemoveColorFromPalette(AColor: TBGRAPixel); override;
  279. function GetKeyAssociatedToColor(const AColor: TBGRAPixel): string; override;
  280. property Initialized: boolean read GetInitialized;
  281. procedure SendKeyDownEventToMainForm(var Key: Word; Shift: TShiftState); override;
  282. procedure SendKeyUpEventToMainForm(var Key: Word; Shift: TShiftState); override;
  283. procedure SendUTF8KeyPressEventToMainForm(var UTF8Key: TUTF8Char); override;
  284. end;
  285. implementation
  286. uses Types, Dialogs, FileUtil, StdCtrls, LCLIntf, BGRAUTF8, UTranslation,
  287. URadialBlur, UMotionBlur, UEmboss, UTwirl, UWaveDisplacement,
  288. unewimage, uresample, UPixelate, unoisefilter, ufilters,
  289. USharpen, uposterize, uhypocycloid, USuperformula, UPhongFilter, UFilterFunction,
  290. uprint, USaveOption, UFormRain,
  291. {$IFDEF DARWIN}Graphics, BGRAGraphics,{$ENDIF}
  292. ugraph, LCScaleDPI, ucommandline, uabout, UPython;
  293. { TLazPaintInstance }
  294. {$i lazpaintdialogs.inc}
  295. constructor TLazPaintInstance.Create;
  296. begin
  297. Init(False);
  298. end;
  299. constructor TLazPaintInstance.Create(AEmbedded: boolean);
  300. begin
  301. Init(AEmbedded);
  302. end;
  303. procedure TLazPaintInstance.RegisterThemeListener(AHandler: TNotifyEvent;
  304. ARegister: boolean);
  305. begin
  306. if ARegister then
  307. begin
  308. if FThemeListeners.IndexOf(AHandler) = -1 then
  309. FThemeListeners.Add(AHandler);
  310. end else
  311. begin
  312. FThemeListeners.Remove(AHandler);
  313. end;
  314. end;
  315. procedure TLazPaintInstance.NotifyThemeChanged;
  316. var
  317. i: Integer;
  318. begin
  319. for i := 0 to FThemeListeners.Count-1 do
  320. FThemeListeners[i](self);
  321. end;
  322. procedure TLazPaintInstance.StartLoadingImage(AFilename: string);
  323. begin
  324. FLoadingFilename:= AFilename;
  325. if not FInCommandLine then
  326. BGRALayers.RegisterLoadingHandler(@OnLayeredBitmapLoadStartHandler,@OnLayeredBitmapLoadProgressHandler,@OnLayeredBitmapLoadedHandler);
  327. end;
  328. procedure TLazPaintInstance.EndLoadingImage;
  329. begin
  330. BGRALayers.UnregisterLoadingHandler(@OnLayeredBitmapLoadStartHandler,@OnLayeredBitmapLoadProgressHandler,@OnLayeredBitmapLoadedHandler);
  331. FreeAndNil(FLoadingLayers);
  332. FLoadingFilename:= '';
  333. end;
  334. procedure TLazPaintInstance.StartSavingImage(AFilename: string);
  335. begin
  336. Screen.Cursor := crHourGlass;
  337. UpdateWindows;
  338. FSavingFilename:= AFilename;
  339. if not FInCommandLine then
  340. BGRALayers.RegisterSavingHandler(@OnLayeredBitmapSaveStartHandler,@OnLayeredBitmapSaveProgressHandler,@OnLayeredBitmapSavedHandler);
  341. end;
  342. procedure TLazPaintInstance.EndSavingImage;
  343. begin
  344. BGRALayers.UnregisterSavingHandler(@OnLayeredBitmapSaveStartHandler,@OnLayeredBitmapSaveProgressHandler,@OnLayeredBitmapSavedHandler);
  345. FreeAndNil(FLoadingLayers);
  346. FSavingFilename:= '';
  347. Screen.Cursor := crDefault;
  348. UpdateWindows;
  349. end;
  350. procedure TLazPaintInstance.ReportActionProgress(AProgressPercent: integer);
  351. var
  352. delay: Integer;
  353. begin
  354. {$IFDEF LCLqt5}exit;{$ENDIF}
  355. if AProgressPercent < 100 then delay := 10000 else delay := 1000;
  356. if Assigned(FMain) then FMain.UpdatingPopup:= true;
  357. try
  358. MessagePopup(rsActionInProgress+'... '+inttostr(AProgressPercent)+'%', delay);
  359. UpdateWindows;
  360. finally
  361. if Assigned(FMain) then FMain.UpdatingPopup:= false;
  362. end;
  363. end;
  364. procedure TLazPaintInstance.Donate;
  365. begin
  366. OpenURL('http://sourceforge.net/donate/index.php?group_id=404555');
  367. end;
  368. procedure TLazPaintInstance.SaveMainWindowPosition;
  369. var r:TRect;
  370. begin
  371. if FMain.WindowState = wsMinimized then exit;
  372. if FMain.WindowState = wsMaximized then
  373. Config.SetDefaultMainWindowMaximized(true) else
  374. If FMain.WindowState = wsNormal then
  375. begin
  376. r.left := FMain.Left;
  377. r.top := FMain.Top;
  378. r.right := r.left+FMain.ClientWidth;
  379. r.Bottom := r.top+FMain.ClientHeight;
  380. Config.SetDefaultMainWindowPosition(r);
  381. end;
  382. end;
  383. procedure TLazPaintInstance.RestoreMainWindowPosition;
  384. var r:TRect;
  385. begin
  386. if not MainFormVisible then exit;
  387. if Config.DefaultMainWindowMaximized then
  388. FMain.WindowState := wsMaximized else
  389. begin
  390. r := Config.DefaultMainWindowPosition;
  391. if (r.right > r.left) and (r.bottom > r.top) then
  392. begin
  393. FMain.Position := poDesigned;
  394. FMain.Left := r.Left;
  395. FMain.Top := r.Top;
  396. FMain.ClientWidth := r.right-r.left;
  397. FMain.ClientHeight := r.bottom-r.top
  398. end;
  399. end;
  400. end;
  401. procedure TLazPaintInstance.RegisterScripts(ARegister: Boolean);
  402. begin
  403. if not Assigned(ScriptContext) then exit;
  404. ScriptContext.RegisterScriptFunction('FileGetTemporaryName', @ScriptFileGetTemporaryName,ARegister);
  405. ScriptContext.RegisterScriptFunction('FileNew',@ScriptFileNew,ARegister);
  406. ScriptContext.RegisterScriptFunction('ImageResample',@ScriptImageResample,ARegister);
  407. ScriptContext.RegisterScriptFunction('ImageCanvasSize',@ScriptImageCanvasSize,ARegister);
  408. ScriptContext.RegisterScriptFunction('ImageRepeat',@ScriptImageRepeat,ARegister);
  409. ScriptContext.RegisterScriptFunction('ColorCurves',@ScriptColorCurves,ARegister);
  410. ScriptContext.RegisterScriptFunction('ColorPosterize',@ScriptColorPosterize,ARegister);
  411. ScriptContext.RegisterScriptFunction('ColorColorize',@ScriptColorColorize,ARegister);
  412. ScriptContext.RegisterScriptFunction('ColorLightness',@ScriptColorLightness,ARegister);
  413. ScriptContext.RegisterScriptFunction('ColorShiftColors',@ScriptColorShiftColors,ARegister);
  414. ScriptContext.RegisterScriptFunction('ColorIntensity',@ScriptColorIntensity,ARegister);
  415. ScriptContext.RegisterScriptFunction('ShowMessage',@ScriptShowMessage,ARegister);
  416. ScriptContext.RegisterScriptFunction('ShowDirectoryDialog',@ScriptShowDirectoryDialog,ARegister);
  417. ScriptContext.RegisterScriptFunction('InputBox',@ScriptInputBox,ARegister);
  418. ScriptContext.RegisterScriptFunction('LazPaintGetVersion',@ScriptLazPaintGetVersion,ARegister);
  419. ScriptContext.RegisterScriptFunction('TranslateText',@ScriptTranslateText,ARegister);
  420. ScriptContext.RegisterScriptFunction('TranslateGetLanguage',@ScriptTranslateGetLanguage,ARegister);
  421. ScriptContext.RegisterScriptFunction('ScriptGetName',@ScriptGetName,ARegister);
  422. end;
  423. function TLazPaintInstance.ScriptFileGetTemporaryName(AVars: TVariableSet): TScriptResult;
  424. var
  425. name: String;
  426. t: file;
  427. begin
  428. if FInRunScript and Assigned(FScriptTempFileNames) then
  429. begin
  430. try
  431. name := GetTempFileName;
  432. assignfile(t, name);
  433. rewrite(t);
  434. closefile(t);
  435. AVars.Strings['Result'] := name;
  436. FScriptTempFileNames.Add(name);
  437. result := srOk;
  438. except
  439. on ex: exception do
  440. begin
  441. ShowError(rsScript, ex.Message);
  442. result := srException;
  443. end;
  444. end;
  445. end else
  446. result := srException;
  447. end;
  448. procedure TLazPaintInstance.Init(AEmbedded: boolean);
  449. begin
  450. Title := 'LazPaint ' + LazPaintCurrentVersion;
  451. FThemeListeners := TListeners.Create;
  452. FCustomImageList := TImageListList.Create;
  453. FTopMostInfo.choosecolorHidden := 0;
  454. FTopMostInfo.layerstackHidden := 0;
  455. FTopMostInfo.toolboxHidden := 0;
  456. FTopMostInfo.imagelistHidden := 0;
  457. FEmbedded:= AEmbedded;
  458. FScriptContext := TScriptContext.Create;
  459. FScriptContext.OnFunctionException:= @OnFunctionException;
  460. FFormToolboxInitialPopup := nil;
  461. FFormToolboxInitialPosition := Point(0,0);
  462. RegisterScripts(True);
  463. InColorFromFChooseColor := false;
  464. FImage := TLazPaintImage.Create(self);
  465. FImage.OnStackChanged:= @OnStackChanged;
  466. FImage.OnException := @OnFunctionException;
  467. FImage.OnActionProgress:=@OnImageActionProgress;
  468. FImage.OnSizeChanged:=@OnSizeChanged;
  469. FToolManager := TToolManager.Create(FImage, self, nil, BlackAndWhite, FScriptContext);
  470. UseConfig(TIniFile.Create(''));
  471. FToolManager.OnPopup := @OnToolPopup;
  472. FToolManager.OnFillChanged:= @ToolFillChanged;
  473. FToolManager.OnQueryColorTarget:=@ToolQueryColorTarget;
  474. FSelectionEditConfig := nil;
  475. FTextureEditConfig := nil;
  476. FImageAction := TImageActions.Create(self);
  477. end;
  478. procedure TLazPaintInstance.FormsNeeded;
  479. begin
  480. if (FMain <> nil) or FInFormsNeeded then exit;
  481. FInFormsNeeded := true;
  482. Application.CreateForm(TFMain, FMain);
  483. FMain.LazPaintInstance := self;
  484. CreateLayerStack;
  485. Application.CreateForm(TFImageList, FImageList);
  486. FImageList.LazPaintInstance := self;
  487. TFChooseColor_CustomDPI := (Config.DefaultIconSize(DoScaleX(16,OriginalDPI))*96+8) div 16;
  488. Application.CreateForm(TFChooseColor, FChooseColor);
  489. FChooseColor.LazPaintInstance := self;
  490. FChooseColor.DarkTheme:= Config.GetDarkTheme;
  491. FChooseColor.OnHide:=@ChooseColorHide;
  492. FInFormsNeeded := false;
  493. end;
  494. procedure TLazPaintInstance.UseConfig(ini: TInifile);
  495. var
  496. c: TBGRAPixel;
  497. begin
  498. FreeAndNil(FConfig);
  499. BlackAndWhite := ini.ReadBool('General','BlackAndWhite',BlackAndWhite);
  500. FConfig := TLazPaintConfig.Create(ini,LazPaintVersionStr);
  501. // make sure default pen color is not fully or almost fully transparent
  502. if FConfig.DefaultToolForeColor.Alpha < 32 then
  503. begin
  504. c := FConfig.DefaultToolForeColor;
  505. c.alpha := 255;
  506. FConfig.SetDefaultToolForeColor(c);
  507. end;
  508. ToolManager.LoadFromConfig;
  509. FGridVisible := Config.DefaultGridVisible;
  510. FDockLayersAndColors:= Config.DefaultDockLayersAndColors;
  511. end;
  512. function TLazPaintInstance.GetConfig: TLazPaintConfig;
  513. begin
  514. result := FConfig;
  515. end;
  516. function TLazPaintInstance.GetImage: TLazPaintImage;
  517. begin
  518. Result:= FImage;
  519. end;
  520. function TLazPaintInstance.GetImageAction: TImageActions;
  521. begin
  522. result := FImageAction;
  523. end;
  524. function TLazPaintInstance.GetToolManager: TToolManager;
  525. begin
  526. Result:= FToolManager;
  527. end;
  528. function TLazPaintInstance.GetUpdateStackOnTimer: boolean;
  529. begin
  530. result := FUpdateStackOnTimer;
  531. end;
  532. procedure TLazPaintInstance.SetUpdateStackOnTimer(AValue: boolean);
  533. begin
  534. FUpdateStackOnTimer := AValue;
  535. end;
  536. procedure TLazPaintInstance.CreateLayerStack;
  537. var
  538. defaultZoom: Single;
  539. begin
  540. if Assigned(FLayerStack) then exit;
  541. TFLayerStack_CustomDPI := (Config.DefaultIconSize(DoScaleX(16,OriginalDPI))*96+8) div 16;
  542. Application.CreateForm(TFLayerStack,FLayerStack);
  543. FLayerStack.OnHide:=@LayerStackHide;
  544. FLayerStack.LazPaintInstance := self;
  545. FLayerStack.DarkTheme:= Config.GetDarkTheme;
  546. defaultZoom := Config.DefaultLayerStackZoom;
  547. if defaultZoom <> EmptySingle then
  548. FLayerStack.ZoomFactor:= defaultZoom;
  549. FLayerStack.AddButton(FMain.LayerRemoveCurrent);
  550. FLayerStack.AddButton(FMain.LayerAddNew);
  551. FLayerStack.AddButton(FMain.LayerFromFile);
  552. FLayerStack.AddButton(FMain.LayerDuplicate);
  553. FLayerStack.AddButton(FMain.LayerMergeOver);
  554. FLayerStack.AddButton(FMain.LayerRasterize);
  555. FLayerStack.AddButton(FMain.LayerMove);
  556. FLayerStack.AddButton(FMain.LayerRotate);
  557. FLayerStack.AddButton(FMain.LayerZoom);
  558. FLayerStack.AddButton(FMain.LayerHorizontalFlip);
  559. FLayerStack.AddButton(FMain.LayerVerticalFlip);
  560. FLayerStack.AddButton(FMain.ToolLayerMapping);
  561. FLayerStack.AddLayerMenu(FMain.LayerDuplicate);
  562. FLayerStack.AddLayerMenu(FMain.LayerRemoveCurrent);
  563. FLayerStack.AddLayerMenu(FMain.LayerRasterize);
  564. FLayerStack.AddLayerMenu(FMain.LayerExport);
  565. end;
  566. procedure TLazPaintInstance.CreateToolBox;
  567. begin
  568. if Assigned(FFormToolbox) or not Assigned(FMain) then exit;
  569. Application.CreateForm(TFToolbox, FFormToolbox);
  570. FFormToolbox.LazPaintInstance := self;
  571. FFormToolbox.DarkTheme := Config.GetDarkTheme;
  572. //needed to attach to the right instance of FMain
  573. FFormToolbox.AddButton(FFormToolbox.Toolbar1, FMain.ToolHand);
  574. FFormToolbox.AddButton(FFormToolbox.Toolbar1, FMain.ToolColorPicker);
  575. FFormToolbox.AddButton(FFormToolbox.Toolbar1, FMain.ToolPen);
  576. FFormToolbox.AddButton(FFormToolbox.Toolbar1, FMain.ToolBrush);
  577. FFormToolbox.AddButton(FFormToolbox.Toolbar1, FMain.ToolEraser);
  578. FFormToolbox.AddButton(FFormToolbox.Toolbar1, FMain.ToolFloodfill);
  579. FFormToolbox.AddButton(FFormToolbox.Toolbar1, FMain.ToolClone);
  580. FFormToolbox.AddButton(FFormToolbox.Toolbar2, FMain.ToolRect);
  581. FFormToolbox.AddButton(FFormToolbox.Toolbar2, FMain.ToolEllipse);
  582. FFormToolbox.AddButton(FFormToolbox.Toolbar2, FMain.ToolPolygon);
  583. FFormToolbox.AddButton(FFormToolbox.Toolbar2, FMain.ToolSpline);
  584. FFormToolbox.AddButton(FFormToolbox.Toolbar2, FMain.ToolGradient);
  585. FFormToolbox.AddButton(FFormToolbox.Toolbar2, FMain.ToolPhong);
  586. FFormToolbox.AddButton(FFormToolbox.Toolbar2, FMain.ToolText);
  587. FFormToolbox.AddButton(FFormToolbox.Toolbar3, FMain.ToolEditShape);
  588. FFormToolbox.AddButton(FFormToolbox.Toolbar3, FMain.ToolDeformation);
  589. FFormToolbox.AddButton(FFormToolbox.Toolbar3, FMain.ToolTextureMapping);
  590. FFormToolbox.AddButton(FFormToolbox.Toolbar3, FMain.EditSelectAll);
  591. FFormToolbox.AddButton(FFormToolbox.Toolbar3, FMain.ToolMoveSelection);
  592. FFormToolbox.AddButton(FFormToolbox.Toolbar3, FMain.ToolRotateSelection);
  593. FFormToolbox.AddButton(FFormToolbox.Toolbar3, FMain.EditDeselect);
  594. FFormToolbox.AddButton(FFormToolbox.Toolbar4, FMain.ToolSelectRect);
  595. FFormToolbox.AddButton(FFormToolbox.Toolbar4, FMain.ToolSelectEllipse);
  596. FFormToolbox.AddButton(FFormToolbox.Toolbar4, FMain.ToolSelectPoly);
  597. FFormToolbox.AddButton(FFormToolbox.Toolbar4, FMain.ToolSelectSpline);
  598. FFormToolbox.AddButton(FFormToolbox.Toolbar4, FMain.ToolSelectPen);
  599. FFormToolbox.AddButton(FFormToolbox.Toolbar4, FMain.ToolMagicWand);
  600. FFormToolbox.AddButton(FFormToolbox.Toolbar4, FMain.ToolHotSpot);
  601. FFormToolbox.SetImages(Icons[Config.DefaultIconSize(DoScaleX(20,OriginalDPI))]);
  602. FFormToolbox.PopupMenu := FFormToolboxInitialPopup;
  603. if FToolBoxPositionDefined then
  604. begin
  605. FFormToolbox.Left := FFormToolboxInitialPosition.X;
  606. FFormToolbox.Top := FFormToolboxInitialPosition.Y;
  607. end;
  608. end;
  609. procedure TLazPaintInstance.SetBlackAndWhite(AValue: boolean);
  610. begin
  611. inherited SetBlackAndWhite(AValue);
  612. if FToolManager <> nil then FToolManager.BlackAndWhite := AValue;
  613. end;
  614. procedure TLazPaintInstance.OnStackChanged(sender: TLazPaintImage;
  615. AScrollIntoView: boolean);
  616. begin
  617. if (FLayerStack <> nil) then
  618. FLayerStack.InvalidateStack(AScrollIntoView);
  619. end;
  620. procedure TLazPaintInstance.OnToolPopup(sender: TToolManager; AMessage: TToolPopupMessage; AKey: Word;
  621. AAlways: boolean);
  622. var messageStr: string;
  623. idx: integer;
  624. begin
  625. if FInCommandLine then exit;
  626. if Assigned(Config) and not AAlways then
  627. begin
  628. idx := ord(AMessage);
  629. if Config.ToolPopupMessageShownCount(idx) < MaxToolPopupShowCount then
  630. Config.SetToolPopupMessageShownCount(idx, Config.ToolPopupMessageShownCount(idx)+1)
  631. else
  632. exit;
  633. end;
  634. messageStr := ToolPopupMessageToStr(AMessage, AKey);
  635. if messageStr <> '' then
  636. MessagePopup(messageStr,4000);
  637. end;
  638. function TLazPaintInstance.GetImageListWindowHeight: integer;
  639. begin
  640. if FImageList <> nil then
  641. result := FImageList.Height
  642. else
  643. result := 0;
  644. end;
  645. function TLazPaintInstance.GetImageListWindowWidth: integer;
  646. begin
  647. if FImageList <> nil then
  648. result := FImageList.Width
  649. else
  650. result := 0;
  651. end;
  652. procedure TLazPaintInstance.SetImageListWindowHeight(AValue: integer);
  653. begin
  654. if FImageList <> nil then
  655. FImageList.Height := AValue;
  656. end;
  657. procedure TLazPaintInstance.SetImageListWindowWidth(AValue: integer);
  658. begin
  659. if FImageList <> nil then
  660. FImageList.Width := AValue;
  661. end;
  662. function TLazPaintInstance.GetLayerWindowHeight: integer;
  663. begin
  664. if FLayerStack <> nil then
  665. result := FLayerStack.Height
  666. else
  667. result := 0;
  668. end;
  669. function TLazPaintInstance.GetLayerWindowWidth: integer;
  670. begin
  671. if FLayerStack <> nil then
  672. result := FLayerStack.Width
  673. else
  674. result := 0;
  675. end;
  676. procedure TLazPaintInstance.SetLayerWindowHeight(AValue: integer);
  677. begin
  678. if FLayerStack <> nil then
  679. begin
  680. FLayerStack.Height := AValue;
  681. FLayerStack.LayerStackControl.Height := AValue;
  682. end;
  683. end;
  684. procedure TLazPaintInstance.SetLayerWindowWidth(AValue: integer);
  685. begin
  686. if FLayerStack <> nil then
  687. begin
  688. FLayerStack.Width := AValue;
  689. FLayerStack.LayerStackControl.Width := AValue;
  690. end;
  691. end;
  692. function TLazPaintInstance.GetMainFormVisible: boolean;
  693. begin
  694. if FMain <> nil then
  695. result := FMain.Visible
  696. else
  697. result := false;
  698. end;
  699. procedure TLazPaintInstance.LayerStackHide(Sender: TObject);
  700. begin
  701. if not DockLayersAndColors then
  702. FLayerControlVisible:= false;
  703. end;
  704. procedure TLazPaintInstance.OnImageActionProgress(ASender: TObject;
  705. AProgressPercent: integer);
  706. begin
  707. ReportActionProgress(AProgressPercent);
  708. end;
  709. function TLazPaintInstance.GetInitialized: boolean;
  710. begin
  711. result := Assigned(FMain) and FMain.Initialized;
  712. end;
  713. function TLazPaintInstance.GetFormCanvasSize: TFCanvasSize;
  714. begin
  715. if FFormCanvasSize = nil then
  716. begin
  717. Application.CreateForm(TFCanvasSize, FFormCanvasSize);
  718. FFormCanvasSize.LazPaintInstance := self;
  719. end;
  720. result := FFormCanvasSize;
  721. end;
  722. function TLazPaintInstance.GetFormAdjustCurves: TFAdjustCurves;
  723. begin
  724. if FFormAdjustCurves = nil then
  725. Application.CreateForm(TFAdjustCurves, FFormAdjustCurves);
  726. result := FFormAdjustCurves;
  727. end;
  728. procedure TLazPaintInstance.ChooseColorHide(Sender: TObject);
  729. begin
  730. if not DockLayersAndColors then
  731. FChooseColorControlVisible:= false;
  732. end;
  733. function TLazPaintInstance.GetFormColorIntensity: TFColorIntensity;
  734. begin
  735. if FFormColorIntensity = nil then
  736. Application.CreateForm(TFColorIntensity, FFormColorIntensity);
  737. result := FFormColorIntensity;
  738. end;
  739. function TLazPaintInstance.GetFormColorize: TFColorize;
  740. begin
  741. if FFormColorize = nil then
  742. Application.CreateForm(TFColorize, FFormColorize);
  743. result := FFormColorize;
  744. end;
  745. function TLazPaintInstance.GetFormCustomBlur: TFCustomBlur;
  746. begin
  747. if FFormCustomBlur = nil then
  748. begin
  749. Application.CreateForm(TFCustomBlur, FFormCustomBlur);
  750. FFormCustomBlur.LazPaintInstance := self;
  751. end;
  752. result := FFormCustomBlur;
  753. end;
  754. function TLazPaintInstance.GetFormShiftColors: TFShiftColors;
  755. begin
  756. if FFormShiftColors = nil then
  757. Application.CreateForm(TFShiftColors, FFormShiftColors);
  758. result := FFormShiftColors;
  759. end;
  760. procedure TLazPaintInstance.PythonScriptCommand(ASender: TObject; ACommand,
  761. AParam: UTF8String; out AResult: UTF8String);
  762. var
  763. params: TVariableSet;
  764. err: TInterpretationErrors;
  765. scriptErr: TScriptResult;
  766. vRes: TScriptVariableReference;
  767. i: Integer;
  768. begin
  769. AResult := 'None';
  770. if Assigned(FScriptContext) then
  771. begin
  772. params := TVariableSet.Create(ACommand);
  773. AParam := trim(AParam);
  774. if length(AParam)>0 then
  775. begin
  776. if AParam[1] = '{' then
  777. begin
  778. delete(AParam,1,1);
  779. if (length(AParam)>0) and (AParam[length(AParam)] = '}') then
  780. delete(AParam, length(AParam), 1);
  781. err := params.LoadFromVariablesAsString(AParam);
  782. if err <> [] then
  783. raise exception.Create('Error in parameter format: '+InterpretationErrorsToStr(err));
  784. end else
  785. raise exception.Create('Error in parameter format: dictionary not found');
  786. end;
  787. try
  788. scriptErr := FScriptContext.CallScriptFunction(params);
  789. if scriptErr = srOk then
  790. begin
  791. vRes := params.GetVariable('Result');
  792. if params.IsReferenceDefined(vRes) then
  793. begin
  794. case vRes.variableType of
  795. svtFloat, svtInteger, svtPoint, svtBoolean: AResult := params.GetString(vRes);
  796. svtString: AResult := ScriptQuote(params.GetString(vRes));
  797. svtPixel: AResult := '"'+BGRAToStr(params.GetPixel(vRes), nil,0,true)+'"';
  798. svtFloatList, svtIntList, svtPointList, svtBoolList, svtStrList: AResult := params.GetString(vRes);
  799. svtPixList: begin
  800. AResult := '[';
  801. for i := 0 to TVariableSet.GetListCount(vRes)-1 do
  802. begin
  803. if i > 0 then AResult += ', ';
  804. AResult += '"'+BGRAToStr(params.GetPixelAt(vRes, i), nil,0,true)+'"'
  805. end;
  806. AResult += ']';
  807. end;
  808. svtSubset: AResult := '{'+params.GetSubset(vRes).VariablesAsString+'}';
  809. end;
  810. end;
  811. end else
  812. raise exception.Create(ScriptResultToStr(scriptErr, ACommand)+' ('+ACommand+')');
  813. finally
  814. params.Free;
  815. end;
  816. end;
  817. end;
  818. function TLazPaintInstance.ScriptShowMessage(AVars: TVariableSet): TScriptResult;
  819. begin
  820. ShowMessage(ExtractFileName(FScriptName), AVars.Strings['Message']);
  821. result := srOk;
  822. end;
  823. function TLazPaintInstance.ScriptInputBox(AVars: TVariableSet): TScriptResult;
  824. var
  825. str: String;
  826. begin
  827. str := AVars.Strings['Default'];
  828. if InputQuery(ExtractFileName(FScriptName), AVars.Strings['Prompt'], str) then
  829. begin
  830. AVars.Strings['Result'] := str;
  831. result := srOk;
  832. end else
  833. result := srCancelledByUser;
  834. end;
  835. procedure TLazPaintInstance.ToolQueryColorTarget(sender: TToolManager;
  836. ATarget: TVectorialFill);
  837. begin
  838. if ATarget = ToolManager.ForeFill then
  839. begin
  840. if ToolManager.ForeFill.FillType = vftGradient then
  841. ChooseColorTarget := ctForeColorStartGrad
  842. else ChooseColorTarget := ctForeColorSolid;
  843. end else
  844. if ATarget = ToolManager.BackFill then
  845. begin
  846. if ToolManager.BackFill.FillType = vftGradient then
  847. ChooseColorTarget := ctBackColorStartGrad
  848. else ChooseColorTarget := ctBackColorSolid;
  849. end else
  850. if ATarget = ToolManager.OutlineFill then
  851. begin
  852. if ToolManager.OutlineFill.FillType = vftGradient then
  853. ChooseColorTarget := ctOutlineColorStartGrad
  854. else ChooseColorTarget := ctOutlineColorSolid;
  855. end;
  856. end;
  857. procedure TLazPaintInstance.OnLayeredBitmapLoadStartHandler(AFilenameUTF8: string);
  858. begin
  859. if FLoadingLayers = nil then FLoadingLayers := TFLoading.Create(nil);
  860. if (AFilenameUTF8 = '<Stream>') and (FLoadingFilename <> '') then AFilenameUTF8 := FLoadingFilename;
  861. if Assigned(FMain) then FMain.UpdatingPopup:= true;
  862. try
  863. FLoadingLayers.ShowMessage(rsOpening+' ' +AFilenameUTF8+'...');
  864. UpdateWindows;
  865. finally
  866. if Assigned(FMain) then FMain.UpdatingPopup:= false;
  867. end;
  868. end;
  869. procedure TLazPaintInstance.OnLayeredBitmapLoadProgressHandler(
  870. APercentage: integer);
  871. begin
  872. if FLoadingLayers <> nil then
  873. begin
  874. if Assigned(FMain) then FMain.UpdatingPopup:= true;
  875. try
  876. FLoadingLayers.ShowMessage(rsLoading+' (' +inttostr(APercentage)+'%)');
  877. UpdateWindows;
  878. finally
  879. if Assigned(FMain) then FMain.UpdatingPopup:= false;
  880. end;
  881. end;
  882. end;
  883. procedure TLazPaintInstance.OnLayeredBitmapLoadedHandler;
  884. begin
  885. if FLoadingLayers <> nil then
  886. begin
  887. if Assigned(FMain) then FMain.UpdatingPopup:= true;
  888. try
  889. FreeAndNil(FLoadingLayers);
  890. UpdateWindows;
  891. finally
  892. if Assigned(FMain) then FMain.UpdatingPopup:= false;
  893. end;
  894. end;
  895. end;
  896. procedure TLazPaintInstance.OnLayeredBitmapSavedHandler();
  897. begin
  898. if FLoadingLayers <> nil then
  899. begin
  900. if Assigned(FMain) then FMain.UpdatingPopup:= true;
  901. try
  902. FreeAndNil(FLoadingLayers);
  903. UpdateWindows;
  904. finally
  905. if Assigned(FMain) then FMain.UpdatingPopup:= false;
  906. end;
  907. end;
  908. end;
  909. procedure TLazPaintInstance.OnLayeredBitmapSaveProgressHandler(
  910. APercentage: integer);
  911. begin
  912. if FLoadingLayers <> nil then
  913. begin
  914. if Assigned(FMain) then FMain.UpdatingPopup:= true;
  915. try
  916. FLoadingLayers.ShowMessage(rsSave+' (' +inttostr(APercentage)+'%)');
  917. UpdateWindows;
  918. finally
  919. if Assigned(FMain) then FMain.UpdatingPopup:= false;
  920. end;
  921. end;
  922. end;
  923. procedure TLazPaintInstance.OnLayeredBitmapSaveStartHandler(
  924. AFilenameUTF8: string);
  925. begin
  926. if FLoadingLayers = nil then FLoadingLayers := TFLoading.Create(nil);
  927. if (AFilenameUTF8 = '<Stream>') and (FSavingFilename <> '') then AFilenameUTF8 := FSavingFilename;
  928. if Assigned(FMain) then FMain.UpdatingPopup:= true;
  929. try
  930. FLoadingLayers.ShowMessage(rsSave+' ' +AFilenameUTF8+'...');
  931. UpdateWindows;
  932. finally
  933. if Assigned(FMain) then FMain.UpdatingPopup:= false;
  934. end;
  935. end;
  936. procedure TLazPaintInstance.OnSizeChanged(Sender: TObject);
  937. begin
  938. if FMain <> nil then FMain.Layout.InvalidatePicture(true);
  939. end;
  940. procedure TLazPaintInstance.PythonBusy(Sender: TObject);
  941. begin
  942. Application.ProcessMessages;
  943. end;
  944. procedure TLazPaintInstance.PythonWarning(Sender: TObject;
  945. AMessage: UTF8String; out AProceed: boolean);
  946. begin
  947. AProceed := QuestionDlg(rsScript, AMessage, mtWarning, [mrOk,rsOkay, mrCancel,rsCancel],'') = mrOK;
  948. end;
  949. function TLazPaintInstance.GetShowSelectionNormal: boolean;
  950. begin
  951. if FMain <> nil then result := fmain.ShowSelectionNormal
  952. else result := true;
  953. end;
  954. procedure TLazPaintInstance.SetShowSelectionNormal(AValue: boolean);
  955. begin
  956. if FMain <> nil then fmain.ShowSelectionNormal:= AValue;
  957. end;
  958. function TLazPaintInstance.GetEmbedded: boolean;
  959. begin
  960. Result:=FEmbedded;
  961. end;
  962. function TLazPaintInstance.GetLayerWindowVisible: boolean;
  963. begin
  964. result := GetToolWindowVisible(FLayerStack, FLayerControlVisible);
  965. end;
  966. procedure TLazPaintInstance.SetLayerWindowVisible(AValue: boolean);
  967. begin
  968. FLayerControlVisible := AValue;
  969. UpdateLayerControlVisibility;
  970. end;
  971. procedure TLazPaintInstance.OnFunctionException(AFunctionName: string;
  972. AException: Exception);
  973. begin
  974. ShowError(AFunctionName,AException.Message);
  975. end;
  976. function TLazPaintInstance.GetMainFormBounds: TRect;
  977. var workarea: TRect;
  978. begin
  979. workarea := rect(Screen.WorkAreaLeft,Screen.WorkAreaTop,
  980. Screen.WorkAreaLeft+Screen.WorkAreaWidth,
  981. Screen.WorkAreaTop+Screen.WorkAreaHeight);
  982. result := workarea;
  983. if Assigned(FMain) then
  984. begin
  985. if not IntersectRect(result, workarea, FMain.BoundsRect) then
  986. result := workarea;
  987. end;
  988. end;
  989. procedure TLazPaintInstance.EditSelectionHandler(var AImage: TBGRABitmap);
  990. begin
  991. if FSelectionEditConfig = nil then
  992. FSelectionEditConfig := TStringStream.Create('[Tool]'+LineEnding+
  993. 'ForeColor=FFFFFFFF'+LineEnding+
  994. 'BackColor=000000FF'+LineEnding+
  995. '[Window]'+LineEnding+
  996. 'LayerWindowVisible=False'+LineEnding+
  997. 'DockLayersAndColors='+BoolToStr(DockLayersAndColors, 'True', 'False')+LineEnding+
  998. '[General]'+LineEnding+
  999. 'DarkTheme='+BoolToStr(DarkTheme, 'True', 'False')+LineEnding);
  1000. EditBitmap(AImage, FSelectionEditConfig, rsEditSelection, @SelectionInstanceOnRun, nil, True);
  1001. end;
  1002. function TLazPaintInstance.GetZoomFactor: single;
  1003. begin
  1004. if Assigned(FMain) and Assigned(FMain.Zoom) then
  1005. Result:=FMain.Zoom.Factor else
  1006. result := inherited GetZoomFactor;
  1007. end;
  1008. procedure TLazPaintInstance.UpdateLayerControlVisibility;
  1009. begin
  1010. if FLayerStack <> nil then
  1011. begin
  1012. if DockLayersAndColors then
  1013. FLayerStack.Visible := false
  1014. else
  1015. begin
  1016. if FLayerStack.Visible and FLayerControlVisible then
  1017. FLayerStack.BringToFront
  1018. else FLayerStack.Visible := FLayerControlVisible;
  1019. end;
  1020. end;
  1021. if FMain <> nil then
  1022. begin
  1023. if (FLayerControlVisible and DockLayersAndColors) and (FLayerStack.LayerStackControl.Parent = FLayerStack) then
  1024. begin
  1025. FLayerStack.LayerStackControl.Parent := nil;
  1026. FLayerStack.LayerStackControl.Align := alNone;
  1027. FLayerStack.LayerStackControl.Width := FLayerStack.ClientWidth;
  1028. FLayerStack.LayerStackControl.Height := FLayerStack.ClientHeight;
  1029. FMain.AddDockedControl(FLayerStack.LayerStackControl);
  1030. end else
  1031. if not (FLayerControlVisible and DockLayersAndColors) and (FLayerStack.LayerStackControl.Parent <> FLayerStack) then
  1032. begin
  1033. FMain.RemoveDockedControl(FLayerStack.LayerStackControl);
  1034. FLayerStack.LayerStackControl.Align := alClient;
  1035. FLayerStack.LayerStackControl.Parent := FLayerStack;
  1036. end;
  1037. end;
  1038. end;
  1039. procedure TLazPaintInstance.UpdateChooseColorControlVisibility;
  1040. begin
  1041. if FChooseColor <> nil then
  1042. begin
  1043. if DockLayersAndColors then
  1044. FChooseColor.Visible := false
  1045. else
  1046. begin
  1047. if FChooseColor.Visible and FChooseColorControlVisible then
  1048. FChooseColor.BringToFront
  1049. else FChooseColor.Visible := FChooseColorControlVisible;
  1050. end;
  1051. end;
  1052. if FMain <> nil then
  1053. begin
  1054. if (FChooseColorControlVisible and DockLayersAndColors) and (FChooseColor.ChooseColorControl.Parent = FChooseColor) then
  1055. begin
  1056. FChooseColor.ChooseColorControl.Parent := nil;
  1057. FChooseColor.ChooseColorControl.Align := alNone;
  1058. FChooseColor.ChooseColorControl.Width := FChooseColor.ClientWidth;
  1059. FChooseColor.ChooseColorControl.Height := FChooseColor.ClientHeight;
  1060. FMain.AddDockedControl(FChooseColor.ChooseColorControl);
  1061. end else
  1062. if not (FChooseColorControlVisible and DockLayersAndColors) and (FChooseColor.ChooseColorControl.Parent <> FChooseColor) then
  1063. begin
  1064. FMain.RemoveDockedControl(FChooseColor.ChooseColorControl);
  1065. FChooseColor.ChooseColorControl.Align := alClient;
  1066. FChooseColor.ChooseColorControl.Parent := FChooseColor;
  1067. end;
  1068. end;
  1069. end;
  1070. function TLazPaintInstance.GetGridVisible: boolean;
  1071. begin
  1072. Result:= FGridVisible;
  1073. end;
  1074. procedure TLazPaintInstance.SetGridVisible(const AValue: boolean);
  1075. begin
  1076. FGridVisible := AValue;
  1077. Image.RenderMayChange(rect(0,0,Image.Width,Image.Height),True);
  1078. end;
  1079. function TLazPaintInstance.GetChooseColorVisible: boolean;
  1080. begin
  1081. result := GetToolWindowVisible(FChooseColor, FChooseColorControlVisible);
  1082. end;
  1083. function TLazPaintInstance.GetToolboxVisible: boolean;
  1084. begin
  1085. Result:= GetToolWindowVisible(FFormToolbox) or
  1086. ((FMain <> nil) and not (FMain.Layout.ToolBoxDocking in [twNone,twWindow]));
  1087. end;
  1088. function TLazPaintInstance.GetImageListWindowVisible: boolean;
  1089. begin
  1090. result := GetToolWindowVisible(FImageList);
  1091. end;
  1092. procedure TLazPaintInstance.SetChooseColorVisible(const AValue: boolean);
  1093. begin
  1094. FChooseColorControlVisible:= AValue;
  1095. UpdateChooseColorControlVisibility;
  1096. end;
  1097. procedure TLazPaintInstance.SetToolBoxVisible(const AValue: boolean);
  1098. var winVisible: boolean;
  1099. begin
  1100. if FInSetToolboxVisible then exit;
  1101. FInSetToolboxVisible := true;
  1102. if Assigned(FMain) then
  1103. begin
  1104. FMain.Layout.ToolBoxVisible := AValue;
  1105. winVisible := (FMain.Layout.ToolBoxDocking = twWindow);
  1106. end else
  1107. winVisible := AValue;
  1108. if winVisible and not Assigned(FFormToolbox) then CreateToolBox;
  1109. if Assigned(FFormToolbox) then FFormToolbox.Visible := winVisible;
  1110. FInSetToolboxVisible := false;
  1111. end;
  1112. procedure TLazPaintInstance.SetImageListWindowVisible(const AValue: boolean);
  1113. begin
  1114. if FImageList <> nil then
  1115. FImageList.Visible := AValue;
  1116. end;
  1117. function TLazPaintInstance.GetChooseColorHeight: integer;
  1118. begin
  1119. Result:= FChooseColor.Height;
  1120. end;
  1121. function TLazPaintInstance.GetChooseColorWidth: integer;
  1122. begin
  1123. Result:= FChooseColor.Width;
  1124. end;
  1125. procedure TLazPaintInstance.SetChooseColorHeight(AValue: integer);
  1126. begin
  1127. if FChooseColor <> nil then
  1128. begin
  1129. FChooseColor.Height := AValue;
  1130. FChooseColor.ChooseColorControl.Height := AValue;
  1131. end;
  1132. end;
  1133. procedure TLazPaintInstance.SetChooseColorWidth(AValue: integer);
  1134. begin
  1135. if FChooseColor <> nil then
  1136. begin
  1137. FChooseColor.Width := AValue;
  1138. FChooseColor.ChooseColorControl.Width := AValue;
  1139. end;
  1140. end;
  1141. procedure TLazPaintInstance.AssignBitmap(bmp: TBGRABitmap);
  1142. begin
  1143. if Assigned(FImageAction) then
  1144. FImageAction.SetCurrentBitmap(bmp.Duplicate, False);
  1145. end;
  1146. procedure TLazPaintInstance.AssignBitmap(bmp: TBGRALayeredBitmap);
  1147. begin
  1148. if Assigned(FImageAction) then
  1149. FImageAction.SetCurrentBitmap(bmp.Duplicate, False);
  1150. end;
  1151. function TLazPaintInstance.InternalEditBitmap(var bmp: TObject;
  1152. ConfigStream: TStream; ATitle: String; AOnRun: TLazPaintInstanceEvent;
  1153. AOnExit: TLazPaintInstanceEvent; ABlackAndWhite: boolean): boolean;
  1154. var
  1155. subLaz: TLazPaintInstance;
  1156. ini : TIniFile;
  1157. topmostInfo: TTopMostInfo;
  1158. embeddedImageToBeFreed: boolean;
  1159. begin
  1160. result := false;
  1161. try
  1162. subLaz := TLazPaintInstance.Create(True);
  1163. except
  1164. on ex:Exception do
  1165. begin
  1166. ShowError('EditBitmap',ex.Message);
  1167. exit;
  1168. end;
  1169. end;
  1170. subLaz.BlackAndWhite := ABlackAndWhite;
  1171. if ATitle <> '' then subLaz.Title := ATitle;
  1172. if FMain <> nil then FMain.Enabled := false;
  1173. topmostInfo:= HideTopmost;
  1174. embeddedImageToBeFreed := false;
  1175. try
  1176. if ConfigStream <> nil then
  1177. begin
  1178. ConfigStream.Position := 0;
  1179. ini := TInifile.Create(ConfigStream);
  1180. ini.CacheUpdates := True;
  1181. subLaz.UseConfig(ini);
  1182. end;
  1183. subLaz.FormsNeeded;
  1184. if bmp <> nil then
  1185. begin
  1186. if bmp is TBGRABitmap then
  1187. begin
  1188. subLaz.AssignBitmap(TBGRABitmap(bmp));
  1189. subLaz.EmbeddedImageBackup := TBGRABitmap(bmp);
  1190. end else
  1191. if bmp is TBGRALayeredBitmap then
  1192. begin
  1193. subLaz.AssignBitmap(TBGRALayeredBitmap(bmp));
  1194. subLaz.EmbeddedImageBackup := TBGRALayeredBitmap(bmp).ComputeFlatImage;
  1195. embeddedImageToBeFreed := true;
  1196. end;
  1197. end;
  1198. subLaz.FMain.BorderIcons := subLaz.FMain.BorderIcons - [biMinimize];
  1199. if AOnRun <> nil then
  1200. AOnRun(subLaz);
  1201. subLaz.Run;
  1202. if AOnExit <> nil then
  1203. AOnExit(subLaz);
  1204. if subLaz.EmbeddedResult = mrOk then
  1205. begin
  1206. if bmp is TBGRALayeredBitmap then
  1207. begin
  1208. FreeAndNil(bmp);
  1209. bmp := subLaz.Image.CurrentState.GetLayeredBitmapCopy;
  1210. end
  1211. else if bmp is TBGRABitmap then
  1212. begin
  1213. FreeAndNil(bmp);
  1214. bmp := subLaz.Image.RenderedImage.Duplicate;
  1215. end;
  1216. result := true;
  1217. end;
  1218. if ConfigStream <> nil then
  1219. begin
  1220. ConfigStream.Position := 0;
  1221. ConfigStream.Size := 0;
  1222. end;
  1223. except
  1224. on ex:Exception do
  1225. ShowError('EditBitmap',ex.Message);
  1226. end;
  1227. ShowTopmost(topmostInfo);
  1228. if FMain <> nil then
  1229. begin
  1230. FMain.Enabled := true;
  1231. FMain.BringToFront;
  1232. end;
  1233. if embeddedImageToBeFreed then
  1234. subLaz.EmbeddedImageBackup.Free
  1235. else subLaz.EmbeddedImageBackup := nil;
  1236. subLaz.Free;
  1237. end;
  1238. function TLazPaintInstance.EditBitmap(var bmp: TBGRABitmap;
  1239. ConfigStream: TStream; ATitle: String; AOnRun: TLazPaintInstanceEvent;
  1240. AOnExit: TLazPaintInstanceEvent; ABlackAndWhite: boolean): boolean;
  1241. var bmpObj: TObject;
  1242. begin
  1243. bmpObj := bmp;
  1244. result := InternalEditBitmap(bmpObj, ConfigStream, ATitle, AOnRun, AOnExit, ABlackAndWhite);
  1245. bmp := bmpObj as TBGRABitmap;
  1246. end;
  1247. function TLazPaintInstance.EditBitmap(var bmp: TBGRALayeredBitmap;
  1248. ConfigStream: TStream; ATitle: String; AOnRun: TLazPaintInstanceEvent;
  1249. AOnExit: TLazPaintInstanceEvent; ABlackAndWhite: boolean): boolean;
  1250. var bmpObj: TObject;
  1251. begin
  1252. bmpObj := bmp;
  1253. result := InternalEditBitmap(bmpObj, ConfigStream, ATitle, AOnRun, AOnExit, ABlackAndWhite);
  1254. bmp := bmpObj as TBGRALayeredBitmap;
  1255. end;
  1256. procedure TLazPaintInstance.EditSelection;
  1257. begin
  1258. try
  1259. TImageActions(ImageAction).EditSelection(@EditSelectionHandler);
  1260. except
  1261. on ex: Exception do
  1262. ShowError('EditSelection',ex.Message);
  1263. end;
  1264. end;
  1265. function TLazPaintInstance.EditTexture(ASource: TBGRABitmap): TBGRABitmap;
  1266. begin
  1267. try
  1268. if FTextureEditConfig = nil then
  1269. FTextureEditConfig := TStringStream.Create('[General]'+LineEnding+
  1270. 'DefaultImageWidth=256'+LineEnding+
  1271. 'DefaultImageHeight=256'+LineEnding);
  1272. result := ASource.Duplicate as TBGRABitmap;
  1273. try
  1274. EditBitmap(result,FTextureEditConfig,rsEditTexture,nil,nil,BlackAndWhite);
  1275. finally
  1276. if result.Equals(ASource) then FreeAndNil(result);
  1277. end;
  1278. except
  1279. on ex: Exception do
  1280. ShowError('EditTexture',ex.Message);
  1281. end;
  1282. end;
  1283. procedure TLazPaintInstance.SelectionInstanceOnRun(AInstance: TLazPaintCustomInstance);
  1284. begin
  1285. AInstance.Config.SetDefaultImageWidth(Image.Width);
  1286. AInstance.Config.SetDefaultImageHeight(Image.Height);
  1287. end;
  1288. procedure TLazPaintInstance.ToolFillChanged(Sender: TObject);
  1289. begin
  1290. ColorToFChooseColor;
  1291. if Assigned(FMain) then FMain.UpdateFillToolbar(false);
  1292. end;
  1293. function TLazPaintInstance.GetIcons(ASize: integer): TImageList;
  1294. function GetUnscaledIcons(ASize: integer): TImageList;
  1295. begin
  1296. if ASize < 24 then
  1297. begin;
  1298. if ASize = 16 then
  1299. begin
  1300. result := TImageList.Create(nil);
  1301. result.Assign(FMain.ImageList16);
  1302. end
  1303. else
  1304. begin
  1305. result := TImageList.Create(nil);
  1306. ScaleImageList(FMain.ImageList16, ASize,ASize, result);
  1307. end;
  1308. end
  1309. else
  1310. begin
  1311. if ASize = 48 then
  1312. begin
  1313. result := TImageList.Create(nil);
  1314. result.Assign(FMain.ImageList48);
  1315. end
  1316. else
  1317. begin
  1318. result := TImageList.Create(nil);
  1319. ScaleImageList(FMain.ImageList48, ASize,ASize, result);
  1320. end;
  1321. end;
  1322. end;
  1323. var
  1324. i: Integer;
  1325. {$IFDEF DARWIN}
  1326. retina, unscaled: TImageList;
  1327. bmpUnscaled, bmpRetina: TBitmap;
  1328. {$ENDIF}
  1329. begin
  1330. if Assigned(FMain) then
  1331. begin
  1332. for i := 0 to FCustomImageList.Count-1 do
  1333. if FCustomImageList[i].Height = ASize then
  1334. exit(FCustomImageList[i]);
  1335. {$IFDEF DARWIN}
  1336. unscaled := GetUnscaledIcons(ASize);
  1337. retina := GetUnscaledIcons(ASize*2);
  1338. bmpUnscaled := TBitmap.Create;
  1339. bmpRetina := TBitmap.Create;
  1340. result := TImageList.Create(nil);
  1341. result.Width := ASize;
  1342. result.Height := ASize;
  1343. result.Scaled := true;
  1344. result.RegisterResolutions([ASize, ASize*2]);
  1345. for i := 0 to unscaled.Count-1 do
  1346. begin
  1347. unscaled.GetBitmap(i, bmpUnscaled);
  1348. retina.GetBitmap(i, bmpRetina);
  1349. result.AddMultipleResolutions([TCustomBitmap(bmpUnscaled), TCustomBitmap(bmpRetina)]);
  1350. end;
  1351. bmpUnscaled.Free;
  1352. bmpRetina.Free;
  1353. unscaled.Free;
  1354. retina.Free;
  1355. {$ELSE}
  1356. if ASize = 16 then
  1357. begin
  1358. result := FMain.ImageList16;
  1359. exit
  1360. end else
  1361. if ASize = 48 then
  1362. begin
  1363. result := FMain.ImageList48;
  1364. exit;
  1365. end else
  1366. result := GetUnscaledIcons(ASize);
  1367. {$ENDIF}
  1368. FCustomImageList.Add(result);
  1369. end else
  1370. result := nil;
  1371. end;
  1372. function TLazPaintInstance.GetToolBoxWindowPopup: TPopupMenu;
  1373. begin
  1374. if Assigned(FFormToolbox) then
  1375. result := FFormToolbox.PopupMenu
  1376. else
  1377. result := FFormToolboxInitialPopup;
  1378. end;
  1379. procedure TLazPaintInstance.SetToolBoxWindowPopup(AValue: TPopupMenu);
  1380. begin
  1381. if Assigned(FFormToolbox) then
  1382. FFormToolbox.PopupMenu := AValue
  1383. else
  1384. FFormToolboxInitialPopup := AValue;
  1385. end;
  1386. function TLazPaintInstance.GetFullscreen: boolean;
  1387. begin
  1388. result := FFullscreen;
  1389. end;
  1390. procedure TLazPaintInstance.SetFullscreen(AValue: boolean);
  1391. begin
  1392. if (AValue = FFullscreen) or not MainFormVisible or (FMain.WindowState = wsMinimized) then exit;
  1393. FFullscreen := AValue;
  1394. if AValue then
  1395. begin
  1396. SaveMainWindowPosition;
  1397. FMain.BorderStyle:= bsNone;
  1398. FMain.WindowState:= wsFullScreen;
  1399. end else
  1400. begin
  1401. FMain.BorderStyle := bsSizeable;
  1402. FMain.WindowState:= wsNormal;
  1403. RestoreMainWindowPosition;
  1404. end;
  1405. end;
  1406. function TLazPaintInstance.GetToolWindowVisible(AWindow: TForm; ADockedVisible: boolean = false): boolean;
  1407. begin
  1408. if Assigned(AWindow) and AWindow.Visible then
  1409. begin
  1410. result := not ((AWindow.FormStyle <> fsStayOnTop) and (AWindow.BorderStyle <> bsDialog) and
  1411. Assigned(FMain) and FMain.Active and
  1412. FMain.BoundsRect.Contains(AWindow.BoundsRect));
  1413. end else
  1414. result := ADockedVisible;
  1415. end;
  1416. function TLazPaintInstance.GetDockLayersAndColors: boolean;
  1417. begin
  1418. result := FDockLayersAndColors;
  1419. end;
  1420. procedure TLazPaintInstance.SetDockLayersAndColors(AValue: boolean);
  1421. begin
  1422. if FDockLayersAndColors= AValue then exit;
  1423. FDockLayersAndColors:= AValue;
  1424. UpdateLayerControlVisibility;
  1425. UpdateChooseColorControlVisibility;
  1426. if Assigned(FMain) and FMain.Visible then FMain.QueryArrange;
  1427. end;
  1428. function TLazPaintInstance.GetScriptContext: TScriptContext;
  1429. begin
  1430. result := FScriptContext;
  1431. end;
  1432. function TLazPaintInstance.ProcessCommandLine: boolean;
  1433. var commands: TStringList;
  1434. error, saved, quitQuery: boolean;
  1435. i: Integer;
  1436. begin
  1437. if paramCount = 0 then
  1438. begin
  1439. result := false;
  1440. exit;
  1441. end;
  1442. FormsNeeded;
  1443. FInCommandLine := true;
  1444. commands := TStringList.Create;
  1445. try
  1446. for i := 1 to paramCount do
  1447. commands.Add(ParamStrUtf8(i));
  1448. ucommandline.ProcessCommands(self, commands, error, saved, quitQuery);
  1449. finally
  1450. commands.free;
  1451. FInCommandLine := false;
  1452. end;
  1453. result := error or saved or quitQuery;
  1454. end;
  1455. function TLazPaintInstance.ProcessCommands(commands: TStringList): boolean;
  1456. var saved, quitQuery: boolean;
  1457. begin
  1458. quitQuery := false;
  1459. if paramCount = 0 then
  1460. begin
  1461. result := true;
  1462. exit;
  1463. end;
  1464. FormsNeeded;
  1465. ucommandline.ProcessCommands(self, commands, result, saved, quitQuery);
  1466. end;
  1467. procedure TLazPaintInstance.ChangeIconSize(size: integer);
  1468. var
  1469. prevSize: Integer;
  1470. begin
  1471. if Config.DefaultIconSize(0)<>size then
  1472. begin
  1473. prevSize := Config.DefaultIconSize(0);
  1474. Config.SetDefaultIconSize(size);
  1475. if not Restart then
  1476. Config.SetDefaultIconSize(prevSize);
  1477. end;
  1478. end;
  1479. procedure TLazPaintInstance.Show;
  1480. begin
  1481. EmbeddedResult := mrNone;
  1482. FormsNeeded;
  1483. FMain.Show;
  1484. end;
  1485. function TLazPaintInstance.Hide: boolean;
  1486. begin
  1487. if MainFormVisible then
  1488. begin
  1489. FMain.Hide;
  1490. result := true;
  1491. end
  1492. else result := false;
  1493. end;
  1494. procedure TLazPaintInstance.Run;
  1495. begin
  1496. if not MainFormVisible then Show;
  1497. repeat
  1498. Application.ProcessMessages;
  1499. if not Application.Terminated then Application.Idle(True);
  1500. until not MainFormVisible or Application.Terminated;
  1501. end;
  1502. function TLazPaintInstance.Restart: boolean;
  1503. begin
  1504. if FMain <> nil then
  1505. begin
  1506. FRestartQuery := true;
  1507. FMain.Close;
  1508. result := FRestartQuery;
  1509. end else
  1510. result := true;
  1511. end;
  1512. procedure TLazPaintInstance.CancelRestart;
  1513. begin
  1514. FRestartQuery := false;
  1515. end;
  1516. destructor TLazPaintInstance.Destroy;
  1517. begin
  1518. FreeAndNil(FImageAction);
  1519. RegisterScripts(False);
  1520. FDestroying := true;
  1521. Config.SetDefaultDockLayersAndColors(FDockLayersAndColors);
  1522. Config.SetDefaultGridVisible(FGridVisible);
  1523. if (FChooseColor <> nil) and FChooseColorPositionDefined then
  1524. begin
  1525. Config.SetDefaultColorWindowVisible(ChooseColorVisible or (FTopMostInfo.choosecolorHidden > 0));
  1526. Config.SetDefaultColorWindowPosition(FChooseColor.BoundsRect);
  1527. end;
  1528. if (FLayerStack <> nil) and FLayerStackPositionDefined then
  1529. begin
  1530. Config.SetDefaultLayerWindowVisible(LayerWindowVisible or (FTopMostInfo.layerstackHidden > 0));
  1531. Config.SetDefaultLayerWindowPosition(FLayerStack.BoundsRect);
  1532. Config.SetDefaultLayerStackZoom(FLayerStack.ZoomFactor);
  1533. end;
  1534. if (FImageList <> nil) and FImageListPositionDefined then
  1535. begin
  1536. Config.SetDefaultImagelistWindowVisible (ImageListWindowVisible or (FTopMostInfo.imagelistHidden > 0));
  1537. Config.SetDefaultImagelistWindowPosition(FImageList.BoundsRect);
  1538. end;
  1539. if (FFormToolbox <> nil) and FToolBoxPositionDefined then
  1540. begin
  1541. Config.SetDefaultToolboxWindowVisible(ToolboxVisible or (FTopMostInfo.toolboxHidden > 0));
  1542. Config.SetDefaultToolboxWindowPosition(FFormToolbox.BoundsRect);
  1543. end else
  1544. if Assigned(FMain) then
  1545. Config.SetDefaultToolboxWindowVisible(FMain.Layout.ToolBoxVisible);
  1546. ToolManager.SaveToConfig;
  1547. BGRALayers.UnregisterLoadingHandler(@OnLayeredBitmapLoadStartHandler,@OnLayeredBitmapLoadProgressHandler,@OnLayeredBitmapLoadedHandler);
  1548. BGRALayers.UnregisterLoadingHandler(@OnLayeredBitmapSaveStartHandler,@OnLayeredBitmapSaveProgressHandler,@OnLayeredBitmapSavedHandler);
  1549. if FLoadingLayers <> nil then FreeAndNil(FLoadingLayers);
  1550. FreeAndNil(FLayerStack);
  1551. FreeAndNil(FFormCustomBlur);
  1552. FreeAndNil(FFormColorize);
  1553. FreeAndNil(FFormAdjustCurves);
  1554. FreeAndNil(FFormShiftColors);
  1555. FreeAndNil(FFormColorIntensity);
  1556. FreeAndNil(FFormCanvasSize);
  1557. FreeAndNil(FChooseColor);
  1558. FreeAndNil(FFormToolbox);
  1559. FreeAndNil(FToolManager);
  1560. FreeAndNil(FMain);
  1561. FreeAndNil(FImage);
  1562. FreeAndNil(FConfig);
  1563. FreeAndNil(FSelectionEditConfig);
  1564. FreeAndNil(FTextureEditConfig);
  1565. //MessageDlg(FScriptContext.RecordedScript,mtInformation,[mbOk],0);
  1566. FreeAndNil(FScriptContext);
  1567. FreeAndNil(FImageList);
  1568. FreeAndNil(FCustomImageList);
  1569. FreeAndNil(FThemeListeners);
  1570. inherited Destroy;
  1571. end;
  1572. function TLazPaintInstance.HideTopmost: TTopMostInfo;
  1573. begin
  1574. result.defined:= false;
  1575. if FDestroying then exit;
  1576. ExitColorEditor;
  1577. if (FFormToolbox <> nil) and FFormToolbox.Visible then
  1578. begin
  1579. FFormToolbox.Hide;
  1580. result.toolboxHidden := 1;
  1581. end else
  1582. result.toolboxHidden := 0;
  1583. if (FChooseColor <> nil) and FChooseColor.Visible then
  1584. begin
  1585. FChooseColor.Hide;
  1586. result.choosecolorHidden := 1;
  1587. end else
  1588. result.choosecolorHidden := 0;
  1589. if (FLayerStack <> nil) and FLayerStack.Visible then
  1590. begin
  1591. FLayerStack.Hide;
  1592. result.layerstackHidden := 1;
  1593. end else
  1594. result.layerstackHidden := 0;
  1595. if (FImageList <> nil) and FImageList.Visible then
  1596. begin
  1597. FImageList.Hide;
  1598. result.imagelistHidden := 1;
  1599. end else
  1600. result.imagelistHidden := 0;
  1601. Inc(FTopMostInfo.toolboxHidden, result.toolboxHidden);
  1602. Inc(FTopMostInfo.choosecolorHidden, result.choosecolorHidden);
  1603. Inc(FTopMostInfo.layerstackHidden, result.layerstackHidden);
  1604. Inc(FTopMostInfo.imagelistHidden, result.imagelistHidden);
  1605. result.defined:= true;
  1606. end;
  1607. procedure TLazPaintInstance.ShowTopmost(AInfo: TTopMostInfo);
  1608. begin
  1609. if FDestroying or not AInfo.defined then exit;
  1610. if assigned(FImageList) and (AInfo.imagelistHidden > 0) then
  1611. begin
  1612. FImageList.Show;
  1613. dec(FTopMostInfo.imagelistHidden);
  1614. end;
  1615. if Assigned(FLayerStack) and (AInfo.layerstackHidden > 0) then
  1616. begin
  1617. FLayerStack.Show;
  1618. FLayerStack.BringToFront;
  1619. FLayerStack.InvalidateStack(False);
  1620. dec(FTopMostInfo.layerstackHidden);
  1621. end;
  1622. if Assigned(FChooseColor) and (AInfo.choosecolorHidden > 0) then
  1623. begin
  1624. FChooseColor.Show;
  1625. FChooseColor.BringToFront;
  1626. dec(FTopMostInfo.choosecolorHidden);
  1627. end;
  1628. if Assigned(FFormToolbox) and (AInfo.toolboxHidden > 0) then
  1629. begin
  1630. FFormToolbox.Show;
  1631. FFormToolbox.BringToFront;
  1632. dec(FTopMostInfo.toolboxHidden);
  1633. end;
  1634. end;
  1635. procedure TLazPaintInstance.UpdateWindows;
  1636. begin
  1637. if Assigned(FMain) then FMain.Enabled:= false;
  1638. if Assigned(FFormToolbox) then FFormToolbox.Enabled:= false;
  1639. if Assigned(FChooseColor) then FChooseColor.Enabled:= false;
  1640. if Assigned(FLayerStack) then FLayerStack.Enabled:= false;
  1641. if Assigned(FImageList) then FImageList.Enabled:= false;
  1642. Application.ProcessMessages;
  1643. if Assigned(FMain) then FMain.Enabled:= true;
  1644. if Assigned(FFormToolbox) then FFormToolbox.Enabled:= true;
  1645. if Assigned(FChooseColor) then FChooseColor.Enabled:= true;
  1646. if Assigned(FLayerStack) then FLayerStack.Enabled:= true;
  1647. if Assigned(FImageList) then FImageList.Enabled:= true;
  1648. end;
  1649. procedure TLazPaintInstance.Wait(ACheckActive: TCheckFunction; ADelayMs: integer);
  1650. var
  1651. tmi: TTopMostInfo;
  1652. wasEnabled: Boolean;
  1653. begin
  1654. tmi := HideTopmost;
  1655. if Assigned(FMain) then
  1656. begin
  1657. wasEnabled := FMain.Enabled;
  1658. FMain.Enabled:= false;
  1659. end
  1660. else wasEnabled := false;
  1661. try
  1662. repeat
  1663. Application.ProcessMessages;
  1664. sleep(ADelayMs);
  1665. until not ACheckActive();
  1666. finally
  1667. if Assigned(FMain) then
  1668. FMain.Enabled := wasEnabled;
  1669. ShowTopmost(tmi);
  1670. end;
  1671. end;
  1672. procedure TLazPaintInstance.NotifyImageChange(RepaintNow: boolean; ARect: TRect);
  1673. begin
  1674. FormsNeeded;
  1675. Image.ImageMayChange(ARect);
  1676. Image.OnImageChanged.NotifyObservers;
  1677. If RepaintNow then FMain.Update;
  1678. end;
  1679. procedure TLazPaintInstance.NotifyImageChangeCompletely(RepaintNow: boolean);
  1680. begin
  1681. FormsNeeded;
  1682. Image.ImageMayChangeCompletely;
  1683. If RepaintNow then FMain.Update;
  1684. end;
  1685. procedure TLazPaintInstance.NotifyImagePaint;
  1686. begin
  1687. if Assigned(FMain) then
  1688. FMain.NotifyImagePaint;
  1689. end;
  1690. function TLazPaintInstance.TryOpenFileUTF8(filename: string; skipDialogIfSingleImage: boolean): boolean;
  1691. begin
  1692. FormsNeeded;
  1693. result := FMain.TryOpenFileUTF8(filename, true, nil, skipDialogIfSingleImage);
  1694. end;
  1695. function TLazPaintInstance.ExecuteFilter(filter: TPictureFilter;
  1696. skipDialog: boolean): TScriptResult;
  1697. var vars: TVariableSet;
  1698. begin
  1699. if filter = pfNone then
  1700. begin
  1701. result := srInvalidParameters;
  1702. exit;
  1703. end;
  1704. vars := TVariableSet.Create('Filter');
  1705. vars.AddString('Name',PictureFilterStr[filter]);
  1706. Result:= UFilters.ExecuteFilter(self, filter, vars, skipDialog);
  1707. vars.Free;
  1708. end;
  1709. function TLazPaintInstance.RunScript(AFilename: string; ACaption: string): boolean;
  1710. var
  1711. p: TPythonScript;
  1712. fError: TForm;
  1713. memo: TMemo;
  1714. doFound, somethingDone: boolean;
  1715. tmi: TTopMostInfo;
  1716. i: Integer;
  1717. begin
  1718. if FInRunScript then exit;
  1719. p := nil;
  1720. if ToolManager.TextShadow then
  1721. begin
  1722. //text shadow will be replaced in the future so do not allow it
  1723. if ToolManager.ToolProvideCommand(tcFinish) then
  1724. ToolManager.ToolCommand(tcFinish);
  1725. ToolManager.TextShadow := false;
  1726. end;
  1727. tmi := HideTopmost;
  1728. if Assigned(FMain) then FMain.Enabled:= false;
  1729. FInRunScript := true;
  1730. try
  1731. FScriptTempFileNames := TStringList.Create;
  1732. p := TPythonScript.Create;
  1733. p.CheckScriptSecure:= Config.DefaultCheckScriptsSecure;
  1734. if Trim(ACaption).Length > 0 then
  1735. FScriptName:= Trim(ACaption)
  1736. else FScriptName := AFilename;
  1737. p.OnCommand:=@PythonScriptCommand;
  1738. p.OnBusy := @PythonBusy;
  1739. p.OnWarning:= @PythonWarning;
  1740. if not p.Run(AFilename) and (p.ErrorText<>'') then
  1741. begin
  1742. fError := TForm.Create(nil);
  1743. try
  1744. fError.Caption := ChangeFileExt(ExtractFileName(AFilename),'');
  1745. fError.Position:= poDesktopCenter;
  1746. fError.Width := Screen.Width*3 div 4;
  1747. fError.Height := Screen.Height*3 div 4;
  1748. memo := TMemo.Create(fError);
  1749. memo.Align:= alClient;
  1750. memo.Parent := fError;
  1751. memo.ScrollBars := ssVertical;
  1752. memo.Font.Name:= 'monospace';
  1753. memo.Text := p.ErrorText;
  1754. fError.ShowModal;
  1755. finally
  1756. fError.Free;
  1757. end;
  1758. result := false;
  1759. end else
  1760. result := true;
  1761. except
  1762. on ex:exception do
  1763. begin
  1764. ShowError(ChangeFileExt(ExtractFileName(AFilename),''), ex.Message);
  1765. result := false;
  1766. end;
  1767. end;
  1768. FInRunScript := false;
  1769. FScriptName := '';
  1770. try
  1771. for i := 0 to FScriptTempFileNames.Count-1 do
  1772. if FileExistsUTF8(FScriptTempFileNames[i]) then
  1773. DeleteFileUTF8(FScriptTempFileNames[i]);
  1774. except
  1775. on ex:exception do
  1776. begin
  1777. ShowError(ChangeFileExt(ExtractFileName(AFilename),''), ex.Message);
  1778. result := false;
  1779. end;
  1780. end;
  1781. FScriptTempFileNames.Free;
  1782. p.Free;
  1783. if Assigned(FMain) then FMain.Enabled:= true;
  1784. ShowTopmost(tmi);
  1785. //ensure we are out of any do group
  1786. repeat
  1787. Image.DoEnd(doFound, somethingDone);
  1788. until not doFound;
  1789. end;
  1790. procedure TLazPaintInstance.AdjustChooseColorHeight;
  1791. begin
  1792. if Assigned(FChooseColor) then
  1793. FChooseColor.AdjustControlHeight;
  1794. end;
  1795. procedure TLazPaintInstance.ColorFromFChooseColor;
  1796. begin
  1797. FormsNeeded;
  1798. if InColorFromFChooseColor then exit;
  1799. InColorFromFChooseColor := True;
  1800. SetColor(FChooseColor.ColorTarget, FChooseColor.GetCurrentColor);
  1801. InColorFromFChooseColor := false;
  1802. end;
  1803. procedure TLazPaintInstance.ColorToFChooseColor;
  1804. var
  1805. c: TBGRAPixel;
  1806. begin
  1807. if not Assigned(FChooseColor) or InColorFromFChooseColor then exit;
  1808. c := GetColor(FChooseColor.ColorTarget);
  1809. if (c.alpha = 0) and (FChooseColor.ColorTarget in [ctForeColorSolid, ctBackColorSolid, ctOutlineColorSolid]) then
  1810. begin
  1811. c := FChooseColor.GetCurrentColor;
  1812. c.alpha := 0;
  1813. end;
  1814. FChooseColor.SetCurrentColor(c);
  1815. end;
  1816. procedure TLazPaintInstance.ExitColorEditor;
  1817. begin
  1818. if Assigned(FChooseColor) then FChooseColor.HideEditor;
  1819. end;
  1820. function TLazPaintInstance.ColorEditorActive: boolean;
  1821. begin
  1822. if Assigned(FChooseColor) then
  1823. result := FChooseColor.EditorVisible
  1824. else result := false;
  1825. end;
  1826. procedure TLazPaintInstance.NotifyColorBinding;
  1827. begin
  1828. if Assigned(FChooseColor) then FChooseColor.SimpleRedraw;
  1829. end;
  1830. function TLazPaintInstance.ShowSaveOptionDlg(AParameters: TVariableSet;
  1831. AOutputFilenameUTF8: string; ASkipOptions: boolean; AExport: boolean): boolean;
  1832. begin
  1833. result := USaveOption.ShowSaveOptionDialog(self, AOutputFilenameUTF8, ASkipOptions, AExport);
  1834. end;
  1835. procedure TLazPaintInstance.MoveToolboxTo(X, Y: integer);
  1836. begin
  1837. if Assigned(FFormToolbox) then
  1838. begin
  1839. FFormToolbox.Left := X;
  1840. FFormToolbox.Top := Y;
  1841. end else
  1842. FFormToolboxInitialPosition := Point(X, Y);
  1843. FToolBoxPositionDefined := true;
  1844. end;
  1845. procedure TLazPaintInstance.MoveChooseColorTo(X, Y: integer);
  1846. begin
  1847. FormsNeeded;
  1848. FChooseColor.Left := X;
  1849. FChooseColor.Top := Y;
  1850. FChooseColorPositionDefined := true;
  1851. end;
  1852. procedure TLazPaintInstance.MoveLayerWindowTo(X, Y: integer);
  1853. begin
  1854. if FLayerStack <> nil then
  1855. begin
  1856. FLayerStack.Left := X;
  1857. FLayerStack.Top := Y;
  1858. if IsRectEmpty(Config.DefaultLayerWindowPosition) then
  1859. Config.SetDefaultLayerWindowPosition(FLayerStack.BoundsRect);
  1860. end;
  1861. FLayerStackPositionDefined := true;
  1862. end;
  1863. procedure TLazPaintInstance.MoveImageListWindowTo(X, Y: integer);
  1864. begin
  1865. FormsNeeded;
  1866. FImageList.Left := X;
  1867. FImageList.Top := Y;
  1868. FImageListPositionDefined := true;
  1869. end;
  1870. procedure TLazPaintInstance.ImageListWindowVisibleKeyDown(var Key: Word;
  1871. Shift: TShiftState);
  1872. begin
  1873. if FImageList <> nil then
  1874. FImageList.FormKeyDown(nil,Key,Shift);
  1875. end;
  1876. procedure TLazPaintInstance.ShowAboutDlg;
  1877. var tmi: TTopMostInfo;
  1878. begin
  1879. tmi := HideTopmost;
  1880. uabout.ShowAboutDlg(self);
  1881. ShowTopmost(tmi);
  1882. end;
  1883. procedure TLazPaintInstance.NotifyStackChange;
  1884. begin
  1885. OnStackChanged(image,False);
  1886. end;
  1887. procedure TLazPaintInstance.ScrollLayerStackOnItem(AIndex: integer; ADelayedUpdate: boolean);
  1888. begin
  1889. if FLayerStack<> nil then
  1890. begin
  1891. if not Assigned(FMain) then ADelayedUpdate:= false;
  1892. FLayerStack.ScrollToItem(AIndex, not ADelayedUpdate);
  1893. if ADelayedUpdate then UpdateStackOnTimer := true;
  1894. end;
  1895. end;
  1896. procedure TLazPaintInstance.InvalidateLayerStack;
  1897. begin
  1898. if FLayerStack<> nil then
  1899. FLayerStack.InvalidateStack(false);
  1900. end;
  1901. procedure TLazPaintInstance.UpdateLayerStackOnTimer;
  1902. begin
  1903. UpdateStackOnTimer := true;
  1904. end;
  1905. function TLazPaintInstance.MakeNewBitmapReplacement(AWidth, AHeight: integer; AColor: TBGRAPixel): TBGRABitmap;
  1906. begin
  1907. result := TBGRABitmap.Create(AWidth,AHeight, AColor);
  1908. end;
  1909. procedure TLazPaintInstance.ChooseTool(Tool: TPaintToolType; AAsFromGui: boolean);
  1910. begin
  1911. FormsNeeded;
  1912. if Assigned(FMain) then FMain.ChooseTool(Tool, AAsFromGui);
  1913. end;
  1914. function TLazPaintInstance.GetToolboxHeight: integer;
  1915. begin
  1916. if Assigned(FFormToolbox) then
  1917. Result:= FFormToolbox.Height
  1918. else
  1919. begin
  1920. Result := DoScaleY(99, OriginalDPI);
  1921. if Assigned(FMain) then
  1922. Inc(result, FMain.Height-FMain.ClientHeight);
  1923. end;
  1924. end;
  1925. function TLazPaintInstance.GetToolboxWidth: integer;
  1926. begin
  1927. if Assigned(FFormToolbox) then
  1928. Result:= FFormToolbox.Width else
  1929. begin
  1930. Result := DoScaleX(143, OriginalDPI);
  1931. if Assigned(FMain) then
  1932. Inc(result, FMain.Width-FMain.ClientWidth);
  1933. end;
  1934. end;
  1935. function TLazPaintInstance.GetTopMostHasFocus: boolean;
  1936. begin
  1937. if FDestroying then
  1938. begin
  1939. result := false;
  1940. exit;
  1941. end;
  1942. result := false;
  1943. if (FFormToolbox <> nil) and FFormToolbox.Visible and FFormToolbox.Active then
  1944. result := true;
  1945. if (FChooseColor <> nil) and FChooseColor.Visible and FChooseColor.Active then
  1946. result := true;
  1947. if (FLayerStack <> nil) and FLayerStack.Visible and FLayerStack.Active then
  1948. result := true;
  1949. if (FImageList <> nil) and FImageList.Visible and FImageList.Active then
  1950. result := true;
  1951. end;
  1952. function TLazPaintInstance.GetTopMostVisible: boolean;
  1953. begin
  1954. if FDestroying then
  1955. begin
  1956. result := false;
  1957. exit;
  1958. end;
  1959. FormsNeeded;
  1960. result := (Assigned(FFormToolbox) and FFormToolbox.Visible) or
  1961. (Assigned(FChooseColor) and FChooseColor.Visible) or
  1962. (Assigned(FLayerStack) and FLayerStack.Visible) or
  1963. (Assigned(FImageList) and FImageList.Visible);
  1964. end;
  1965. function TLazPaintInstance.GetTopMostOkToUnfocus: boolean;
  1966. begin
  1967. if FChooseColor.Active and FChooseColor.EditorVisible then
  1968. result := false
  1969. else
  1970. result := true;
  1971. end;
  1972. function TLazPaintInstance.GetChooseColorTarget: TColorTarget;
  1973. begin
  1974. if Assigned(FChooseColor) then
  1975. Result:= FChooseColor.ColorTarget
  1976. else
  1977. result := ctForeColorSolid;
  1978. end;
  1979. procedure TLazPaintInstance.SetChooseColorTarget(const AValue: TColorTarget);
  1980. begin
  1981. if not Assigned(FChooseColor) then exit;
  1982. FChooseColor.ColorTarget:= AValue;
  1983. if Assigned(FMain) then
  1984. begin
  1985. FMain.VectorialFill_Pen.IsTarget := AValue in [ctForeColorSolid..ctForeColorEndGrad];
  1986. FMain.VectorialFill_Back.IsTarget := AValue in [ctBackColorSolid..ctBackColorEndGrad];
  1987. FMain.VectorialFill_Outline.IsTarget := AValue in [ctOutlineColorSolid..ctOutlineColorEndGrad];
  1988. end;
  1989. ColorToFChooseColor;
  1990. end;
  1991. function TLazPaintInstance.OpenImage (FileName: string; AddToRecent: Boolean=True): boolean;
  1992. begin
  1993. FormsNeeded;
  1994. Result:= FMain.TryOpenFileUTF8(FileName, AddToRecent);
  1995. end;
  1996. procedure TLazPaintInstance.AddToImageList(const FileNames: array of String);
  1997. begin
  1998. if FImageList <> nil then
  1999. FImageList.AddFiles (FileNames, true);
  2000. end;
  2001. procedure TLazPaintInstance.UpdateToolbar;
  2002. begin
  2003. if Assigned(FMain) then FMain.UpdateToolbar;
  2004. end;
  2005. procedure TLazPaintInstance.UpdateEditPicture(ADelayed: boolean);
  2006. begin
  2007. if Assigned(FMain) then FMain.UpdateEditPicture(ADelayed);
  2008. end;
  2009. procedure TLazPaintInstance.AddColorToPalette(AColor: TBGRAPixel);
  2010. begin
  2011. if Assigned(FMain) then FMain.Layout.AddColorToPalette(AColor);
  2012. end;
  2013. procedure TLazPaintInstance.RemoveColorFromPalette(AColor: TBGRAPixel);
  2014. begin
  2015. if Assigned(FMain) then FMain.Layout.RemoveColorFromPalette(AColor);
  2016. end;
  2017. function TLazPaintInstance.GetKeyAssociatedToColor(const AColor: TBGRAPixel): string;
  2018. begin
  2019. if Assigned(FMain) and
  2020. Assigned(FMain.Layout) and
  2021. Assigned(FMain.Layout.PaletteToolbar) then Result := FMain.Layout.PaletteToolbar.GetKeyAssociatedToColor(AColor)
  2022. else Result := '';
  2023. end;
  2024. procedure TLazPaintInstance.SendKeyDownEventToMainForm(var Key: Word; Shift: TShiftState);
  2025. begin
  2026. if Assigned(FMain) then FMain.FormKeyDown(FMain, key, Shift);
  2027. end;
  2028. procedure TLazPaintInstance.SendKeyUpEventToMainForm(var Key: Word; Shift: TShiftState);
  2029. begin
  2030. if Assigned(FMain) then FMain.FormKeyUp(FMain, key, Shift);
  2031. end;
  2032. procedure TLazPaintInstance.SendUTF8KeyPressEventToMainForm(var UTF8Key: TUTF8Char);
  2033. begin
  2034. if Assigned(FMain) then FMain.FormUTF8KeyPress(FMain, UTF8Key);
  2035. end;
  2036. end.