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