1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UImage;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 uses
9   Classes, SysUtils, BGRABitmap, BGRABitmapTypes, types,
10   UImageState, UStateType, Graphics, BGRALayers, UImageObservation, FPWriteBMP,
11   UImageType, UZoom, BGRATransform, BGRALayerOriginal, ULayerAction;
12 
13 const
14   MaxLayersToAdd = 99;
15   MaxImageWidth = 8192;
16   MaxImageHeight = 8192;
17   MaxLayerNameLength = 255;
18   MaxUndoCount = 200;
19   MaxUsedMemoryWithoutCompression = 512*1024*1024;
20 
21 type
22   TLayeredBitmapAndSelection = record
23         layeredBitmap: TBGRALayeredBitmap;
24         selection: TBGRABitmap;
25         selectionLayer: TBGRABitmap;
26       end;
27 
28   TLazPaintImage = class;
29   TOnSelectionMaskChanged = procedure(ASender: TLazPaintImage; const ARect: TRect) of object;
30   TOnCurrentLayerIndexChanged = procedure(ASender: TLazPaintImage) of object;
31   TOnStackChanged = procedure(ASender: TLazPaintImage; AScrollIntoView: boolean) of object;
32   TImageExceptionHandler = procedure(AFunctionName: string; AException: Exception) of object;
33   TOnCurrentFilenameChanged = procedure(ASender: TLazPaintImage) of object;
34 
35   TOnQueryExitToolHandler = procedure(sender: TLazPaintImage) of object;
36 
37   { TLazPaintImage }
38 
39   TLazPaintImage = class
40   private
41     FLazPaintInstance: TObject;
42     FActionInProgress: TCustomLayerAction;
43     FOnActionProgress: TLayeredActionProgressEvent;
44     FOnSelectedLayerIndexChanging: TOnCurrentLayerIndexChanged;
45     FOnSelectionMaskChanged: TOnSelectionMaskChanged;
46     FOnSelectedLayerIndexChanged: TOnCurrentLayerIndexChanged;
47     FOnSizeChanged: TNotifyEvent;
48     FOnStackChanged: TOnStackChanged;
49     FOnQueryExitToolHandler: TOnQueryExitToolHandler;
50     FCurrentState: TImageState;
51     FRenderedImage: TBGRABitmap;
52     FRenderedImageInvalidated: TRect;
53     FOnImageChanged, FOnImageSaving, FOnImageExport: TLazPaintImageObservable;
54     FOnImageRenderChanged: TNotifyEvent;
55     FUndoList: TComposedImageDifference;
56     FUndoPos: integer;
57     FRenderUpdateRectInPicCoord, FRenderUpdateRectInVSCoord: TRect;
58     FOnCurrentFilenameChanged: TOnCurrentFilenameChanged;
59 
60     FSelectionLayerAfterMask: TBGRABitmap;
61     FSelectionLayerAfterMaskOffset: TPoint;
62     FSelectionLayerAfterMaskDefined: boolean;
63     FDraftOriginal: boolean;
64 
65     procedure DiscardSelectionLayerAfterMask;
GetDPInull66     function GetDPI: integer;
GetIsCursornull67     function GetIsCursor: boolean;
GetIsIconCursornull68     function GetIsIconCursor: boolean;
GetIsTiffnull69     function GetIsTiff: boolean;
GetIsGifnull70     function GetIsGif: boolean;
GetLayerBitmapByIdnull71     function GetLayerBitmapById(AId: integer): TBGRABitmap;
GetLayerGuidnull72     function GetLayerGuid(AIndex: integer): TGuid;
GetLayerIdnull73     function GetLayerId(AIndex: integer): integer;
GetLayerOriginalnull74     function GetLayerOriginal(AIndex: integer): TBGRALayerCustomOriginal;
GetLayerOriginalClassnull75     function GetLayerOriginalClass(AIndex: integer): TBGRALayerOriginalAny;
GetLayerOriginalDefinednull76     function GetLayerOriginalDefined(AIndex: integer): boolean;
GetLayerOriginalKnownnull77     function GetLayerOriginalKnown(AIndex: integer): boolean;
GetLayerOriginalMatrixnull78     function GetLayerOriginalMatrix(AIndex: integer): TAffineMatrix;
GetSelectionLayerEmptynull79     function GetSelectionLayerEmpty: boolean;
GetSelectionMaskBoundsnull80     function GetSelectionMaskBounds: TRect;
GetSelectionMaskEmptynull81     function GetSelectionMaskEmpty: boolean;
GetSelectionTransformnull82     function GetSelectionTransform: TAffineMatrix;
83     procedure LayeredActionDone(Sender: TObject);
84     procedure LayeredActionProgress({%H-}ASender: TObject; AProgressPercent: integer);
85     procedure LayeredSizeChanged(Sender: TObject);
86     procedure NeedSelectionLayerAfterMask;
GetBlendOperationnull87     function GetBlendOperation(AIndex: integer): TBlendOperation;
GetCurrentFilenameUTF8null88     function GetCurrentFilenameUTF8: string;
GetCurrentLayerVisiblenull89     function GetCurrentLayerVisible: boolean;
GetCurrentLayerIndexnull90     function GetCurrentLayerIndex:integer;
GetEmptynull91     function GetEmpty: boolean;
GetHeightnull92     function GetHeight: integer;
GetSelectionMasknull93     function GetSelectionMask: TBGRABitmap;
GetSelectedImageLayernull94     function GetSelectedImageLayer: TBGRABitmap;
GetLayerBitmapnull95     function GetLayerBitmap(AIndex: integer): TBGRABitmap;
GetLayerNamenull96     function GetLayerName(AIndex: integer): string;
GetLayerOffsetnull97     function GetLayerOffset(AIndex: integer): TPoint;
GetLayerOpacitynull98     function GetLayerOpacity(AIndex: integer): byte;
GetLayerVisiblenull99     function GetLayerVisible(AIndex: integer): boolean;
GetNbLayersnull100     function GetNbLayers: integer;
GetRenderedImagenull101     function GetRenderedImage: TBGRABitmap;
GetSelectedLayerPixelnull102     function GetSelectedLayerPixel(X, Y: Integer): TBGRAPixel;
GetSelectionLayerBoundsnull103     function GetSelectionLayerBounds: TRect;
GetWidthnull104     function GetWidth: integer;
GetZoomFactornull105     function GetZoomFactor: single;
106     procedure InvalidateImageDifference(ADiff: TCustomImageDifference);
107     procedure OriginalChange({%H-}ASender: TObject;
108       AOriginal: TBGRALayerCustomOriginal; var ADiff: TBGRAOriginalDiff);
109     procedure OriginalEditingChange({%H-}ASender: TObject;
110       {%H-}AOriginal: TBGRALayerCustomOriginal);
111     procedure OriginalLoadError(ASender: TObject; AError: string;
112       var ARaise: boolean);
113     procedure SetBlendOperation(AIndex: integer; AValue: TBlendOperation);
114     procedure SetCurrentFilenameUTF8(AValue: string);
115     procedure LayeredBitmapReplaced;
116     procedure SetDraftOriginal(AValue: boolean);
117     procedure SetLayerName(AIndex: integer; AValue: string);
118     procedure SetLayerOffset(AIndex: integer; AValue: TPoint);
119     procedure SetLayerOpacity(AIndex: integer; AValue: byte);
120     procedure SetLayerOriginalMatrix(AIndex: integer; AValue: TAffineMatrix);
121     procedure SetLayerVisible(AIndex: integer; AValue: boolean);
122     procedure LayerBlendMayChange(AIndex: integer);
GetDrawingLayernull123     function GetDrawingLayer: TBGRABitmap;
124     procedure CompressUndoIfNecessary;
125     procedure NotifyException(AFunctionName: string; AException: Exception);
126     procedure SetOnActionProgress(AValue: TLayeredActionProgressEvent);
127     procedure SetOnSizeChanged(AValue: TNotifyEvent);
128     procedure SetSelectionTransform(ATransform: TAffineMatrix);
129     procedure UpdateIconFileUTF8(AFilename: string; AOutputFilename: string = ''; AExport: boolean = false);
130     procedure UpdateTiffFileUTF8(AFilename: string; AOutputFilename: string = ''; AExport: boolean = false);
131     procedure UpdateGifFileUTF8(AFilename: string; AOutputFilename: string = ''; AExport: boolean = false);
132     procedure ReplaceCurrentSelectionWithoutUndo(const AValue: TBGRABitmap);
133     procedure LayerActionNotifyChange({%H-}ASender: TObject; ALayer: TBGRABitmap; ARect: TRect);
134     procedure LayerActionDestroy(Sender: TObject);
135     procedure LayerActionNotifyUndo({%H-}ASender: TObject; AUndo: TCustomImageDifference; var Owned: boolean);
136   public
137     OnException: TImageExceptionHandler;
138     ImageOffset: TPoint;
139     Zoom: TZoom;
140     CursorHotSpot: TPoint;
141     BPP, FrameIndex, FrameCount: integer;
142     VisibleArea: TRectF;
143 
144     // make copy
MakeLayeredBitmapCopynull145     function MakeLayeredBitmapCopy: TBGRALayeredBitmap;
MakeLayeredBitmapAndSelectionCopynull146     function MakeLayeredBitmapAndSelectionCopy: TLayeredBitmapAndSelection;
MakeBitmapCopynull147     function MakeBitmapCopy(backgroundColor: TColor): TBitmap;
MakeCroppedLayernull148     function MakeCroppedLayer: TBGRABitmap;
149 
150     // undo/redo
151     procedure AddUndo(AUndoAction: TCustomImageDifference);
CanUndonull152     function CanUndo: boolean;
CanRedonull153     function CanRedo: boolean;
154     procedure Undo;
155     procedure Redo;
156     procedure DoBegin;
157     procedure DoEnd(out ADoFound: boolean; out ASomethingDone: boolean);
158     procedure ClearUndo;
159     procedure CompressUndo;
UsedMemorynull160     function UsedMemory: int64;
161 
CreateActionnull162     function CreateAction(AApplyOfsBefore: boolean=false; AApplySelTransformBefore: boolean=false): TLayerAction;
163 
164     // invalidating
165     procedure ImageMayChange(ARect: TRect; ADiscardSelectionLayerAfterMask: boolean = true);
166     procedure ImageMayChangeCompletely;
167     procedure LayerMayChange(ALayer: TBGRABitmap; ARect: TRect);
168     procedure LayerMayChangeCompletely(ALayer: TBGRABitmap);
169     procedure SelectionMaskMayChange(ARect: TRect);
170     procedure SelectionMaskMayChangeCompletely;
171     procedure RenderMayChange(ARect: TRect; APicCoords: boolean = false; ANotify: boolean = true);
172     procedure ResetRenderUpdateRect;
173 
174     // selection mask
SelectionMaskNilnull175     function SelectionMaskNil: boolean;
GetSelectionMaskCenternull176     function GetSelectionMaskCenter: TPointF;
177     procedure SaveSelectionMaskToFileUTF8(AFilename: string);
SelectionMaskReadonlynull178     function SelectionMaskReadonly: TBGRABitmap;
179     procedure ReleaseEmptySelection;
180 
181     // selection layer
SelectionLayerReadonlynull182     function SelectionLayerReadonly: TBGRABitmap;
183 
184     // image layer
SetCurrentLayerByIndexnull185     function SetCurrentLayerByIndex(AValue: integer): boolean;
SelectLayerContainingPixelAtnull186     function SelectLayerContainingPixelAt(APicturePos: TPoint): boolean;
CurrentLayerEmptynull187     function CurrentLayerEmpty: boolean;
CurrentLayerTransparentnull188     function CurrentLayerTransparent: boolean;
CurrentLayerEqualsnull189     function CurrentLayerEquals(AColor: TBGRAPixel): boolean;
190     property CurrentLayerPixel[X,Y: Integer]: TBGRAPixel read GetSelectedLayerPixel;
191     procedure SetLayerOffset(AIndex: integer; AValue: TPoint; APrecomputedLayerBounds: TRect);
CurrentLayerReadOnlynull192     function CurrentLayerReadOnly: TBGRABitmap;
193 
194     procedure SetLayerRegistry(ALayerIndex: integer; AIdentifier: string; AValue: RawByteString);
GetLayerRegistrynull195     function GetLayerRegistry(ALayerIndex: integer; AIdentifier: string): RawByteString;
196     procedure SetRegistry(AIdentifier: string; AValue: RawByteString);
GetRegistrynull197     function GetRegistry(AIdentifier: string): RawByteString;
198 
GetLayerIndexByIdnull199     function GetLayerIndexById(AId: integer): integer;
GetLayerIndexByGuidnull200     function GetLayerIndexByGuid(AGuid: TGuid): integer;
201     procedure AddNewLayer;
202     procedure AddNewLayer(AOriginal: TBGRALayerCustomOriginal; AName: string; ABlendOp: TBlendOperation; AMatrix: TAffineMatrix; AOpacity: byte = 255);
203     procedure AddNewLayer(ALayer: TBGRABitmap; AName: string; ABlendOp: TBlendOperation; AOpacity: byte = 255);
204     procedure AddNewLayer(ALayer: TBGRABitmap; AName: string; AOffset: TPoint; ABlendOp: TBlendOperation; AOpacity: byte = 255);
205     procedure DuplicateLayer;
206     procedure RasterizeLayer;
207     procedure MergeLayerOver;
208     procedure MoveLayer(AFromIndex,AToIndex: integer);
209     procedure RemoveLayer;
210     procedure ClearLayer;
211 
212     procedure HorizontalFlip(ALayerIndex: integer); overload;
213     procedure VerticalFlip(ALayerIndex: integer); overload;
214 
215     // whole image
216     procedure Assign(const AValue: TBGRABitmap; AOwned: boolean; AUndoable: boolean;
217                      ACaption: string = ''; AOpacity: byte = 255); overload;
218     procedure Assign(const AValue: TBGRACustomLayeredBitmap; AOwned: boolean; AUndoable: boolean); overload;
219     procedure Assign(const AValue: TLayeredBitmapAndSelection; AOwned: boolean; AUndoable: boolean); overload;
220 
221     procedure SwapRedBlue;
222     procedure LinearNegativeAll;
223     procedure NegativeAll;
224     procedure HorizontalFlip; overload;
225     procedure VerticalFlip; overload;
226     procedure RotateCW;
227     procedure RotateCCW;
228     procedure Rotate180;
229     procedure Resample(AWidth, AHeight: integer; filter: TResampleFilter);
ApplySmartZoom3null230     function ApplySmartZoom3: boolean;
231 
232     procedure Flatten;
FlatImageEqualsnull233     function FlatImageEquals(ABitmap: TBGRABitmap): boolean;
ComputeFlatImagenull234     function ComputeFlatImage(AFromLayer,AToLayer: integer; ASeparateXorMask: boolean): TBGRABitmap;
235     procedure PrepareForRendering;
236     procedure Draw(ADest: TBGRABitmap; x,y: integer);
237 
238     // input/output
DetectImageFormatnull239     function DetectImageFormat(AFilename: string): TBGRAImageFormat;
240     procedure LoadFromFileUTF8(AFilename: string);
AbleToSaveAsUTF8null241     function AbleToSaveAsUTF8(AFilename: string): boolean;
AbleToSaveSelectionAsUTF8null242     function AbleToSaveSelectionAsUTF8(AFilename: string): boolean;
243     procedure SaveToFileUTF8(AFilename: string; AExport: boolean = false);
244     procedure UpdateMultiImage(AOutputFilename: string = ''; AExport: boolean = false);
245     procedure SetSavedFlag(ASavedBPP: integer = 0;
246                            ASavedFrameIndex: integer = 0;
247                            ASavedFrameCount: integer = 1;
248                            AOpening: boolean = false);
IsFileModifiednull249     function IsFileModified: boolean;
250     procedure SaveOriginalToStream(AStream: TStream);
251 
CheckCurrentLayerVisiblenull252     function CheckCurrentLayerVisible: boolean;
CheckNoActionnull253     function CheckNoAction(ASilent: boolean = false): boolean;
CanDuplicateFramenull254     function CanDuplicateFrame: boolean;
CanHaveFramesnull255     function CanHaveFrames: boolean;
256     procedure ZoomFit;
257 
258     property CurrentState: TImageState read FCurrentState;
259     property currentFilenameUTF8: string read GetCurrentFilenameUTF8 write SetCurrentFilenameUTF8;
260     property CurrentLayerIndex: integer read GetCurrentLayerIndex;
261     property SelectionMask: TBGRABitmap read GetSelectionMask;
262     property RenderedImage: TBGRABitmap read GetRenderedImage;
263     property Width: integer read GetWidth;
264     property Height: integer read GetHeight;
265     property OnSelectionChanged: TOnSelectionMaskChanged read FOnSelectionMaskChanged write FOnSelectionMaskChanged;
266     property OnSelectedLayerIndexChanging: TOnCurrentLayerIndexChanged read FOnSelectedLayerIndexChanging write FOnSelectedLayerIndexChanging;
267     property OnSelectedLayerIndexChanged: TOnCurrentLayerIndexChanged read FOnSelectedLayerIndexChanged write FOnSelectedLayerIndexChanged;
268     property OnStackChanged: TOnStackChanged read FOnStackChanged write FOnStackChanged;
269     property OnImageChanged: TLazPaintImageObservable read FOnImageChanged;
270     property OnImageRenderChanged: TNotifyEvent read FOnImageRenderChanged write FOnImageRenderChanged;
271     property OnImageSaving: TLazPaintImageObservable read FOnImageSaving;
272     property OnImageExport: TLazPaintImageObservable read FOnImageExport;
273     property OnSizeChanged: TNotifyEvent read FOnSizeChanged write SetOnSizeChanged;
274     property OnActionProgress: TLayeredActionProgressEvent read FOnActionProgress write SetOnActionProgress;
275     property NbLayers: integer read GetNbLayers;
276     property Empty: boolean read GetEmpty;
277     property SelectionLayerBounds: TRect read GetSelectionLayerBounds;
278     property SelectionLayerIsEmpty: boolean read GetSelectionLayerEmpty;
279     property SelectionMaskBounds: TRect read GetSelectionMaskBounds;
280     property SelectionMaskEmpty: boolean read GetSelectionMaskEmpty;
281     property LayerName[AIndex: integer]: string read GetLayerName write SetLayerName;
282     property LayerBitmap[AIndex: integer]: TBGRABitmap read GetLayerBitmap;
283     property LayerBitmapById[AIndex: integer]: TBGRABitmap read GetLayerBitmapById;
284     property LayerOriginal[AIndex: integer]: TBGRALayerCustomOriginal read GetLayerOriginal;
285     property LayerOriginalDefined[AIndex: integer]: boolean read GetLayerOriginalDefined;
286     property LayerOriginalKnown[AIndex: integer]: boolean read GetLayerOriginalKnown;
287     property LayerOriginalClass[AIndex: integer]: TBGRALayerOriginalAny read GetLayerOriginalClass;
288     property LayerOriginalMatrix[AIndex: integer]: TAffineMatrix read GetLayerOriginalMatrix write SetLayerOriginalMatrix;
289     property LayerId[AIndex: integer]: integer read GetLayerId;
290     property LayerGuid[AIndex: integer]: TGuid read GetLayerGuid;
291     property LayerVisible[AIndex: integer]: boolean read GetLayerVisible write SetLayerVisible;
292     property LayerOpacity[AIndex: integer]: byte read GetLayerOpacity write SetLayerOpacity;
293     property LayerOffset[AIndex: integer]: TPoint read GetLayerOffset write SetLayerOffset;
294     property BlendOperation[AIndex: integer]: TBlendOperation read GetBlendOperation write SetBlendOperation;
295     property CurrentLayerVisible: boolean read GetCurrentLayerVisible;
296     property OnQueryExitToolHandler: TOnQueryExitToolHandler read FOnQueryExitToolHandler write FOnQueryExitToolHandler;
297     property OnCurrentFilenameChanged: TOnCurrentFilenameChanged read FOnCurrentFilenameChanged write FOnCurrentFilenameChanged;
298     property RenderUpdateRectInPicCoord: TRect read FRenderUpdateRectInPicCoord;
299     property RenderUpdateRectInVSCoord: TRect read FRenderUpdateRectInVSCoord;
300     property SelectionTransform: TAffineMatrix read GetSelectionTransform write SetSelectionTransform;
301     property ZoomFactor: single read GetZoomFactor;
302     property DraftOriginal: boolean read FDraftOriginal write SetDraftOriginal;
303     property IsIconCursor: boolean read GetIsIconCursor;
304     property IsCursor: boolean read GetIsCursor;
305     property IsTiff: boolean read GetIsTiff;
306     property IsGif: boolean read GetIsGif;
307     property DPI: integer read GetDPI;
308     constructor Create(ALazPaintInstance: TObject);
309     destructor Destroy; override;
310   end;
311 
ComputeAcceptableImageSizenull312 function ComputeAcceptableImageSize(AWidth,AHeight: integer): TSize;
313 
314 implementation
315 
316 uses UGraph, UResourceStrings, Dialogs,
317     BGRAOpenRaster, BGRAPhoxo, BGRAPaintNet, UImageDiff, ULoading,
318     BGRAWriteLzp, BGRAUTF8,
319     BGRAPalette, BGRAColorQuantization, UFileSystem,
320     BGRAThumbnail, BGRAIconCursor, UTiff, LazPaintType,
321     BGRALazPaint, BGRAAnimatedGif,
322     BGRAGradientScanner, BGRASVGOriginal, Forms;
323 
ComputeAcceptableImageSizenull324 function ComputeAcceptableImageSize(AWidth, AHeight: integer): TSize;
325 var ratio,newRatio: single;
326 begin
327   ratio := 1;
328   if AWidth > MaxImageWidth then ratio := MaxImageWidth/AWidth;
329   if AHeight > MaxImageHeight then
330   begin
331     newRatio := MaxImageHeight/AHeight;
332     if newRatio < ratio then ratio := newRatio;
333   end;
334   if ratio < 1 then
335   begin
336     result.cx := round(AWidth*ratio);
337     result.cy := round(AHeight*ratio);
338   end else
339   begin
340     result.cx := AWidth;
341     result.cy := AHeight;
342   end;
343 end;
344 
345 { TLazPaintImage }
346 
347 procedure TLazPaintImage.LayerActionNotifyUndo(ASender: TObject; AUndo: TCustomImageDifference;
348   var Owned: boolean);
349 begin
350   AddUndo(AUndo);
351   Owned := true;
352   OnImageChanged.NotifyObservers;
353 end;
354 
MakeCroppedLayernull355 function TLazPaintImage.MakeCroppedLayer: TBGRABitmap;
356 var r: TRect;
357   cropped: TBGRABitmap;
358   ofs: TPoint;
359 begin
360   ofs := Point(0,0);
361   result := DuplicateBitmap(FCurrentState.SelectionLayer);
362   if (result <> nil) and (SelectionMask <> nil) then result.ApplyMask(SelectionMask);
363   if (result <> nil) and result.Empty then FreeAndNil(result);
364   if result = nil then
365   begin
366     ofs := LayerOffset[CurrentLayerIndex];
367     result := DuplicateBitmap(GetSelectedImageLayer);
368     if (result <> nil) and (SelectionMask <> nil) then
369       result.ApplyMask(SelectionMask, rect(0,0,result.Width,result.Height),
370                        Point(ofs.X,ofs.Y));
371   end;
372   if result <> nil then
373   begin
374     if SelectionMask = nil then
375       r := result.GetImageBounds
376     else
377     begin
378       r := SelectionMaskBounds;
379       OffsetRect(r, -ofs.x, -ofs.y);
380     end;
381     if IsRectEmpty(r) then
382       FreeAndNil(result)
383     else
384     begin
385       if (r.left <> 0) or (r.top <> 0) or (r.right <> result.Width) or (r.bottom <> result.Height) then
386       begin
387         cropped := TBGRABitmap.Create(r.Width,r.Height);
388         cropped.PutImage(-r.Left, -r.Top, result, dmSet);
389         BGRAReplace(result, cropped);
390       end;
391     end;
392   end;
393 end;
394 
ApplySmartZoom3null395 function TLazPaintImage.ApplySmartZoom3: boolean;
396 var i, idx: integer;
397   zoomed: TLayeredBitmapAndSelection;
398   ofs: TPoint;
399   withOfs: TBGRABitmap;
400 begin
401   result := false;
402   if not CheckNoAction then exit;
403   try
404     zoomed.layeredBitmap := TBGRALayeredBitmap.Create(Width*3,Height*3);
405     for i := 0 to NbLayers-1 do
406     begin
407       idx := zoomed.layeredBitmap.AddOwnedLayer(FCurrentState.LayerBitmap[i].FilterSmartZoom3(moMediumSmooth) as TBGRABitmap,
408         FCurrentState.BlendOperation[i], FCurrentState.LayerOpacity[i]);
409       ofs := FCurrentState.LayerOffset[i];
410       if (ofs.x <> 0) or (ofs.y <> 0) or (zoomed.layeredBitmap.LayerBitmap[idx].Width <> zoomed.layeredBitmap.Width)
411         or (zoomed.layeredBitmap.LayerBitmap[idx].Height <> zoomed.layeredBitmap.Height) then
412       begin
413         withOfs := TBGRABitmap.Create(zoomed.layeredBitmap.Width, zoomed.layeredBitmap.Height);
414         withOfs.PutImage(ofs.x*3,ofs.y*3, zoomed.layeredBitmap.LayerBitmap[idx], dmSet);
415         zoomed.layeredBitmap.SetLayerBitmap(idx, withOfs, true);
416       end;
417     end;
418     if SelectionMask <> nil then
419       zoomed.selection:= SelectionMask.FilterSmartZoom3(moMediumSmooth) as TBGRABitmap
420     else zoomed.Selection := nil;
421     if FCurrentState.SelectionLayer <> nil then
422       zoomed.selectionLayer := FCurrentState.SelectionLayer.FilterSmartZoom3(moMediumSmooth) as TBGRABitmap
423     else
424       zoomed.selectionLayer := nil;
425     AddUndo(FCurrentState.AssignWithUndo(zoomed.layeredBitmap,true, FCurrentState.SelectedImageLayerIndex, zoomed.selection, zoomed.selectionLayer));
426     result := true;
427   except on ex: exception do NotifyException('ApplySmartZoom3',ex);
428   end;
429   ImageMayChangeCompletely;
430   SelectionMaskMayChangeCompletely;
431 end;
432 
433 procedure TLazPaintImage.Resample(AWidth, AHeight: integer; filter: TResampleFilter);
434 var quality : TResampleMode;
435     backup: TImageState;
436 begin
437   if not CheckNoAction then exit;
438   try
439     backup := FCurrentState.Duplicate as TImageState;
440 
441     if filter = rfBox then
442       quality := rmSimpleStretch
443     else
444       quality := rmFineResample;
445 
446     FCurrentState.Resample(AWidth,AHeight,quality,filter);
447     LayeredBitmapReplaced;
448     AddUndo(FCurrentState.GetUndoAfterAssign(backup));
449     SelectionMaskMayChangeCompletely;
450     backup.Free;
451   except on ex: exception do NotifyException(RemoveTrail(rsResamplingImage),ex);
452   end;
453 end;
454 
TLazPaintImage.DetectImageFormatnull455 function TLazPaintImage.DetectImageFormat(AFilename: string): TBGRAImageFormat;
456 var
457   s: TStream;
458 begin
459   s := FileManager.CreateFileStream(AFilename, fmOpenRead);
460   try
461     result := DetectFileFormat(s, ExtractFileExt(AFilename));
462   finally
463     s.Free;
464   end;
465 end;
466 
AbleToSaveAsUTF8null467 function TLazPaintImage.AbleToSaveAsUTF8(AFilename: string): boolean;
468 var format: TBGRAImageFormat;
469 begin
470   format := SuggestImageFormat(AFilename);
471   result := (DefaultBGRAImageWriter[format] <> nil) or
472     (format in [ifIco,ifCur,ifSvg]);
473   if result and (format = ifXPixMap) then
474   begin
475     if (Width > 256) or (Height > 256) then
476     begin
477       ShowMessage(rsNotReasonableFormat + ' (> 256x256)');
478       result := false;
479     end;
480   end;
481 
482 end;
483 
AbleToSaveSelectionAsUTF8null484 function TLazPaintImage.AbleToSaveSelectionAsUTF8(AFilename: string): boolean;
485 var ext: string;
486 begin
487   ext := UTF8LowerCase(ExtractFileExt(AFilename));
488   if (ext='.bmp') or (ext='.jpg') or (ext='.jpeg')
489     or (ext='.png') or (ext='.pcx') or (ext='.tga') or (ext='.lzp') then
490     result := true else
491       result := false;
492 end;
493 
494 procedure TLazPaintImage.SaveToFileUTF8(AFilename: string; AExport: boolean);
495 var s: TStream;
496   format: TBGRAImageFormat;
497 begin
498   format := SuggestImageFormat(AFilename);
499   if format in[ifOpenRaster,ifPhoxo,ifLazPaint,ifSvg] then
500   begin
501     s := FileManager.CreateFileStream(AFilename, fmCreate);
502     try
503       FCurrentState.SaveToStreamAs(s, format);
504     finally
505       s.Free;
506     end;
507     if not AExport then SetSavedFlag else OnImageExport.NotifyObservers;
508   end else
509   begin
510     if RenderedImage = nil then exit;
511     s := FileManager.CreateFileStream(AFilename, fmCreate);
512     try
513       RenderedImage.SaveToStreamAs(s, SuggestImageFormat(AFilename));
514     finally
515       s.Free;
516     end;
517     if not AExport then
518     begin
519       if NbLayers = 1 then SetSavedFlag
520       else OnImageSaving.NotifyObservers;
521     end
522       else OnImageExport.NotifyObservers;
523   end;
524 end;
525 
526 procedure TLazPaintImage.UpdateMultiImage(AOutputFilename: string; AExport: boolean);
527 begin
528   if not FileManager.FileExists(currentFilenameUTF8) then
529   begin
530     ShowMessage(rsFileNotFound + LineEnding + LineEnding + currentFilenameUTF8);
531     exit;
532   end;
533   if IsIconCursor then
534     UpdateIconFileUTF8(currentFilenameUTF8, AOutputFilename, AExport)
535   else if IsTiff then
536     UpdateTiffFileUTF8(currentFilenameUTF8, AOutputFilename, AExport)
537   else if IsGif then
538     UpdateGifFileUTF8(currentFilenameUTF8, AOutputFilename, AExport)
539   else
540     ShowMessage(rsFileExtensionNotSupported);
541 end;
542 
543 procedure TLazPaintImage.UpdateIconFileUTF8(AFilename: string; AOutputFilename: string; AExport: boolean);
544 var
545   s: TStream;
546   icoCur: TBGRAIconCursor;
547   frame: TBGRABitmap;
548   newFrameIndex: integer;
549 begin
550   if bpp = 0 then
551   begin
552     if RenderedImage.HasTransparentPixels then
553       bpp := 32
554     else
555       bpp := 24;
556   end;
557 
558   if AOutputFilename = '' then AOutputFilename := AFilename;
559 
560   frame := BGRADitherIconCursor(RenderedImage, bpp, daFloydSteinberg) as TBGRABitmap;
561   icoCur := TBGRAIconCursor.Create;
562 
563   try
564     if FileManager.FileExists(AFilename) then
565     begin
566       s := FileManager.CreateFileStream(AFilename,fmOpenRead or fmShareDenyWrite);
567       try
568         icoCur.LoadFromStream(s);
569       finally
570         s.Free;
571       end;
572     end;
573 
574     newFrameIndex := icoCur.Add(frame, bpp, true);
575     icoCur.FileType:= SuggestImageFormat(AOutputFilename);
576 
577     s := FileManager.CreateFileStream(AOutputFilename,fmCreate);
578     try
579       icoCur.SaveToStream(s);
580       if not AExport then
581         SetSavedFlag(bpp, newFrameIndex, icoCur.Count)
582       else OnImageExport.NotifyObservers;
583     finally
584       s.Free;
585     end;
586   finally
587 
588     frame.free;
589     icoCur.Free;
590   end;
591 end;
592 
593 procedure TLazPaintImage.UpdateTiffFileUTF8(AFilename: string;
594   AOutputFilename: string; AExport: boolean);
595 var
596   s, sAdded: TStream;
597   tiff, addedTiff: TTiff;
598   newFrameIndex: integer;
599 begin
600   if AOutputFilename = '' then AOutputFilename := AFilename;
601 
602   tiff := TTiff.Create;
603   addedTiff := TTiff.Create;
604   sAdded := nil;
605   s := nil;
606   try
607     if FileManager.FileExists(AFilename) then
608     begin
609       s := FileManager.CreateFileStream(AFilename,fmOpenRead or fmShareDenyWrite);
610       if tiff.LoadFromStream(s) <> teNone then
611         raise Exception.Create(StringReplace(rsErrorOnOpeningFile,'%1', AFilename, []));
612       FreeAndNil(s);
613     end;
614 
615     sAdded := TMemoryStream.Create;
616     RenderedImage.SaveToStreamAs(sAdded, ifTiff);
617     sAdded.Position:= 0;
618     if addedTiff.LoadFromStream(sAdded) <> teNone then
619       raise Exception.Create(rsInternalError);
620     FreeAndNil(sAdded);
621 
622     if FrameIndex = TImageEntry.NewFrameIndex then
623       newFrameIndex := tiff.Move(addedTiff,0)
624     else
625     begin
626       newFrameIndex := FrameIndex;
627       if newFrameIndex >= tiff.Count then
628         newFrameIndex := tiff.Count
629       else
630         tiff.Delete(newFrameIndex);
631       tiff.Move(addedTiff,0,newFrameIndex);
632     end;
633 
634     s := FileManager.CreateFileStream(AOutputFilename,fmCreate);
635     try
636       tiff.SaveToStream(s);
637       if not AExport then
638         SetSavedFlag(bpp, newFrameIndex, tiff.Count)
639       else OnImageExport.NotifyObservers;
640     finally
641       FreeAndNil(s);
642     end;
643   finally
644 
645     addedTiff.Free;
646     sAdded.Free;
647     tiff.Free;
648     s.Free;
649   end;
650 
651 end;
652 
653 procedure TLazPaintImage.UpdateGifFileUTF8(AFilename: string;
654   AOutputFilename: string; AExport: boolean);
655 var
656   s: TStream;
657   gif: TBGRAAnimatedGif;
658   newFrameIndex: integer;
659 begin
660   if AOutputFilename = '' then AOutputFilename := AFilename;
661 
662   gif := TBGRAAnimatedGif.Create;
663   s := nil;
664   try
665     if FileManager.FileExists(AFilename) then
666     begin
667       s := FileManager.CreateFileStream(AFilename,fmOpenRead or fmShareDenyWrite);
668       gif.LoadFromStream(s);
669       FreeAndNil(s);
670     end;
671 
672     if FrameIndex = TImageEntry.NewFrameIndex then
673       newFrameIndex := gif.AddFullFrame(RenderedImage, gif.AverageDelayMs)
674     else
675     begin
676       newFrameIndex := FrameIndex;
677       gif.ReplaceFullFrame(newFrameIndex, RenderedImage, gif.FrameDelayMs[newFrameIndex]);
678     end;
679 
680     s := FileManager.CreateFileStream(AOutputFilename,fmCreate);
681     try
682       gif.SaveToStream(s);
683       if not AExport then
684         SetSavedFlag(bpp, newFrameIndex, gif.Count)
685       else OnImageExport.NotifyObservers;
686     finally
687       FreeAndNil(s);
688     end;
689   finally
690 
691     gif.Free;
692     s.Free;
693   end;
694 
695 end;
696 
697 procedure TLazPaintImage.LoadFromFileUTF8(AFilename: string);
698 var s: TStream;
699   ext: string;
700   bmp: TBGRABitmap;
701   layeredBmp: TBGRACustomLayeredBitmap;
702   temp: TBGRALayeredBitmap;
703   selIndex: Integer;
704 begin
705   if not CheckNoAction then exit;
706 
707   ext := UTF8LowerCase(ExtractFileExt(AFilename));
708   bmp := nil;
709   s := nil;
710   try
711     s := FileManager.CreateFileStream(AFilename, fmOpenRead or fmShareDenyWrite);
712 
713     layeredBmp := TryCreateLayeredBitmapReader(ext);
714     if Assigned(layeredBmp) then
715     begin
716       if layeredBmp is TBGRALayeredSVG then
717       with TBGRALayeredSVG(layeredBmp) do
718       begin
719         ContainerWidth := Screen.Width;
720         ContainerHeight := Screen.Height;
721         DefaultLayerName:= rsLayer;
722       end;
723       layeredBmp.LoadFromStream(s);
724       with ComputeAcceptableImageSize(layeredBmp.Width,layeredBmp.Height) do
725         if (cx < layeredBmp.Width) or (cy < layeredBmp.Height) then
726         begin
727           if not (layeredBmp is TBGRALayeredBitmap) then
728           begin
729             temp := TBGRALayeredBitmap.Create;
730             temp.Assign(layeredBmp, true, true);
731             layeredBmp.Free;
732             layeredBmp := temp;
733           end;
734           MessagePopupForever(rsResamplingImage);
735           (FLazPaintInstance as TLazPaintCustomInstance).UpdateWindows;
736           (layeredBmp as TBGRALayeredBitmap).Resample(cx, cy, rmFineResample);
737           MessagePopupHide;
738         end;
739       CursorHotSpot := Point(0,0);
740       if layeredBmp is TBGRALazPaintImage then
741         selIndex := TBGRALazPaintImage(layeredBmp).SelectedLayerIndex
742         else selIndex := -1;
743       Assign(layeredBmp, true, false);
744       if selIndex <> -1 then SetCurrentLayerByIndex(selIndex);
745       layeredBmp := nil;
746     end else
747     begin
748       bmp := TBGRABitmap.Create;
749       bmp.LoadFromStream(s);
750       Assign(bmp,true,false);
751       bmp := nil;
752     end;
753 
754   finally
755     bmp.Free;
756     s.Free;
757   end;
758 end;
759 
760 procedure TLazPaintImage.SetSavedFlag(ASavedBPP: integer; ASavedFrameIndex: integer;
761   ASavedFrameCount: integer; AOpening: boolean);
762 var i: integer;
763 begin
764   FCurrentState.saved := true;
765   self.BPP := ASavedBPP;
766   self.FrameIndex := ASavedFrameIndex;
767   self.FrameCount := ASavedFrameCount;
768   for i := 0 to FUndoList.Count-1 do
769   begin
770     FUndoList[i].SavedBefore := (i = FUndoPos+1);
771     FUndoList[i].SavedAfter := (i = FUndoPos);
772   end;
773   OnImageChanged.NotifyObservers;
774   if (currentFilenameUTF8 <> '') and not AOpening then
775     OnImageSaving.NotifyObservers;
776 end;
777 
TLazPaintImage.IsFileModifiednull778 function TLazPaintImage.IsFileModified: boolean;
779 begin
780   result := not FCurrentState.saved;
781 end;
782 
TLazPaintImage.FlatImageEqualsnull783 function TLazPaintImage.FlatImageEquals(ABitmap: TBGRABitmap): boolean;
784 begin
785   if ABitmap = nil then result := RenderedImage = nil
786   else
787     result := ABitmap.Equals(RenderedImage);
788 end;
789 
790 procedure TLazPaintImage.Flatten;
791 begin
792   Assign(RenderedImage,False,True);
793 end;
794 
TLazPaintImage.GetDrawingLayernull795 function TLazPaintImage.GetDrawingLayer: TBGRABitmap;
796 begin
797    if SelectionMaskEmpty then result := GetSelectedImageLayer else
798      result := FCurrentState.GetOrCreateSelectionLayer;
799 end;
800 
801 procedure TLazPaintImage.LayeredBitmapReplaced;
802 begin
803   FreeAndNil(FRenderedImage);
804   if FCurrentState.NbLayers = 0 then
805     raise Exception.Create('No layer')
806   else
807     if FCurrentState.SelectedImageLayerIndex = -1 then
808       FCurrentState.SelectedImageLayerIndex := 0;
809 
810   if Assigned(FOnStackChanged)then FOnStackChanged(self,True);
811   OnImageChanged.NotifyObservers;
812   ImageMayChangeCompletely;
813 end;
814 
815 procedure TLazPaintImage.SetDraftOriginal(AValue: boolean);
816 var
817   r: TRect;
818 begin
819   if FDraftOriginal=AValue then Exit;
820   FDraftOriginal:=AValue;
821   if not FDraftOriginal then
822   begin
823     r := FCurrentState.LayeredBitmap.RenderOriginalsIfNecessary(FDraftOriginal);
824     ImageMayChange(r, false);
825   end;
826 end;
827 
828 procedure TLazPaintImage.AddUndo(AUndoAction: TCustomImageDifference);
829 var
830   prevAction: TCustomImageDifference;
831   prevGroup: TComposedImageDifference;
832   prevActionIndex: Integer;
833 begin
834   if AUndoAction <> nil then
835   begin
836     if AUndoAction.IsIdentity then
837     begin
838       AUndoAction.Free;
839       exit;
840     end;
841     prevGroup := FUndoList;
842     prevActionIndex := FUndoPos;
843     if prevActionIndex > -1 then
844     begin
845       prevAction := prevGroup[prevActionIndex];
846       while (prevAction is TComposedImageDifference) and
847         TComposedImageDifference(prevAction).Agglutinate do
848       begin
849         prevGroup := TComposedImageDifference(prevAction);
850         prevActionIndex := prevGroup.Count-1;
851         if prevActionIndex>=0 then
852           prevAction := prevGroup[prevActionIndex]
853         else
854           prevAction := nil;
855       end;
856     end else
857       prevAction := nil;
858     if assigned(prevAction) then
859     begin
860       if IsInverseImageDiff(AUndoAction,prevAction) then
861       begin
862         //writeln('Inverse');
863         AUndoAction.Free;
864         FCurrentState.saved := prevAction.SavedBefore;
865         prevGroup.DeleteFrom(prevActionIndex);
866         if prevGroup = FUndoList then FUndoPos := prevActionIndex-1;
867         exit;
868       end else
869       if not prevAction.savedAfter and TryCombineImageDiff(AUndoAction,prevAction) then
870       begin
871         AUndoAction.Free;
872         If prevAction.IsIdentity then
873         begin
874           //writeln('Inverse (combine)');
875           FCurrentState.saved := prevAction.SavedBefore;
876           prevGroup.DeleteFrom(prevActionIndex);
877           if prevGroup = FUndoList then FUndoPos := prevActionIndex-1;
878         end;
879         exit;
880       end;
881     end;
882     prevGroup.DeleteFrom(prevActionIndex+1);
883     if prevGroup.TotalCount >= MaxUndoCount then
884     begin
885       if prevGroup = FUndoList then
886       begin
887         FUndoList.Delete(0);
888         FUndoList.Add(AUndoAction);
889       end else
890       begin
891         MessagePopup(rsTooManyActions, 4000);
892         AUndoAction.UnapplyTo(FCurrentState);
893         InvalidateImageDifference(AUndoAction);
894         exit;
895       end;
896     end else
897     begin
898       prevGroup.Add(AUndoAction);
899       if prevGroup = FUndoList then inc(FUndoPos);
900     end;
901     //writeln(AUndoAction.ToString);
902     FCurrentState.saved := AUndoAction.SavedAfter;
903     CompressUndoIfNecessary;
904   end;
905 end;
906 
907 procedure TLazPaintImage.CompressUndoIfNecessary;
908 var i: integer;
909 begin
910   for i := 0 to FUndoList.Count-1 do
911     if UsedMemory <= MaxUsedMemoryWithoutCompression then break else
912     repeat
913       if not FUndoList[i].TryCompress then break;
914     until UsedMemory <= MaxUsedMemoryWithoutCompression;
915 end;
916 
917 procedure TLazPaintImage.NotifyException(AFunctionName: string;
918   AException: Exception);
919 begin
920   if Assigned(OnException) then
921     OnException(AFunctionName,AException)
922   else
923     MessageDlg(AFunctionName,AException.Message,mtError,[mbOk],0);
924 end;
925 
926 procedure TLazPaintImage.SetOnActionProgress(AValue: TLayeredActionProgressEvent);
927 begin
928   if FOnActionProgress=AValue then Exit;
929   FOnActionProgress:=AValue;
930 end;
931 
932 procedure TLazPaintImage.SetOnSizeChanged(AValue: TNotifyEvent);
933 begin
934   if FOnSizeChanged=AValue then Exit;
935   FOnSizeChanged:=AValue;
936 end;
937 
938 procedure TLazPaintImage.SetSelectionTransform(ATransform: TAffineMatrix);
939 
940   procedure InvalidateTransformedSelection;
941   var selectionChangeRect: TRect;
942   begin
943     selectionChangeRect := FCurrentState.GetTransformedSelectionMaskBounds;
944     if not SelectionLayerIsEmpty then
945       ImageMayChange(selectionChangeRect,False);
946     if not IsRectEmpty(selectionChangeRect) then
947     begin
948       InflateRect(selectionChangeRect,1,1);
949       RenderMayChange(selectionChangeRect,true);
950     end;
951   end;
952 
953 var
954   diff: TSetSelectionTransformDifference;
955 begin
956   if ATransform <> CurrentState.SelectionTransform then
957   begin
958     InvalidateTransformedSelection;
959     diff := TSetSelectionTransformDifference.Create(FCurrentState, ATransform);
960     diff.ApplyTo(FCurrentState);
961     InvalidateTransformedSelection;
962     AddUndo(diff);
963   end;
964 end;
965 
966 procedure TLazPaintImage.SetLayerName(AIndex: integer; AValue: string);
967 begin
968   AddUndo(FCurrentState.SetLayerName(AIndex,Avalue));
969   OnImageChanged.NotifyObservers;
970 end;
971 
972 procedure TLazPaintImage.SetLayerOffset(AIndex: integer; AValue: TPoint);
973 var bounds: TRect;
974 begin
975   bounds := FCurrentState.LayerBitmap[AIndex].GetImageBounds;
976   SetLayerOffset(AIndex,AValue,bounds);
977 end;
978 
979 procedure TLazPaintImage.SetLayerOpacity(AIndex: integer; AValue: byte);
980 begin
981   AddUndo(FCurrentState.SetLayerOpacity(AIndex,AValue));
982   LayerBlendMayChange(AIndex);
983 end;
984 
985 procedure TLazPaintImage.SetLayerOriginalMatrix(AIndex: integer;
986   AValue: TAffineMatrix);
987 var
988   prevMatrix: TAffineMatrix;
989   r: TRect;
990 begin
991   if LayerOriginalDefined[AIndex] then
992   begin
993     if not LayerOriginalKnown[AIndex] then
994       raise exception.Create('Unknown original cannot be transformed');
995     prevMatrix := LayerOriginalMatrix[AIndex];
996     FCurrentState.LayeredBitmap.LayerOriginalMatrix[AIndex] := AValue;
997     r := FCurrentState.LayeredBitmap.RenderOriginalsIfNecessary(FDraftOriginal);
998     ImageMayChange(r, false);
999     AddUndo(FCurrentState.ComputeLayerMatrixDifference(AIndex, prevMatrix, AValue));
1000   end else
1001   if not IsAffineMatrixIdentity(AValue) then
1002     raise exception.Create('Raster layer cannot have a matrix transform');
1003 end;
1004 
1005 procedure TLazPaintImage.SetLayerVisible(AIndex: integer; AValue: boolean);
1006 begin
1007   if not CheckNoAction then exit;
1008   if not SelectionLayerIsEmpty then
1009   begin
1010     MessagePopup(rsMustReleaseSelection,2000);
1011     exit;
1012   end;
1013   AddUndo(FCurrentState.SetLayerVisible(AIndex,AValue));
1014   LayerBlendMayChange(AIndex);
1015   OnImageChanged.NotifyObservers; //to show/hide tools
1016 end;
1017 
MakeBitmapCopynull1018 function TLazPaintImage.MakeBitmapCopy(backgroundColor: TColor): TBitmap;
1019 begin
1020   result := RenderedImage.MakeBitmapCopy(backgroundColor);
1021 end;
1022 
TLazPaintImage.CanUndonull1023 function TLazPaintImage.CanUndo: boolean;
1024 begin
1025   result := FUndoPos >= 0;
1026 end;
1027 
CanRedonull1028 function TLazPaintImage.CanRedo: boolean;
1029 begin
1030   result := FUndoPos < (FUndoList.Count-1);
1031 end;
1032 
1033 procedure TLazPaintImage.Undo;
1034 var prevAction: TCustomImageDifference;
1035   prevGroup: TComposedImageDifference;
1036   prevActionIndex: Integer;
1037 begin
1038   if CanUndo then
1039   begin
1040     if not CheckNoAction then exit;
1041     try
1042       prevGroup := FUndoList;
1043       prevActionIndex := FUndoPos;
1044       prevAction := prevGroup[prevActionIndex];
1045       while (prevAction is TComposedImageDifference) and
1046         TComposedImageDifference(prevAction).Agglutinate and
1047         (TComposedImageDifference(prevAction).Count > 0) do
1048       begin
1049         prevGroup := TComposedImageDifference(prevAction);
1050         prevActionIndex := prevGroup.Count-1;
1051         prevAction := prevGroup[prevActionIndex];
1052       end;
1053       prevAction.UnapplyTo(FCurrentState);
1054       InvalidateImageDifference(prevAction);
1055       if prevGroup = FUndoList then
1056         Dec(FUndoPos)
1057       else
1058         prevGroup.Delete(prevActionIndex);
1059     except
1060       on ex:Exception do
1061       begin
1062         NotifyException('Undo',ex);
1063         ClearUndo;
1064         ImageMayChangeCompletely;
1065         SelectionMaskMayChangeCompletely;
1066       end;
1067     end;
1068     CompressUndoIfNecessary;
1069   end;
1070 end;
1071 
1072 procedure TLazPaintImage.InvalidateImageDifference(ADiff: TCustomImageDifference);
1073 var kind:TImageDifferenceKind;
1074 begin
1075   kind := ADiff.Kind;
1076   case kind of
1077   idkChangeStack: OnImageChanged.NotifyObservers;
1078   idkChangeImageAndSelection: begin
1079     if ADiff.ChangingBoundsDefined then
1080     begin
1081       ImageMayChange(ADiff.ChangingBounds);
1082       SelectionMaskMayChange(ADiff.ChangingBounds);
1083     end else
1084     begin
1085       ImageMayChangeCompletely;
1086       SelectionMaskMayChangeCompletely;
1087     end;
1088   end;
1089   idkChangeImage:
1090       if ADiff.ChangingBoundsDefined then
1091         ImageMayChange(ADiff.ChangingBounds)
1092       else
1093         ImageMayChangeCompletely;
1094   idkChangeSelection:
1095       if ADiff.ChangingBoundsDefined then
1096         SelectionMaskMayChange(ADiff.ChangingBounds)
1097       else
1098         SelectionMaskMayChangeCompletely;
1099   end;
1100 end;
1101 
1102 procedure TLazPaintImage.OriginalChange(ASender: TObject;
1103   AOriginal: TBGRALayerCustomOriginal; var ADiff: TBGRAOriginalDiff);
1104 var
1105   r: TRect;
1106 begin
1107   r := FCurrentState.LayeredBitmap.RenderOriginalIfNecessary(AOriginal.Guid, FDraftOriginal);
1108   if r.IsEmpty then OnImageChanged.NotifyObservers
1109   else ImageMayChange(r, false);
1110   if Assigned(ADiff) then
1111   begin
1112     AddUndo(TVectorOriginalEmbeddedDifference.Create(CurrentState,AOriginal.Guid,ADiff,r));
1113     ADiff := nil;
1114   end;
1115 end;
1116 
1117 procedure TLazPaintImage.OriginalEditingChange(ASender: TObject;
1118   AOriginal: TBGRALayerCustomOriginal);
1119 begin
1120   OnImageChanged.NotifyObservers;
1121 end;
1122 
1123 procedure TLazPaintImage.OriginalLoadError(ASender: TObject; AError: string;
1124   var ARaise: boolean);
1125 begin
1126   MessagePopup(rsErrorLoadingOriginal, 4000);
1127   ARaise := false;
1128 end;
1129 
1130 procedure TLazPaintImage.Redo;
1131 var diff: TCustomImageDifference;
1132 begin
1133   if CanRedo then
1134   begin
1135     if not CheckNoAction then exit;
1136     try
1137       inc(FUndoPos);
1138       diff := FUndoList[FUndoPos];
1139       diff.ApplyTo(FCurrentState);
1140       InvalidateImageDifference(diff);
1141     except
1142       on ex:Exception do
1143       begin
1144         NotifyException('Redo',ex);
1145         ClearUndo;
1146         ImageMayChangeCompletely;
1147         SelectionMaskMayChangeCompletely;
1148       end;
1149     end;
1150     CompressUndoIfNecessary;
1151   end;
1152 end;
1153 
1154 procedure TLazPaintImage.DoBegin;
1155 begin
1156   AddUndo(TComposedImageDifference.Create(True));
1157 end;
1158 
1159 procedure TLazPaintImage.DoEnd(out ADoFound: boolean; out ASomethingDone: boolean);
1160 var
1161   curDiff, insideDiff: TCustomImageDifference;
1162   curGroup: TComposedImageDifference;
1163   curIndex: Integer;
1164 begin
1165   ADoFound := false;
1166   ASomethingDone := false;
1167   if FUndoPos >= 0 then
1168   begin
1169     curGroup := FUndoList;
1170     curIndex := FUndoPos;
1171     curDiff := curGroup[curIndex];
1172     if not ((curDiff is TComposedImageDifference) and
1173       TComposedImageDifference(curDiff).Agglutinate) then
1174         exit;
1175     ADoFound:= true;
1176     ASomethingDone := true;
1177     repeat
1178       insideDiff := TComposedImageDifference(curDiff).GetLast;
1179       if (insideDiff <> nil) and (insideDiff is TComposedImageDifference) and
1180          TComposedImageDifference(insideDiff).Agglutinate then
1181       begin
1182         curGroup := TComposedImageDifference(curDiff);
1183         curIndex := curGroup.Count-1;
1184         curDiff := insideDiff;
1185       end
1186       else
1187         break;
1188     until false;
1189     TComposedImageDifference(curDiff).StopAgglutinate;
1190     if TComposedImageDifference(curDiff).Count = 0 then
1191     begin
1192       curGroup.Delete(curIndex);
1193       if curGroup = FUndoList then dec(FUndoPos);
1194       ASomethingDone := false;
1195     end;
1196   end;
1197 end;
1198 
1199 procedure TLazPaintImage.ClearUndo;
1200 begin
1201   try
1202     FUndoList.Clear;
1203     FUndoPos := -1;
1204   except on ex:exception do
1205     MessagePopup(ex.Message, 4000);
1206   end;
1207 end;
1208 
1209 procedure TLazPaintImage.CompressUndo;
1210 var i: integer;
1211 begin
1212   for i := 0 to FUndoList.Count-1 do
1213     if FUndoList[i].TryCompress then exit;
1214 end;
1215 
UsedMemorynull1216 function TLazPaintImage.UsedMemory: int64;
1217 var i: integer;
1218 begin
1219   result := 0;
1220   if Assigned(FUndoList) then
1221     for i := 0 to FUndoList.Count-1 do
1222       result += FUndoList[i].UsedMemory;
1223 end;
1224 
TLazPaintImage.CreateActionnull1225 function TLazPaintImage.CreateAction(AApplyOfsBefore: boolean;
1226                                      AApplySelTransformBefore: boolean): TLayerAction;
1227 begin
1228   if not CheckNoAction(True) then
1229     raise exception.Create(rsConflictingActions);
1230   result := TLayerAction.Create(FCurrentState, AApplyOfsBefore, AApplySelTransformBefore);
1231   result.OnNotifyChange:= @LayerActionNotifyChange;
1232   result.OnDestroy:=@LayerActionDestroy;
1233   result.OnNotifyUndo:=@LayerActionNotifyUndo;
1234   FActionInProgress := result;
1235   if Assigned(result.Prediff) then
1236     InvalidateImageDifference(result.Prediff);
1237 end;
1238 
1239 procedure TLazPaintImage.ImageMayChange(ARect: TRect;
1240   ADiscardSelectionLayerAfterMask: boolean);
1241 begin
1242   IntersectRect(ARect, ARect, rect(0,0,Width,Height));
1243   if IsRectEmpty(ARect) then exit;
1244 
1245   if ADiscardSelectionLayerAfterMask then DiscardSelectionLayerAfterMask;
1246   FRenderUpdateRectInPicCoord := RectUnion(FRenderUpdateRectInPicCoord,ARect);
1247   FRenderedImageInvalidated := RectUnion(FRenderedImageInvalidated, ARect);
1248   FCurrentState.DiscardSelectionLayerBounds(ARect);
1249   OnImageChanged.NotifyObservers;
1250 end;
1251 
1252 procedure TLazPaintImage.ImageMayChangeCompletely;
1253 begin
1254   ImageMayChange(rect(0,0,Width,Height));
1255 end;
1256 
1257 procedure TLazPaintImage.LayerMayChange(ALayer: TBGRABitmap; ARect: TRect);
1258 var
1259   ab: TAffineBox;
1260 begin
1261   If ALayer = nil then exit;
1262   if ALayer = SelectionMask then
1263   begin
1264     SelectionMaskMayChange(ARect);
1265     exit;
1266   end;
1267   if ALayer = SelectionLayerReadonly then
1268   begin
1269     DiscardSelectionLayerAfterMask;
1270     ARect.Intersect(SelectionMaskBounds);
1271     ab := SelectionTransform*TAffineBox.AffineBox(rectF(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom));
1272     ARect := ab.RectBounds;
1273   end;
1274   if ALayer = CurrentLayerReadOnly then
1275     with LayerOffset[CurrentLayerIndex] do
1276       OffsetRect(ARect,X,Y);
1277   ImageMayChange(ARect);
1278 end;
1279 
1280 procedure TLazPaintImage.LayerMayChangeCompletely(ALayer: TBGRABitmap);
1281 begin
1282   If ALayer = nil then exit;
1283   LayerMayChange(ALayer,rect(0,0,ALayer.Width,ALayer.Height));
1284 end;
1285 
1286 procedure TLazPaintImage.SelectionMaskMayChange(ARect: TRect);
1287 var transfRect: TRect;
1288   ab: TAffineBox;
1289 begin
1290   IntersectRect(ARect, ARect, rect(0,0,Width,Height));
1291   if IsRectEmpty(ARect) then exit;
1292 
1293   DiscardSelectionLayerAfterMask;
1294 
1295   ab := SelectionTransform*TAffineBox.AffineBox(rectF(ARect.Left,ARect.Top,ARect.Right,ARect.Bottom));
1296   transfRect := ab.RectBounds;
1297   InflateRect(transfRect,1,1);
1298   FRenderUpdateRectInPicCoord := RectUnion(FRenderUpdateRectInPicCoord,transfRect);
1299 
1300   FCurrentState.DiscardSelectionMaskBounds(ARect);
1301   if Assigned(FOnSelectionMaskChanged) then FOnSelectionMaskChanged(self, ARect);
1302   if FCurrentState.SelectionLayer <> nil then
1303     ImageMayChange(transfRect, False)
1304   else
1305     OnImageChanged.NotifyObservers;
1306 end;
1307 
1308 procedure TLazPaintImage.SelectionMaskMayChangeCompletely;
1309 begin
1310   DiscardSelectionLayerAfterMask;
1311   FRenderUpdateRectInPicCoord := rect(0,0,Width,Height);
1312   FCurrentState.DiscardSelectionMaskBoundsCompletely;
1313   if Assigned(FOnSelectionMaskChanged) then FOnSelectionMaskChanged(self, rect(0,0,Width,Height));
1314   if FCurrentState.SelectionLayer <> nil then
1315     LayerMayChange(FCurrentState.SelectionLayer, rect(0,0,Width,Height))
1316   else
1317     OnImageChanged.NotifyObservers;
1318 end;
1319 
1320 procedure TLazPaintImage.RenderMayChange(ARect: TRect; APicCoords: boolean; ANotify: boolean);
1321 begin
1322   if APicCoords then
1323      FRenderUpdateRectInPicCoord := RectUnion(FRenderUpdateRectInPicCoord,ARect)
1324   else
1325      FRenderUpdateRectInVSCoord := RectUnion(FRenderUpdateRectInVSCoord,ARect);
1326   if ANotify and Assigned(OnImageRenderChanged) then
1327     OnImageRenderChanged(self);
1328 end;
1329 
1330 procedure TLazPaintImage.LayerBlendMayChange(AIndex: integer);
1331 var r, rSel: TRect;
1332 begin
1333   r := FCurrentState.LayerBitmap[AIndex].GetImageBounds;
1334   with LayerOffset[AIndex] do OffsetRect(r, x,y);
1335   if (AIndex = CurrentLayerIndex) and not SelectionMaskEmpty then
1336   begin
1337     rSel := TRect.Intersect(SelectionMaskBounds, SelectionLayerBounds);
1338     rSel := SelectionMask.GetImageAffineBounds(SelectionTransform, rSel, false);
1339     if not rSel.IsEmpty then
1340     begin
1341       if r.IsEmpty then r := rSel
1342       else r := TRect.Union(r, rSel);
1343     end;
1344   end;
1345   ImageMayChange(r);
1346 end;
1347 
TLazPaintImage.MakeLayeredBitmapAndSelectionCopynull1348 function TLazPaintImage.MakeLayeredBitmapAndSelectionCopy: TLayeredBitmapAndSelection;
1349 begin
1350   result.layeredBitmap := FCurrentState.GetLayeredBitmapCopy;
1351   result.selection := DuplicateBitmap(SelectionMask);
1352   result.selectionLayer := DuplicateBitmap(FCurrentState.SelectionLayer);
1353 end;
1354 
1355 {--------------------- Selection --------------------------------------}
1356 
SelectionMaskNilnull1357 function TLazPaintImage.SelectionMaskNil: boolean;
1358 begin
1359   result := (SelectionMask = nil);
1360 end;
1361 
TLazPaintImage.GetHeightnull1362 function TLazPaintImage.GetHeight: integer;
1363 begin
1364   result := FCurrentState.Height;
1365 end;
1366 
TLazPaintImage.GetSelectedImageLayernull1367 function TLazPaintImage.GetSelectedImageLayer: TBGRABitmap;
1368 begin
1369   result := FCurrentState.SelectedImageLayer;
1370   if (result = nil) and (NbLayers > 0) then
1371   begin
1372     SetCurrentLayerByIndex(0);
1373     result := FCurrentState.SelectedImageLayer;
1374   end;
1375 end;
1376 
GetCurrentLayerIndexnull1377 function TLazPaintImage.GetCurrentLayerIndex: integer;
1378 begin
1379   result := FCurrentState.SelectedImageLayerIndex;
1380   if (result = -1) and (NbLayers > 0) then
1381   begin
1382     SetCurrentLayerByIndex(0);
1383     result := 0;
1384   end;
1385 end;
1386 
TLazPaintImage.GetCurrentFilenameUTF8null1387 function TLazPaintImage.GetCurrentFilenameUTF8: string;
1388 begin
1389   result := FCurrentState.filenameUTF8;
1390 end;
1391 
TLazPaintImage.GetCurrentLayerVisiblenull1392 function TLazPaintImage.GetCurrentLayerVisible: boolean;
1393 var idx: integer;
1394 begin
1395   idx := CurrentLayerIndex;
1396   if (idx < 0) or (idx >= NbLayers) then
1397     result := false
1398   else
1399     result := LayerVisible[CurrentLayerIndex];
1400 end;
1401 
1402 procedure TLazPaintImage.DiscardSelectionLayerAfterMask;
1403 begin
1404   if FSelectionLayerAfterMaskDefined then
1405   begin
1406     FreeAndNil(FSelectionLayerAfterMask);
1407     FSelectionLayerAfterMaskOffset := Point(0,0);
1408     FSelectionLayerAfterMaskDefined := false;
1409   end;
1410 end;
1411 
GetDPInull1412 function TLazPaintImage.GetDPI: integer;
1413 begin
1414   result := ScreenInfo.PixelsPerInchY;
1415 end;
1416 
GetIsCursornull1417 function TLazPaintImage.GetIsCursor: boolean;
1418 begin
1419   result := UTF8CompareText(ExtractFileExt(currentFilenameUTF8),'.cur')=0;
1420 end;
1421 
TLazPaintImage.GetIsIconCursornull1422 function TLazPaintImage.GetIsIconCursor: boolean;
1423 begin
1424   result := SuggestImageFormat(currentFilenameUTF8) in [ifIco,ifCur];
1425 end;
1426 
GetIsTiffnull1427 function TLazPaintImage.GetIsTiff: boolean;
1428 begin
1429   result := SuggestImageFormat(currentFilenameUTF8) = ifTiff;
1430 end;
1431 
GetIsGifnull1432 function TLazPaintImage.GetIsGif: boolean;
1433 begin
1434   result := SuggestImageFormat(currentFilenameUTF8) = ifGif;
1435 end;
1436 
GetLayerBitmapByIdnull1437 function TLazPaintImage.GetLayerBitmapById(AId: integer): TBGRABitmap;
1438 begin
1439   result := FCurrentState.LayerBitmapById[AId];
1440 end;
1441 
TLazPaintImage.GetLayerGuidnull1442 function TLazPaintImage.GetLayerGuid(AIndex: integer): TGuid;
1443 var
1444   guidStr: RawByteString;
1445 begin
1446   guidStr := GetLayerRegistry(AIndex, 'guid');
1447   if guidStr<>'' then
1448     result := StringToGUID(guidStr)
1449   else
1450   begin
1451     CreateGUID(result);
1452     SetLayerRegistry(AIndex, 'guid', GUIDToString(result));
1453   end;
1454 end;
1455 
TLazPaintImage.GetLayerIdnull1456 function TLazPaintImage.GetLayerId(AIndex: integer): integer;
1457 begin
1458   result := FCurrentState.LayerId[AIndex];
1459 end;
1460 
GetLayerOriginalnull1461 function TLazPaintImage.GetLayerOriginal(AIndex: integer): TBGRALayerCustomOriginal;
1462 begin
1463   try
1464     result := FCurrentState.LayerOriginal[AIndex];
1465   except
1466     on ex:exception do
1467     begin
1468       MessagePopup(rsErrorLoadingOriginal, 4000);
1469       result := nil;
1470     end;
1471   end;
1472 end;
1473 
GetLayerOriginalClassnull1474 function TLazPaintImage.GetLayerOriginalClass(AIndex: integer): TBGRALayerOriginalAny;
1475 begin
1476   result := FCurrentState.LayerOriginalClass[AIndex];
1477 end;
1478 
GetLayerOriginalDefinednull1479 function TLazPaintImage.GetLayerOriginalDefined(AIndex: integer): boolean;
1480 begin
1481   result := FCurrentState.LayerOriginalDefined[AIndex];
1482 end;
1483 
TLazPaintImage.GetLayerOriginalKnownnull1484 function TLazPaintImage.GetLayerOriginalKnown(AIndex: integer): boolean;
1485 begin
1486   result := FCurrentState.LayerOriginalKnown[AIndex];
1487 end;
1488 
TLazPaintImage.GetLayerOriginalMatrixnull1489 function TLazPaintImage.GetLayerOriginalMatrix(AIndex: integer): TAffineMatrix;
1490 begin
1491   result := FCurrentState.LayerOriginalMatrix[AIndex];
1492 end;
1493 
GetSelectionLayerEmptynull1494 function TLazPaintImage.GetSelectionLayerEmpty: boolean;
1495 begin
1496   result := FCurrentState.SelectionLayerEmpty;
1497 end;
1498 
GetSelectionMaskBoundsnull1499 function TLazPaintImage.GetSelectionMaskBounds: TRect;
1500 begin
1501   result := FCurrentState.GetSelectionMaskBounds;
1502 end;
1503 
TLazPaintImage.GetSelectionMaskEmptynull1504 function TLazPaintImage.GetSelectionMaskEmpty: boolean;
1505 begin
1506   result := FCurrentState.SelectionMaskEmpty;
1507 end;
1508 
TLazPaintImage.GetSelectionTransformnull1509 function TLazPaintImage.GetSelectionTransform: TAffineMatrix;
1510 begin
1511   result := FCurrentState.SelectionTransform;
1512 end;
1513 
1514 procedure TLazPaintImage.LayeredActionDone(Sender: TObject);
1515 begin
1516   if Assigned(OnActionProgress) then
1517     OnActionProgress(self, 100);
1518 end;
1519 
1520 procedure TLazPaintImage.LayeredActionProgress(ASender: TObject;
1521   AProgressPercent: integer);
1522 begin
1523   if Assigned(OnActionProgress) then
1524     OnActionProgress(self, AProgressPercent);
1525 end;
1526 
1527 procedure TLazPaintImage.LayeredSizeChanged(Sender: TObject);
1528 begin
1529   if Assigned(FOnSizeChanged) then
1530     FOnSizeChanged(self);
1531 end;
1532 
1533 procedure TLazPaintImage.NeedSelectionLayerAfterMask;
1534 var
1535   bounds,
1536   boundsAfter: TRect;
1537 begin
1538   if not FSelectionLayerAfterMaskDefined then
1539   begin
1540     if SelectionMaskEmpty or SelectionLayerIsEmpty then
1541       FreeAndNil(FSelectionLayerAfterMask)
1542     else
1543     begin
1544       bounds := SelectionLayerBounds;
1545       FSelectionLayerAfterMask := SelectionLayerReadonly.GetPart(bounds) as TBGRABitmap;
1546       FSelectionLayerAfterMask.ApplyMask(SelectionMask,
1547           Rect(0,0,FSelectionLayerAfterMask.Width,FSelectionLayerAfterMask.Height),
1548           bounds.TopLeft);
1549       FSelectionLayerAfterMaskOffset := bounds.TopLeft;
1550 
1551       boundsAfter := FSelectionLayerAfterMask.GetImageBounds;
1552       if IsRectEmpty(boundsAfter) then FreeAndNil(FSelectionLayerAfterMask) else
1553       if (boundsAfter.left > FSelectionLayerAfterMask.Width div 10) or (boundsAfter.right < FSelectionLayerAfterMask.Width*9 div 10) or
1554          (boundsAfter.top > FSelectionLayerAfterMask.Height div 10) or (boundsAfter.bottom < FSelectionLayerAfterMask.Height*9 div 10) then
1555       begin
1556         BGRAReplace(FSelectionLayerAfterMask, FSelectionLayerAfterMask.GetPart(boundsAfter));
1557         FSelectionLayerAfterMaskOffset.x += boundsAfter.Left;
1558         FSelectionLayerAfterMaskOffset.y += boundsAfter.Top;
1559       end;
1560     end;
1561     FSelectionLayerAfterMaskDefined := true;
1562   end;
1563 end;
1564 
TLazPaintImage.GetBlendOperationnull1565 function TLazPaintImage.GetBlendOperation(AIndex: integer): TBlendOperation;
1566 begin
1567   result := FCurrentState.BlendOperation[AIndex];
1568 end;
1569 
TLazPaintImage.GetEmptynull1570 function TLazPaintImage.GetEmpty: boolean;
1571 begin
1572   result := (NbLayers = 0) or ((NbLayers = 1) and FCurrentState.LayerBitmap[0].Empty);
1573 end;
1574 
1575 procedure TLazPaintImage.SetBlendOperation(AIndex: integer;
1576   AValue: TBlendOperation);
1577 begin
1578   AddUndo(FCurrentState.SetBlendOp(AIndex,AValue));
1579   LayerBlendMayChange(AIndex);
1580 end;
1581 
1582 procedure TLazPaintImage.SetCurrentFilenameUTF8(AValue: string);
1583 var oldIsIco: boolean;
1584 begin
1585   oldIsIco := IsIconCursor;
1586   FCurrentState.filenameUTF8 := AValue;
1587   if oldIsIco <> IsIconCursor then ImageMayChangeCompletely;
1588   if Assigned(FOnCurrentFilenameChanged) then
1589     FOnCurrentFilenameChanged(self);
1590 end;
1591 
SetCurrentLayerByIndexnull1592 function TLazPaintImage.SetCurrentLayerByIndex(AValue: integer): boolean;
1593 begin
1594   if AValue = FCurrentState.SelectedImageLayerIndex then exit(true);
1595   if (AValue < 0) or (AValue >= NbLayers) then exit(false);
1596   if not CheckNoAction then
1597   begin
1598     result := false;
1599     exit;
1600   end;
1601 
1602   if assigned(OnSelectedLayerIndexChanging) then OnSelectedLayerIndexChanging(self);
1603   FCurrentState.SelectedImageLayerIndex := AValue;
1604   if assigned(OnSelectedLayerIndexChanged) then OnSelectedLayerIndexChanged(self);
1605   ImageMayChangeCompletely;
1606 
1607   result := true;
1608 end;
1609 
SelectLayerContainingPixelAtnull1610 function TLazPaintImage.SelectLayerContainingPixelAt(APicturePos: TPoint): boolean;
1611 var
1612   i: Integer;
1613   ofs: TPoint;
1614 begin
1615   for i := NbLayers-1 downto 0 do
1616   begin
1617     ofs := LayerOffset[i];
1618     if LayerBitmap[i].GetPixel(APicturePos.x - ofs.x, APicturePos.y - ofs.y).alpha > 0 then
1619     begin
1620       result := SetCurrentLayerByIndex(i);
1621       exit;
1622     end;
1623   end;
1624   result := false;
1625 end;
1626 
1627 procedure TLazPaintImage.SetLayerOffset(AIndex: integer; AValue: TPoint;
1628   APrecomputedLayerBounds: TRect);
1629 var
1630   discardOrig: TDiscardOriginalStateDifference;
1631   comb: TComposedImageDifference;
1632 begin
1633   OffsetRect(APrecomputedLayerBounds, LayerOffset[AIndex].x,LayerOffset[AIndex].y);
1634   ImageMayChange(APrecomputedLayerBounds);
1635   OffsetRect(APrecomputedLayerBounds, -LayerOffset[AIndex].x,-LayerOffset[AIndex].y);
1636   if FCurrentState.LayerOriginalDefined[AIndex] then
1637   begin
1638     discardOrig := TDiscardOriginalStateDifference.Create(FCurrentState,AIndex);
1639     discardOrig.ApplyTo(FCurrentState);
1640     comb := TComposedImageDifference.Create;
1641     comb.Add(discardOrig);
1642     comb.Add(FCurrentState.SetLayerOffset(AIndex,AValue));
1643     AddUndo(comb);
1644   end else
1645     AddUndo(FCurrentState.SetLayerOffset(AIndex,AValue));
1646   OffsetRect(APrecomputedLayerBounds, LayerOffset[AIndex].x,LayerOffset[AIndex].y);
1647   ImageMayChange(APrecomputedLayerBounds);
1648   OffsetRect(APrecomputedLayerBounds, -LayerOffset[AIndex].x,-LayerOffset[AIndex].y);
1649 end;
1650 
CheckNoActionnull1651 function TLazPaintImage.CheckNoAction(ASilent: boolean): boolean;
1652 begin
1653   result := true;
1654   if FActionInProgress <> nil then
1655   begin
1656     FActionInProgress.TryStop;
1657     if FActionInProgress <> nil then
1658     begin
1659       if Assigned(FOnQueryExitToolHandler) then
1660         FOnQueryExitToolHandler(self);
1661       if FActionInProgress <> nil then
1662       begin
1663         if not ASilent then MessagePopup(rsActionInProgress,2000);
1664         result := false;
1665       end;
1666     end;
1667   end;
1668 end;
1669 
CanDuplicateFramenull1670 function TLazPaintImage.CanDuplicateFrame: boolean;
1671 begin
1672   result := IsGif or IsTiff;
1673 end;
1674 
CanHaveFramesnull1675 function TLazPaintImage.CanHaveFrames: boolean;
1676 begin
1677   result := IsGif or IsTiff or IsIconCursor;
1678 end;
1679 
1680 procedure TLazPaintImage.ZoomFit;
1681 begin
1682   if Assigned(Zoom) then Zoom.ZoomFit(Width,Height);
1683 end;
1684 
1685 procedure TLazPaintImage.ResetRenderUpdateRect;
1686 begin
1687   FRenderUpdateRectInPicCoord := rect(0,0,0,0);
1688   FRenderUpdateRectInVSCoord := rect(0,0,0,0);
1689 end;
1690 
GetSelectionMasknull1691 function TLazPaintImage.GetSelectionMask: TBGRABitmap;
1692 begin
1693   result := FCurrentState.SelectionMask;
1694 end;
1695 
GetLayerBitmapnull1696 function TLazPaintImage.GetLayerBitmap(AIndex: integer): TBGRABitmap;
1697 begin
1698   result := FCurrentState.LayerBitmap[AIndex];
1699 end;
1700 
TLazPaintImage.GetLayerNamenull1701 function TLazPaintImage.GetLayerName(AIndex: integer): string;
1702 begin
1703   result := FCurrentState.LayerName[AIndex];
1704 end;
1705 
GetLayerOffsetnull1706 function TLazPaintImage.GetLayerOffset(AIndex: integer): TPoint;
1707 begin
1708   result := FCurrentState.LayerOffset[AIndex];
1709 end;
1710 
TLazPaintImage.GetLayerOpacitynull1711 function TLazPaintImage.GetLayerOpacity(AIndex: integer): byte;
1712 begin
1713   result := FCurrentState.LayerOpacity[AIndex];
1714 end;
1715 
GetLayerVisiblenull1716 function TLazPaintImage.GetLayerVisible(AIndex: integer): boolean;
1717 begin
1718   result := FCurrentState.LayerVisible[AIndex];
1719 end;
1720 
GetNbLayersnull1721 function TLazPaintImage.GetNbLayers: integer;
1722 begin
1723   result := FCurrentState.NbLayers;
1724 end;
1725 
GetRenderedImagenull1726 function TLazPaintImage.GetRenderedImage: TBGRABitmap;
1727 var
1728   ofs: TPoint;
1729   temp: TBGRABitmap;
1730   rectOutput, rLayer: TRect;
1731   actualTransformation: TAffineMatrix;
1732   selectionScanner: TBGRACustomScanner;
1733   selFilter: TResampleFilter;
1734 begin
1735   if (NbLayers = 1) and (LayerOpacity[CurrentLayerIndex] = 255) and
1736     (LayerOffset[CurrentLayerIndex].X = 0) and (LayerOffset[CurrentLayerIndex].Y = 0) and
1737     (LayerBitmap[CurrentLayerIndex].Width = Width) and (LayerBitmap[CurrentLayerIndex].Height = Height) and
1738     LayerVisible[CurrentLayerIndex] and ((SelectionMask = nil) or (SelectionLayerReadonly = nil)) then
1739     exit(LayerBitmap[CurrentLayerIndex])
1740   else
1741   if (FRenderedImage = nil) or ((FRenderedImageInvalidated.Right > FRenderedImageInvalidated.Left) and
1742      (FRenderedImageInvalidated.Bottom > FRenderedImageInvalidated.Top)) then
1743   begin
1744     if FCurrentState = nil then
1745     begin
1746       FreeAndNil(FRenderedImage);
1747       result := nil;
1748       exit;
1749     end;
1750     PrepareForRendering;
1751 
1752     selectionScanner := nil;
1753     //if there is an overlapping selection, then we must draw it on current layer
1754     if LayerVisible[CurrentLayerIndex] and (LayerOpacity[CurrentLayerIndex] > 0) and
1755        (SelectionMask <> nil) and (SelectionLayerReadonly <> nil) then
1756     begin
1757       if not SelectionMaskEmpty and not SelectionLayerIsEmpty then
1758       begin
1759          if not TBGRABitmap.IsAffineRoughlyTranslation(SelectionTransform, SelectionMaskBounds) then
1760          begin
1761            NeedSelectionLayerAfterMask;
1762            actualTransformation := SelectionTransform*AffineMatrixTranslation(FSelectionLayerAfterMaskOffset.X,FSelectionLayerAfterMaskOffset.Y);
1763            rectOutput := SelectionMask.GetImageAffineBounds(actualTransformation, FSelectionLayerAfterMask.ClipRect);
1764            rectOutput.Intersect(rect(0,0,self.Width,self.Height));
1765            if not rectOutput.IsEmpty then
1766            begin
1767              if rectOutput.Width*rectOutput.Height > 640*480 then
1768                selFilter := rfBox else selFilter := rfCosine;
1769              selectionScanner := TBGRAAffineBitmapTransform.Create(
1770                                             FSelectionLayerAfterMask, false, selFilter);
1771              TBGRAAffineBitmapTransform(selectionScanner).ViewMatrix := actualTransformation;
1772              FCurrentState.LayeredBitmap.SelectionScanner := selectionScanner;
1773              FCurrentState.LayeredBitmap.SelectionRect:= rectOutput;
1774              FCurrentState.LayeredBitmap.SelectionScannerOffset:= Point(0, 0);
1775              FCurrentState.LayeredBitmap.SelectionLayerIndex:= CurrentLayerIndex;
1776            end;
1777          end else
1778          begin
1779            DiscardSelectionLayerAfterMask;
1780            rectOutput := TRect.Intersect(SelectionLayerBounds, SelectionMaskBounds);
1781            ofs := Point(round(SelectionTransform[1, 3]), round(SelectionTransform[2, 3]));
1782            rectOutput.Offset(ofs.x, ofs.y);
1783            rectOutput.Intersect(rect(0,0,self.Width,self.Height));
1784            if not IsRectEmpty(rectOutput) then
1785            begin
1786              selectionScanner := TBGRATextureMaskScanner.Create(SelectionMask,
1787                Point(0,0), FCurrentState.SelectionLayer);
1788              FCurrentState.LayeredBitmap.SelectionScanner := selectionScanner;
1789              FCurrentState.LayeredBitmap.SelectionRect:= rectOutput;
1790              FCurrentState.LayeredBitmap.SelectionScannerOffset:= Point(-ofs.x, -ofs.y);
1791              FCurrentState.LayeredBitmap.SelectionLayerIndex:= CurrentLayerIndex;
1792            end;
1793          end;
1794       end;
1795     end;
1796 
1797     if (FRenderedImage <> nil) and ((FRenderedImage.Width <> Width) or (FRenderedImage.Height <> Height)) then
1798       FreeAndNil(FRenderedImage);
1799 
1800     if FRenderedImage = nil then FRenderedImage := TBGRABitmap.Create(Width,Height);
1801 
1802     if IsIconCursor then
1803     begin
1804       temp := FCurrentState.ComputeFlatImage(FRenderedImageInvalidated,0,NbLayers-1,True);
1805       FRenderedImage.PutImage(FRenderedImageInvalidated.Left,FRenderedImageInvalidated.Top, temp, dmSet);
1806       if temp.XorMask <> nil then
1807       begin
1808         FRenderedImage.NeedXorMask;
1809         FRenderedImage.XorMask.PutImage(FRenderedImageInvalidated.Left,FRenderedImageInvalidated.Top, temp.XorMask, dmSet);
1810       end else
1811         FRenderedImage.DiscardXorMask;
1812       temp.Free;
1813     end else
1814     begin
1815       FRenderedImage.ClipRect := FRenderedImageInvalidated;
1816       FRenderedImage.DiscardXorMask;
1817       if (NbLayers = 1) and (FCurrentState.LayeredBitmap.SelectionScanner = nil) then
1818       begin
1819         if (LayerOpacity[0] > 0) and LayerVisible[0] then
1820         begin
1821           rLayer := RectWithSize(LayerOffset[0].X, LayerOffset[0].Y, LayerBitmap[0].Width, LayerBitmap[0].Height);
1822           if rLayer.Top > FRenderedImageInvalidated.Top then
1823             FRenderedImage.EraseRect(FRenderedImageInvalidated.Left, FRenderedImageInvalidated.Top,
1824               FRenderedImageInvalidated.Right, rLayer.Top, 255);
1825           if rLayer.Left > FRenderedImageInvalidated.Left then
1826             FRenderedImage.EraseRect(FRenderedImageInvalidated.Left, rLayer.Top,
1827               rLayer.Left, rLayer.Bottom, 255);
1828           FRenderedImage.PutImage(rLayer.Left, rLayer.Top, LayerBitmap[0], dmSet);
1829           FRenderedImage.ApplyGlobalOpacity(rLayer, LayerOpacity[0]);
1830           if rLayer.Right < FRenderedImageInvalidated.Right then
1831             FRenderedImage.EraseRect(rLayer.Right, rLayer.Top,
1832               FRenderedImageInvalidated.Right, rLayer.Bottom, 255);
1833           if rLayer.Bottom < FRenderedImageInvalidated.Bottom then
1834             FRenderedImage.EraseRect(FRenderedImageInvalidated.Left, rLayer.Bottom,
1835               FRenderedImageInvalidated.Right, FRenderedImageInvalidated.Bottom, 255);
1836         end else
1837           FRenderedImage.EraseRect(FRenderedImageInvalidated, 255);
1838       end else
1839       begin
1840         FRenderedImage.FillRect(FRenderedImageInvalidated, BGRAPixelTransparent, dmSet);
1841         FCurrentState.DrawLayers(FRenderedImage, 0, 0, False, true);
1842       end;
1843       FRenderedImage.NoClip;
1844     end;
1845     FCurrentState.LayeredBitmap.DiscardSelection;
1846     selectionScanner.Free;
1847     FRenderedImageInvalidated := EmptyRect; //up to date
1848   end;
1849   result := FRenderedImage;
1850 end;
1851 
GetSelectedLayerPixelnull1852 function TLazPaintImage.GetSelectedLayerPixel(X, Y: Integer): TBGRAPixel;
1853 begin
1854   result := GetSelectedImageLayer.GetPixel(X,Y);
1855 end;
1856 
TLazPaintImage.GetSelectionLayerBoundsnull1857 function TLazPaintImage.GetSelectionLayerBounds: TRect;
1858 begin
1859   result := FCurrentState.GetSelectionLayerBounds;
1860 end;
1861 
TLazPaintImage.GetWidthnull1862 function TLazPaintImage.GetWidth: integer;
1863 begin
1864   result := FCurrentState.Width;
1865 end;
1866 
GetZoomFactornull1867 function TLazPaintImage.GetZoomFactor: single;
1868 begin
1869   if Assigned(Zoom) then result := Zoom.Factor else result := 1;
1870 end;
1871 
1872 procedure TLazPaintImage.Assign(const AValue: TBGRABitmap; AOwned: boolean; AUndoable: boolean;
1873   ACaption: string; AOpacity: byte);
1874 var layeredBmp: TBGRALayeredBitmap;
1875   mask: TBGRABitmap;
1876 begin
1877   if not CheckNoAction then exit;
1878   CursorHotSpot := AValue.HotSpot;
1879   layeredBmp := TBGRALayeredBitmap.Create(AValue.Width,AValue.Height);
1880   if AOwned then
1881   begin
1882     layeredBmp.AddOwnedLayer(AValue);
1883     if Assigned(AValue.XorMask) then
1884     begin
1885       mask := AValue.XorMask.Duplicate as TBGRABitmap;
1886       mask.AlphaFill(255);
1887       mask.ReplaceColor(BGRABlack,BGRAPixelTransparent);
1888       layeredBmp.LayerName[layeredBmp.AddOwnedLayer(mask,boXor)] := 'Xor';
1889       AValue.DiscardXorMask;
1890     end;
1891   end
1892   else
1893   begin
1894     layeredBmp.AddLayer(AValue);
1895     if Assigned(AValue.XorMask) then
1896     begin
1897       mask := AValue.XorMask.Duplicate as TBGRABitmap;
1898       mask.AlphaFill(255);
1899       mask.ReplaceColor(BGRABlack,BGRAPixelTransparent);
1900       layeredBmp.LayerName[layeredBmp.AddOwnedLayer(mask,boXor)] := 'Xor';
1901     end;
1902   end;
1903   if ACaption = '' then ACaption := rsLayer+'1';
1904   layeredBmp.LayerName[0] := ACaption;
1905   layeredBmp.LayerOpacity[0] := AOpacity;
1906   Assign(layeredBmp,True,AUndoable);
1907 end;
1908 
1909 procedure TLazPaintImage.Assign(const AValue: TBGRACustomLayeredBitmap;
1910   AOwned: boolean; AUndoable: boolean);
1911 var idx: integer;
1912 begin
1913   if not CheckNoAction then exit;
1914   if AValue.NbLayers = 0 then
1915   begin
1916     Assign(TBGRABitmap.Create(AValue.Width,AValue.Height),True,AUndoable);
1917     if AOwned then AValue.Free;
1918     exit;
1919   end;
1920   if AUndoable then
1921   begin
1922     idx := FCurrentState.SelectedImageLayerIndex;
1923     if idx > AValue.NbLayers-1 then idx := 0;
1924     AddUndo(FCurrentState.AssignWithUndo(AValue, AOwned, idx, nil, nil));
1925     ImageMayChangeCompletely;
1926     SelectionMaskMayChangeCompletely;
1927   end else
1928   begin
1929     FCurrentState.Assign(AValue, AOwned);
1930     FCurrentState.RemoveSelection;
1931     FCurrentState.saved := false;
1932     LayeredBitmapReplaced;
1933     ImageMayChangeCompletely;
1934     SelectionMaskMayChangeCompletely;
1935     ClearUndo;
1936   end;
1937 end;
1938 
1939 procedure TLazPaintImage.Assign(const AValue: TLayeredBitmapAndSelection;
1940   AOwned: boolean; AUndoable: boolean);
1941 begin
1942   if not CheckNoAction then exit;
1943   if AUndoable then
1944   begin
1945     AddUndo(FCurrentState.AssignWithUndo(AValue.layeredBitmap,AOwned,FCurrentState.SelectedImageLayerIndex,AValue.selection,AValue.selectionLayer));
1946     ImageMayChangeCompletely;
1947     SelectionMaskMayChangeCompletely;
1948   end
1949   else
1950   begin
1951     with AValue do
1952     begin
1953       Assign(layeredBitmap,AOwned,False);
1954       if not AOwned then
1955         ReplaceCurrentSelectionWithoutUndo(selection.Duplicate(True) as TBGRABitmap)
1956       else
1957         ReplaceCurrentSelectionWithoutUndo(selection);
1958       FCurrentState.ReplaceSelectionLayer(selectionLayer,AOwned);
1959     end;
1960   end;
1961   OnImageChanged.NotifyObservers;
1962 end;
1963 
1964 procedure TLazPaintImage.Draw(ADest: TBGRABitmap; x, y: integer);
1965 var bmp: TBGRABitmap;
1966 begin
1967   if (NbLayers = 1) and ((SelectionMask = nil) or (GetSelectedImageLayer = nil)) then
1968   begin
1969     if FCurrentState <> nil then
1970       FCurrentState.DrawLayers(ADest,x,y,IsIconCursor);
1971   end else
1972   begin
1973     bmp := RenderedImage;
1974     if bmp <> nil then
1975       if FCurrentState.LinearBlend then
1976         ADest.PutImage(x,y,bmp,dmLinearBlend)
1977       else
1978         ADest.PutImage(x,y,bmp,dmDrawWithTransparency);
1979   end;
1980 end;
1981 
1982 procedure TLazPaintImage.AddNewLayer;
1983 begin
1984   if not CheckNoAction then exit;
1985   try
1986     AddUndo(FCurrentState.AddNewLayer(TBGRABitmap.Create(1,1), '', Point(0,0), boTransparent));
1987     LayerBlendMayChange(CurrentLayerIndex);
1988   except on ex: exception do NotifyException('AddNewLayer',ex);
1989   end;
1990   OnImageChanged.NotifyObservers;
1991 end;
1992 
1993 procedure TLazPaintImage.AddNewLayer(AOriginal: TBGRALayerCustomOriginal;
1994   AName: string; ABlendOp: TBlendOperation; AMatrix: TAffineMatrix; AOpacity: byte);
1995 begin
1996   if not CheckNoAction then exit;
1997   try
1998     AddUndo(FCurrentState.AddNewLayer(AOriginal, AName, ABlendOp, AMatrix, AOpacity));
1999     ImageMayChangeCompletely;
2000   except on ex: exception do NotifyException('AddNewLayer',ex);
2001   end;
2002   OnImageChanged.NotifyObservers;
2003 end;
2004 
2005 procedure TLazPaintImage.AddNewLayer(ALayer: TBGRABitmap; AName: string; ABlendOp: TBlendOperation; AOpacity: byte);
2006 var temp: TBGRAbitmap;
2007 begin
2008   if not CheckNoAction then exit;
2009   try
2010     If (ALayer.Width > Width) or (ALayer.Height > Height) then
2011     begin
2012       temp := TBGRABitmap.Create(Width,Height);
2013       temp.PutImage((Width-ALayer.Width) div 2, (Height-ALayer.Height) div 2,ALayer,dmSet);
2014       ALayer.Free;
2015       ALayer := temp;
2016     end;
2017     AddUndo(FCurrentState.AddNewLayer(ALayer, AName,
2018       Point((Width - ALayer.Width) div 2, (Height - ALayer.Height) div 2),
2019       ABlendOp, AOpacity));
2020     ImageMayChangeCompletely;
2021   except on ex: exception do NotifyException('AddNewLayer',ex);
2022   end;
2023   OnImageChanged.NotifyObservers;
2024 end;
2025 
2026 procedure TLazPaintImage.AddNewLayer(ALayer: TBGRABitmap; AName: string;
2027   AOffset: TPoint; ABlendOp: TBlendOperation; AOpacity: byte);
2028 begin
2029   if not CheckNoAction then exit;
2030   try
2031     AddUndo(FCurrentState.AddNewLayer(ALayer, AName, AOffset, ABlendOp, AOpacity));
2032     ImageMayChangeCompletely;
2033   except on ex: exception do NotifyException('AddNewLayer',ex);
2034   end;
2035   OnImageChanged.NotifyObservers;
2036 end;
2037 
2038 procedure TLazPaintImage.DuplicateLayer;
2039 begin
2040   if not CheckNoAction then exit;
2041   try
2042     AddUndo(FCurrentState.DuplicateLayer);
2043     LayerBlendMayChange(CurrentLayerIndex);
2044     OnImageChanged.NotifyObservers;
2045   except on ex: exception do
2046     begin
2047       NotifyException('DuplicateLayer',ex);
2048       ImageMayChangeCompletely;
2049     end;
2050   end;
2051 end;
2052 
2053 procedure TLazPaintImage.RasterizeLayer;
2054 begin
2055   if LayerOriginalDefined[CurrentLayerIndex] then
2056   try
2057     AddUndo(FCurrentState.DiscardOriginal(True));
2058     OnImageChanged.NotifyObservers;
2059   except on ex: exception do NotifyException('RasterizeLayer',ex);
2060   end;
2061 end;
2062 
2063 procedure TLazPaintImage.MergeLayerOver;
2064 var
2065   remove: TCustomImageDifference;
2066   nextId: LongInt;
2067 begin
2068   if CurrentLayerIndex = 0 then exit;
2069   if not CheckNoAction then exit;
2070   try
2071     if LayerBitmap[CurrentLayerIndex].Empty then
2072     begin
2073       nextId := LayerId[CurrentLayerIndex-1];
2074       remove := FCurrentState.RemoveLayer;
2075       if remove is TRemoveLayerStateDifference then
2076         TRemoveLayerStateDifference(remove).nextActiveLayerId:= nextId;
2077       AddUndo(remove);
2078     end else
2079       AddUndo(FCurrentState.MergerLayerOver(CurrentLayerIndex));
2080   except on ex: exception do NotifyException('MergeLayerOver',ex);
2081   end;
2082   ImageMayChangeCompletely;
2083 end;
2084 
2085 procedure TLazPaintImage.PrepareForRendering;
2086 begin
2087   if FCurrentState <> nil then FCurrentState.PrepareForRendering;
2088 end;
2089 
MakeLayeredBitmapCopynull2090 function TLazPaintImage.MakeLayeredBitmapCopy: TBGRALayeredBitmap;
2091 begin
2092   result := FCurrentState.GetLayeredBitmapCopy;
2093 end;
2094 
ComputeFlatImagenull2095 function TLazPaintImage.ComputeFlatImage(AFromLayer, AToLayer: integer;
2096   ASeparateXorMask: boolean): TBGRABitmap;
2097 begin
2098   result := FCurrentState.ComputeFlatImage(AFromLayer,AToLayer,ASeparateXorMask);
2099 end;
2100 
2101 procedure TLazPaintImage.MoveLayer(AFromIndex, AToIndex: integer);
2102 begin
2103   if (AFromIndex < 0) or (AFromIndex >= NbLayers) then
2104     raise exception.Create('Index out of bounds');
2105   if AToIndex < 0 then AToIndex := 0;
2106   if AToIndex >= NbLayers then AToIndex := NbLayers-1;
2107   if AToIndex = AFromIndex then exit;
2108   if not CheckNoAction then exit;
2109   try
2110     LayerBlendMayChange(AToIndex);
2111     AddUndo(FCurrentState.MoveLayer(AFromIndex,AToIndex));
2112     LayerBlendMayChange(AToIndex);
2113   except on ex: exception do
2114     begin
2115       NotifyException('MoveLayer',ex);
2116       ImageMayChangeCompletely;
2117     end;
2118   end;
2119 end;
2120 
2121 procedure TLazPaintImage.RemoveLayer;
2122 begin
2123   if not CheckNoAction then exit;
2124   try
2125     AddUndo(FCurrentState.RemoveLayer);
2126   except on ex: exception do NotifyException('RemoveLayer',ex);
2127   end;
2128   ImageMayChangeCompletely;
2129 end;
2130 
2131 procedure TLazPaintImage.ClearLayer;
2132 begin
2133   if not CheckNoAction then exit;
2134   try
2135     AddUndo(FCurrentState.ClearLayer);
2136   except on ex: exception do NotifyException('ClearLayer',ex);
2137   end;
2138   ImageMayChangeCompletely;
2139 end;
2140 
2141 procedure TLazPaintImage.SaveOriginalToStream(AStream: TStream);
2142 begin
2143   FCurrentState.LayeredBitmap.SaveOriginalToStream(
2144     FCurrentState.LayeredBitmap.LayerOriginalGuid[CurrentLayerIndex],
2145     AStream);
2146 end;
2147 
2148 procedure TLazPaintImage.SwapRedBlue;
2149 begin
2150   if not CheckNoAction then exit;
2151   try
2152     AddUndo(FCurrentState.SwapRedBlue);
2153   except on ex: exception do NotifyException('SwapRedBlue',ex);
2154   end;
2155   ImageMayChangeCompletely;
2156 end;
2157 
2158 procedure TLazPaintImage.LinearNegativeAll;
2159 begin
2160   if not CheckNoAction then exit;
2161   try
2162     AddUndo(FCurrentState.LinearNegative);
2163   except on ex: exception do NotifyException('LinearNegativeAll',ex);
2164   end;
2165   ImageMayChangeCompletely;
2166 end;
2167 
2168 procedure TLazPaintImage.NegativeAll;
2169 begin
2170   if not CheckNoAction then exit;
2171   try
2172     AddUndo(FCurrentState.Negative);
2173   except on ex: exception do NotifyException('NegativeAll',ex);
2174   end;
2175   ImageMayChangeCompletely;
2176 end;
2177 
2178 procedure TLazPaintImage.HorizontalFlip;
2179 begin
2180   if not CheckNoAction then exit;
2181   try
2182     AddUndo(FCurrentState.HorizontalFlip);
2183   except on ex: exception do NotifyException('HorizontalFlip',ex);
2184   end;
2185   ImageMayChangeCompletely;
2186 end;
2187 
2188 procedure TLazPaintImage.HorizontalFlip(ALayerIndex: integer);
2189 begin
2190   if not CheckNoAction then exit;
2191   try
2192     AddUndo(FCurrentState.HorizontalFlip(ALayerIndex));
2193   except on ex: exception do NotifyException('HorizontalFlip',ex);
2194   end;
2195   ImageMayChangeCompletely;
2196 end;
2197 
2198 procedure TLazPaintImage.VerticalFlip;
2199 begin
2200   if not CheckNoAction then exit;
2201   try
2202     AddUndo(FCurrentState.VerticalFlip);
2203   except on ex: exception do NotifyException('VerticalFlip',ex);
2204   end;
2205   ImageMayChangeCompletely;
2206 end;
2207 
2208 procedure TLazPaintImage.VerticalFlip(ALayerIndex: integer);
2209 begin
2210   if not CheckNoAction then exit;
2211   try
2212     AddUndo(FCurrentState.VerticalFlip(ALayerIndex));
2213   except on ex: exception do NotifyException('VerticalFlip',ex);
2214   end;
2215   ImageMayChangeCompletely;
2216 end;
2217 
2218 procedure TLazPaintImage.RotateCW;
2219 begin
2220   if not CheckNoAction then exit;
2221   try
2222     AddUndo(FCurrentState.RotateCW);
2223   except on ex: exception do NotifyException('RotateCW',ex);
2224   end;
2225   ImageMayChangeCompletely;
2226   SelectionMaskMayChangeCompletely;
2227 end;
2228 
2229 procedure TLazPaintImage.RotateCCW;
2230 begin
2231   if not CheckNoAction then exit;
2232   try
2233     AddUndo(FCurrentState.RotateCCW);
2234   except on ex: exception do NotifyException('RotateCCW',ex);
2235   end;
2236   ImageMayChangeCompletely;
2237   SelectionMaskMayChangeCompletely;
2238 end;
2239 
2240 procedure TLazPaintImage.Rotate180;
2241 begin
2242   if not CheckNoAction then exit;
2243   try
2244     AddUndo(FCurrentState.Rotate180);
2245   except on ex: exception do NotifyException('Rotate180',ex);
2246   end;
2247   ImageMayChangeCompletely;
2248   SelectionMaskMayChangeCompletely;
2249 end;
2250 
CheckCurrentLayerVisiblenull2251 function TLazPaintImage.CheckCurrentLayerVisible: boolean;
2252 begin
2253   result := CurrentLayerVisible;
2254   if not result then
2255     MessagePopup(rsMustShowLayer,2000);
2256 end;
2257 
2258 procedure TLazPaintImage.ReplaceCurrentSelectionWithoutUndo(const AValue: TBGRABitmap);
2259 begin
2260   if FCurrentState.SelectionMask = AValue then exit;
2261   FCurrentState.SelectionMask.Free;
2262   FCurrentState.SelectionMask := AValue;
2263   SelectionMaskMayChangeCompletely;
2264 end;
2265 
2266 procedure TLazPaintImage.LayerActionNotifyChange(ASender: TObject;
2267   ALayer: TBGRABitmap; ARect: TRect);
2268 begin
2269   LayerMayChange(ALayer, ARect);
2270 end;
2271 
2272 procedure TLazPaintImage.LayerActionDestroy(Sender: TObject);
2273 begin
2274   if FActionInProgress = Sender then
2275     FActionInProgress := nil;
2276 end;
2277 
2278 procedure TLazPaintImage.ReleaseEmptySelection;
2279 begin
2280   if SelectionMaskEmpty and SelectionLayerIsEmpty then
2281     FCurrentState.ReplaceSelection(nil,nil);
2282 end;
2283 
CurrentLayerEmptynull2284 function TLazPaintImage.CurrentLayerEmpty: boolean;
2285 var
2286   selLayer: TBGRABitmap;
2287 begin
2288   selLayer := GetSelectedImageLayer;
2289   result := not Assigned(selLayer) or selLayer.Empty;
2290 end;
2291 
TLazPaintImage.CurrentLayerTransparentnull2292 function TLazPaintImage.CurrentLayerTransparent: boolean;
2293 var
2294   r: TRect;
2295   idx: Integer;
2296   y, x: LongInt;
2297   p: PBGRAPixel;
2298 begin
2299   r := rect(0,0, Width, height);
2300   idx := CurrentLayerIndex;
2301   if RectWithSize(LayerOffset[idx].x, LayerOffset[idx].y,
2302        LayerBitmap[idx].Width, LayerBitmap[idx].Height).Contains(r) then
2303   begin
2304     r.Offset(-LayerOffset[idx].x, -LayerOffset[idx].y);
2305     for y := r.Top to r.Bottom-1 do
2306     begin
2307       p := LayerBitmap[idx].ScanLine[y] + r.Left;
2308       for x := r.Left to r.Right-1 do
2309       begin
2310         if p^.alpha <> 255 then exit(true);
2311         inc(p);
2312       end;
2313     end;
2314     result := false;
2315   end else
2316     result := true;
2317 end;
2318 
CurrentLayerEqualsnull2319 function TLazPaintImage.CurrentLayerEquals(AColor: TBGRAPixel): boolean;
2320 begin
2321   result := GetSelectedImageLayer.Equals(AColor);
2322 end;
2323 
TLazPaintImage.GetSelectionMaskCenternull2324 function TLazPaintImage.GetSelectionMaskCenter: TPointF;
2325 begin
2326   result := ugraph.GetSelectionCenter(SelectionMask);
2327 end;
2328 
2329 procedure TLazPaintImage.SaveSelectionMaskToFileUTF8(AFilename: string);
2330 var s: TStream;
2331 begin
2332   if SelectionMask = nil then exit;
2333   try
2334     s := FileManager.CreateFileStream(AFilename, fmCreate);
2335     try
2336       SelectionMask.SaveToStreamAs(s, SuggestImageFormat(AFilename));
2337     finally
2338       s.Free;
2339     end;
2340   except on ex: exception do NotifyException('SaveSelectionToFile',ex);
2341   end;
2342 end;
2343 
SelectionMaskReadonlynull2344 function TLazPaintImage.SelectionMaskReadonly: TBGRABitmap;
2345 begin
2346   result := SelectionMask;
2347 end;
2348 
TLazPaintImage.SelectionLayerReadonlynull2349 function TLazPaintImage.SelectionLayerReadonly: TBGRABitmap;
2350 begin
2351   result := FCurrentState.SelectionLayer;
2352 end;
2353 
CurrentLayerReadOnlynull2354 function TLazPaintImage.CurrentLayerReadOnly: TBGRABitmap;
2355 begin
2356   result := GetSelectedImageLayer;
2357 end;
2358 
2359 procedure TLazPaintImage.SetLayerRegistry(ALayerIndex: integer;
2360   AIdentifier: string; AValue: RawByteString);
2361 begin
2362   AddUndo(TSetLayerRegistryDifference.Create(FCurrentState, LayerId[ALayerIndex], AIdentifier, AValue, true));
2363 end;
2364 
GetLayerRegistrynull2365 function TLazPaintImage.GetLayerRegistry(ALayerIndex: integer;
2366   AIdentifier: string): RawByteString;
2367 begin
2368   result := FCurrentState.LayeredBitmap.GetLayerRegistry(ALayerIndex, AIdentifier);
2369 end;
2370 
2371 procedure TLazPaintImage.SetRegistry(AIdentifier: string;
2372   AValue: RawByteString);
2373 begin
2374   AddUndo(TSetImageRegistryDifference.Create(FCurrentState, AIdentifier, AValue, true));
2375 end;
2376 
GetRegistrynull2377 function TLazPaintImage.GetRegistry(AIdentifier: string): RawByteString;
2378 begin
2379   result := FCurrentState.LayeredBitmap.GetGlobalRegistry(AIdentifier);
2380 end;
2381 
TLazPaintImage.GetLayerIndexByIdnull2382 function TLazPaintImage.GetLayerIndexById(AId: integer): integer;
2383 begin
2384   result := FCurrentState.LayeredBitmap.GetLayerIndexFromId(AId);
2385 end;
2386 
TLazPaintImage.GetLayerIndexByGuidnull2387 function TLazPaintImage.GetLayerIndexByGuid(AGuid: TGuid): integer;
2388 var
2389   guidStr: String;
2390   i: Integer;
2391 begin
2392   guidStr := GUIDToString(AGuid);
2393   for i := 0 to NbLayers-1 do
2394     if CompareText(GetLayerRegistry(i, 'guid'),guidStr)=0 then exit(i);
2395   exit(-1);
2396 end;
2397 
2398 constructor TLazPaintImage.Create(ALazPaintInstance: TObject);
2399 begin
2400   FLazPaintInstance := ALazPaintInstance;
2401   FCurrentState := TImageState.Create;
2402   FCurrentState.OnOriginalChange:= @OriginalChange;
2403   FCurrentState.OnOriginalEditingChange:= @OriginalEditingChange;
2404   FCurrentState.OnOriginalLoadError:=@OriginalLoadError;
2405   FCurrentState.OnActionProgress:= @LayeredActionProgress;
2406   FCurrentState.OnActionDone:=@LayeredActionDone;
2407   FCurrentState.OnSizeChanged:=@LayeredSizeChanged;
2408   FRenderUpdateRectInPicCoord := rect(0,0,0,0);
2409   FRenderUpdateRectInVSCoord := rect(0,0,0,0);
2410   FOnSelectionMaskChanged := nil;
2411   FOnSelectedLayerIndexChanged := nil;
2412   FOnStackChanged := nil;
2413   FOnImageChanged := TLazPaintImageObservable.Create(self);
2414   FOnImageSaving := TLazPaintImageObservable.Create(self);
2415   FOnImageExport := TLazPaintImageObservable.Create(self);
2416   FUndoList := TComposedImageDifference.Create;
2417   FUndoPos := -1;
2418   ImageOffset := Point(0,0);
2419   FrameIndex := -1;
2420   FrameCount := 0;
2421 end;
2422 
2423 destructor TLazPaintImage.Destroy;
2424 begin
2425   ClearUndo;
2426   FUndoList.Free;
2427   FreeAndNil(FRenderedImage);
2428   FCurrentState.Free;
2429   FOnImageChanged.Free;
2430   FOnImageSaving.Free;
2431   FOnImageExport.Free;
2432   FSelectionLayerAfterMask.Free;
2433   inherited Destroy;
2434 end;
2435 
2436 initialization
2437 
2438   RegisterPaintNetFormat;
2439   RegisterOpenRasterFormat;
2440   RegisterPhoxoFormat;
2441   RegisterLazPaintFormat;
2442   BGRAColorQuantizerFactory := TBGRAColorQuantizer;
2443 
2444 end.
2445