1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRALayers;
3 
4 {$mode objfpc}{$H+}
5 {$MODESWITCH ADVANCEDRECORDS}
6 
7 interface
8 
9 uses
10   BGRAGraphics, BGRAClasses, SysUtils, BGRABitmapTypes, BGRABitmap,
11   BGRAMemDirectory, BGRATransform, fgl, BGRALayerOriginal;
12 
13 type
14   TBGRACustomLayeredBitmap = class;
15   TBGRACustomLayeredBitmapClass = class of TBGRACustomLayeredBitmap;
16 
17   { TBGRALayerOriginalEntry }
18 
19   TBGRALayerOriginalEntry = record
20      Guid: TGuid;
21      Instance: TBGRALayerCustomOriginal;
22      class operator = (const AEntry1,AEntry2: TBGRALayerOriginalEntry): boolean;
23   end;
24 
BGRALayerOriginalEntrynull25 function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry;
BGRALayerOriginalEntrynull26 function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry;
27 
28 type
29   TBGRALayerOriginalList = specialize TFPGList<TBGRALayerOriginalEntry>;
30 
31   TBGRALayeredBitmap = class;
32   TBGRALayeredBitmapClass = class of TBGRALayeredBitmap;
33 
34   TBGRALayeredBitmapSaveToStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
35   TBGRALayeredBitmapLoadFromStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
Streamnull36   TBGRALayeredBitmapCheckStreamProc = function(AStream: TStream): boolean;
37   TOriginalRenderStatus = (orsNone, orsDraft, orsPartialDraft, orsProof, orsPartialProof);
38 
39   { TBGRACustomLayeredBitmap }
40 
41   TBGRACustomLayeredBitmap = class(TGraphic)
42   private
43     FFrozenRange: array of record
44       firstLayer,lastLayer: integer;
45       image: TBGRABitmap;
46       linearBlend: boolean;
47     end;
48     FLinearBlend: boolean;
49     FMemDirectory: TMemDirectory;
50     FMemDirectoryOwned: boolean;
51     FSelectionDrawMode: TDrawMode;
52     FSelectionLayerIndex: integer;
53     FSelectionRect: TRect;
54     FSelectionScanner: IBGRAScanner;
55     FSelectionScannerOffset: TPoint;
GetDefaultBlendingOperationnull56     function GetDefaultBlendingOperation: TBlendOperation;
GetHasMemFilesnull57     function GetHasMemFiles: boolean;
GetLinearBlendnull58     function GetLinearBlend: boolean;
GetSelectionVisiblenull59     function GetSelectionVisible: boolean;
60     procedure SetLinearBlend(AValue: boolean);
61 
62   protected
GetNbLayersnull63     function GetNbLayers: integer; virtual; abstract;
GetMemDirectorynull64     function GetMemDirectory: TMemDirectory;
GetBlendOperationnull65     function GetBlendOperation(Layer: integer): TBlendOperation; virtual; abstract;
GetLayerVisiblenull66     function GetLayerVisible(layer: integer): boolean; virtual; abstract;
GetLayerOpacitynull67     function GetLayerOpacity(layer: integer): byte; virtual; abstract;
GetLayerNamenull68     function GetLayerName(layer: integer): string; virtual;
GetLayerOffsetnull69     function GetLayerOffset(layer: integer): TPoint; virtual;
GetLayerFrozenRangenull70     function GetLayerFrozenRange(layer: integer): integer;
GetLayerFrozennull71     function GetLayerFrozen(layer: integer): boolean; virtual;
GetLayerUniqueIdnull72     function GetLayerUniqueId(layer: integer): integer; virtual;
GetLayerOriginalnull73     function GetLayerOriginal({%H-}layer: integer): TBGRALayerCustomOriginal; virtual;
GetLayerOriginalKnownnull74     function GetLayerOriginalKnown({%H-}layer: integer): boolean; virtual;
GetLayerOriginalMatrixnull75     function GetLayerOriginalMatrix({%H-}layer: integer): TAffineMatrix; virtual;
GetLayerOriginalGuidnull76     function GetLayerOriginalGuid({%H-}layer: integer): TGuid; virtual;
GetLayerOriginalRenderStatusnull77     function GetLayerOriginalRenderStatus({%H-}layer: integer): TOriginalRenderStatus; virtual;
GetOriginalCountnull78     function GetOriginalCount: integer; virtual;
GetOriginalByIndexnull79     function GetOriginalByIndex({%H-}AIndex: integer): TBGRALayerCustomOriginal; virtual;
GetOriginalByIndexKnownnull80     function GetOriginalByIndexKnown({%H-}AIndex: integer): boolean; virtual;
GetOriginalByIndexLoadednull81     function GetOriginalByIndexLoaded({%H-}AIndex: integer): boolean; virtual;
GetOriginalByIndexClassnull82     function GetOriginalByIndexClass({%H-}AIndex: integer): TBGRALayerOriginalAny; virtual;
GetTransparentnull83     function GetTransparent: Boolean; override;
GetEmptynull84     function GetEmpty: boolean; override;
85 
IndexOfOriginalnull86     function IndexOfOriginal(const AGuid: TGuid): integer; overload; virtual;
IndexOfOriginalnull87     function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; virtual;
88 
89     procedure SetWidth(Value: Integer); override;
90     procedure SetHeight(Value: Integer); override;
91     procedure SetMemDirectory(AValue: TMemDirectory);
92     procedure SetTransparent(Value: Boolean); override;
93 
94     procedure SetLayerFrozen(layer: integer; AValue: boolean); virtual;
RangeIntersectnull95     function RangeIntersect(first1,last1,first2,last2: integer): boolean;
96     procedure RemoveFrozenRange(index: integer);
ContainsFrozenRangenull97     function ContainsFrozenRange(first,last: integer): boolean;
GetLayerDrawModenull98     function GetLayerDrawMode(AIndex: integer): TDrawMode;
99 
100   public
101     procedure SaveToFile(const filenameUTF8: string); override;
102     procedure SaveToStream(Stream: TStream); override;
103     procedure SaveToStreamAs(Stream: TStream; AExtension: string);
104     constructor Create; override;
105     destructor Destroy; override;
ToStringnull106     function ToString: ansistring; override;
107     procedure DiscardSelection;
GetLayerBitmapDirectlynull108     function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual;
GetLayerBitmapCopynull109     function GetLayerBitmapCopy(layer: integer): TBGRABitmap; virtual; abstract;
ComputeFlatImagenull110     function ComputeFlatImage(ASeparateXorMask: boolean = false): TBGRABitmap; overload;
ComputeFlatImagenull111     function ComputeFlatImage(firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload;
ComputeFlatImagenull112     function ComputeFlatImage(ARect: TRect; ASeparateXorMask: boolean = false): TBGRABitmap; overload;
ComputeFlatImagenull113     function ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload;
114     procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; overload;
115     procedure Draw(Canvas: TCanvas; x,y: integer); overload;
116     procedure Draw(Canvas: TCanvas; x,y: integer; firstLayer, lastLayer: integer); overload;
117     procedure Draw(Dest: TBGRABitmap; x,y: integer); overload;
118     procedure Draw(Dest: TBGRABitmap; x,y: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean = false); overload;
119     procedure Draw(Dest: TBGRABitmap; AX,AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false; ADestinationEmpty: boolean = false); overload;
DrawLayernull120     function DrawLayer(Dest: TBGRABitmap; X,Y: Integer; AIndex: integer; ASeparateXorMask: boolean = false; ADestinationEmpty: boolean = false): boolean;
121 
122     procedure FreezeExceptOneLayer(layer: integer); overload;
123     procedure Freeze(firstLayer, lastLayer: integer); overload;
124     procedure Freeze; overload;
125     procedure Unfreeze; overload;
126     procedure Unfreeze(layer: integer); overload;
127     procedure Unfreeze(firstLayer, lastLayer: integer); overload;
128 
129     procedure NotifyLoaded; virtual;
130     procedure NotifySaving; virtual;
131 
132     property NbLayers: integer read GetNbLayers;
133     property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation;
134     property LayerVisible[layer: integer]: boolean read GetLayerVisible;
135     property LayerOpacity[layer: integer]: byte read GetLayerOpacity;
136     property LayerName[layer: integer]: string read GetLayerName;
137     property LayerOffset[layer: integer]: TPoint read GetLayerOffset;
138     property LayerFrozen[layer: integer]: boolean read GetLayerFrozen;
139     property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId;
140     property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal;
141     property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown;
142     property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid;
143     property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix;
144     property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus;
145     property SelectionScanner: IBGRAScanner read FSelectionScanner write FSelectionScanner;
146     property SelectionScannerOffset: TPoint read FSelectionScannerOffset write FSelectionScannerOffset;
147     property SelectionRect: TRect read FSelectionRect write FSelectionRect;
148     property SelectionLayerIndex: integer read FSelectionLayerIndex write FSelectionLayerIndex;
149     property SelectionDrawMode: TDrawMode read FSelectionDrawMode write FSelectionDrawMode;
150     property SelectionVisible: boolean read GetSelectionVisible;
151     property LinearBlend: boolean read GetLinearBlend write SetLinearBlend; //use linear blending unless specified
152     property DefaultBlendingOperation: TBlendOperation read GetDefaultBlendingOperation;
153     property MemDirectory: TMemDirectory read GetMemDirectory write SetMemDirectory;
154     property MemDirectoryOwned: boolean read FMemDirectoryOwned write FMemDirectoryOwned;
155     property HasMemFiles: boolean read GetHasMemFiles;
156   end;
157 
158   TEmbeddedOriginalChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal;
159                                             var ADiff: TBGRAOriginalDiff) of object;
160   TEmbeddedOriginalEditingChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal) of object;
161   TLayeredActionProgressEvent = procedure(ASender: TObject; AProgressPercent: integer) of object;
162   TEmbeddedOriginalLoadErrorEvent = procedure (ASender: TObject; AError: string; var ARaise: boolean) of object;
163 
164   TBGRALayerInfo = record
165     UniqueId: integer;
166     Name: string;
167     x, y: integer;
168     Source: TBGRABitmap;
169     blendOp: TBlendOperation;
170     Opacity: byte;
171     Visible: boolean;
172     Owner: boolean;
173     Frozen: boolean;
174     OriginalMatrix: TAffineMatrix;
175     OriginalRenderStatus: TOriginalRenderStatus;
176     OriginalGuid: TGuid;
177     OriginalInvalidatedBounds: TRectF;
178   end;
179 
180   { TBGRALayeredBitmap }
181 
182   TBGRALayeredBitmap = class(TBGRACustomLayeredBitmap)
183   private
184     FNbLayers: integer;
185     FLayers: array of TBGRALayerInfo;
186     FOnActionDone: TNotifyEvent;
187     FOnEditorFocusChanged: TNotifyEvent;
188     FEditorFocused: boolean;
189     FOnActionProgress: TLayeredActionProgressEvent;
190     FOnOriginalLoadError: TEmbeddedOriginalLoadErrorEvent;
191     FOriginalChange: TEmbeddedOriginalChangeEvent;
192     FOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent;
193     FWidth,FHeight: integer;
194     FOriginals: TBGRALayerOriginalList;
195     FOriginalEditor: TBGRAOriginalEditor;
196     FOriginalEditorOriginal: TGuid;
197     FOriginalEditorViewMatrix: TAffineMatrix;
198     procedure EditorFocusedChanged({%H-}Sender: TObject);
GetLayerOriginalClassnull199     function GetLayerOriginalClass(layer: integer): TBGRALayerOriginalAny;
GetOriginalEditornull200     function GetOriginalEditor: TBGRAOriginalEditor;
GetOriginalGuidnull201     function GetOriginalGuid(AIndex: integer): TGUID;
202     procedure SetEditorFocused(AValue: boolean);
203     procedure SetOnActionDone(AValue: TNotifyEvent);
204     procedure SetOnActionProgress(AValue: TLayeredActionProgressEvent);
205 
206   protected
GetWidthnull207     function GetWidth: integer; override;
GetHeightnull208     function GetHeight: integer; override;
GetNbLayersnull209     function GetNbLayers: integer; override;
GetBlendOperationnull210     function GetBlendOperation(Layer: integer): TBlendOperation; override;
GetLayerVisiblenull211     function GetLayerVisible(layer: integer): boolean; override;
GetLayerOpacitynull212     function GetLayerOpacity(layer: integer): byte; override;
GetLayerOffsetnull213     function GetLayerOffset(layer: integer): TPoint; override;
GetLayerNamenull214     function GetLayerName(layer: integer): string; override;
GetLayerFrozennull215     function GetLayerFrozen(layer: integer): boolean; override;
GetLayerUniqueIdnull216     function GetLayerUniqueId(layer: integer): integer; override;
GetLayerOriginalnull217     function GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; override;
GetLayerOriginalKnownnull218     function GetLayerOriginalKnown(layer: integer): boolean; override;
GetLayerOriginalMatrixnull219     function GetLayerOriginalMatrix(layer: integer): TAffineMatrix; override;
GetLayerOriginalGuidnull220     function GetLayerOriginalGuid(layer: integer): TGuid; override;
GetLayerOriginalRenderStatusnull221     function GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus; override;
GetOriginalCountnull222     function GetOriginalCount: integer; override;
GetOriginalByIndexnull223     function GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal; override;
GetOriginalByIndexKnownnull224     function GetOriginalByIndexKnown(AIndex: integer): boolean; override;
GetOriginalByIndexLoadednull225     function GetOriginalByIndexLoaded(AIndex: integer): boolean; override;
GetOriginalByIndexClassnull226     function GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny; override;
227     procedure SetBlendOperation(Layer: integer; op: TBlendOperation);
228     procedure SetLayerVisible(layer: integer; AValue: boolean);
229     procedure SetLayerOpacity(layer: integer; AValue: byte);
230     procedure SetLayerOffset(layer: integer; AValue: TPoint);
231     procedure SetLayerName(layer: integer; AValue: string);
232     procedure SetLayerFrozen(layer: integer; AValue: boolean); override;
233     procedure SetLayerUniqueId(layer: integer; AValue: integer);
234     procedure SetLayerOriginalMatrix(layer: integer; AValue: TAffineMatrix);
235     procedure SetLayerOriginalGuid(layer: integer; const AValue: TGuid);
236     procedure SetLayerOriginalRenderStatus(layer: integer; AValue: TOriginalRenderStatus);
237 
238     procedure FindOriginal(AGuid: TGuid;
239                 out ADir: TMemDirectory;
240                 out AClass: TBGRALayerOriginalAny);
241     procedure StoreOriginal(AOriginal: TBGRALayerCustomOriginal);
242     procedure OriginalChange(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff);
243     procedure OriginalEditingChange(ASender: TObject);
GetLayerDirectorynull244     function GetLayerDirectory(ALayerIndex: integer; ACanCreate: boolean): TMemDirectory;
245     procedure UpdateOriginalEditor(ALayerIndex: integer; AMatrix: TAffineMatrix;
246       APointSize: single);
247 
248   public
249     procedure LoadFromFile(const filenameUTF8: string); override;
250     procedure LoadFromStream(stream: TStream); override;
251     procedure LoadFromResource(AFilename: string);
252     procedure SetSize(AWidth, AHeight: integer); virtual;
253     procedure Clear; override;
254     procedure ClearOriginals;
255     procedure RemoveLayer(index: integer);
256     procedure InsertLayer(index: integer; fromIndex: integer);
257     procedure Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean = false;
258                 ACopyAdditionalMemData: boolean = false); overload;
MoveLayerUpnull259     function MoveLayerUp(index: integer): integer;
MoveLayerDownnull260     function MoveLayerDown(index: integer): integer;
261 
AddLayernull262     function AddLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload;
AddLayernull263     function AddLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload;
AddLayernull264     function AddLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
AddLayernull265     function AddLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddLayernull266     function AddLayer(AName: string; Source: TBGRABitmap; Opacity: byte = 255): integer; overload;
AddLayernull267     function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload;
AddLayernull268     function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
AddLayernull269     function AddLayer(AName: string; Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddSharedLayernull270     function AddSharedLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload;
AddSharedLayernull271     function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddSharedLayernull272     function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
AddSharedLayernull273     function AddSharedLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddLayerFromFilenull274     function AddLayerFromFile(AFileName: string; Opacity: byte = 255): integer; overload;
AddLayerFromFilenull275     function AddLayerFromFile(AFileName: string; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddLayerFromFilenull276     function AddLayerFromFile(AFileName: string; Position: TPoint; Opacity: byte = 255): integer; overload;
AddLayerFromFilenull277     function AddLayerFromFile(AFileName: string; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddOwnedLayernull278     function AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte = 255): integer; overload;
AddOwnedLayernull279     function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddOwnedLayernull280     function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
AddOwnedLayernull281     function AddOwnedLayer(ABitmap: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddLayerFromOriginalnull282     function AddLayerFromOriginal(const AGuid: TGuid; Opacity: byte = 255): integer; overload;
AddLayerFromOriginalnull283     function AddLayerFromOriginal(const AGuid: TGuid; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddLayerFromOriginalnull284     function AddLayerFromOriginal(const AGuid: TGuid; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload;
AddLayerFromOriginalnull285     function AddLayerFromOriginal(const AGuid: TGuid; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddLayerFromOwnedOriginalnull286     function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Opacity: byte = 255): integer; overload;
AddLayerFromOwnedOriginalnull287     function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
AddLayerFromOwnedOriginalnull288     function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload;
AddLayerFromOwnedOriginalnull289     function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
290 
IsValidRegistryIndentifiernull291     class function IsValidRegistryIndentifier(AIdentifier: string): boolean;
GetLayerRegistrynull292     function GetLayerRegistry(ALayerIndex: integer; ARegistryIdentifier: string): RawByteString;
293     procedure SetLayerRegistry(ALayerIndex: integer; ARegistryIdentifier: string; AValue: RawByteString);
294     procedure SaveLayerRegistryToStream(ALayerIndex: integer; AStream: TStream);
295     procedure LoadLayerRegistryFromStream(ALayerIndex: integer; AStream: TStream);
GetGlobalRegistrynull296     function GetGlobalRegistry(ARegistryIdentifier: string): RawByteString;
297     procedure SetGlobalRegistry(ARegistryIdentifier: string; AValue: RawByteString);
298 
AddOriginalnull299     function AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean = true): integer;
AddOriginalFromStreamnull300     function AddOriginalFromStream(AStream: TStream; ALateLoad: boolean = false): integer; overload;
AddOriginalFromStreamnull301     function AddOriginalFromStream(AStream: TStream; const AGuid: TGuid; ALateLoad: boolean = false): integer; overload;
AddOriginalFromStoragenull302     function AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean = false): integer; overload;
AddOriginalFromStoragenull303     function AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; const AGuid: TGuid; ALateLoad: boolean = false): integer; overload;
304     procedure SaveOriginalToStream(AIndex: integer; AStream: TStream); overload;
305     procedure SaveOriginalToStream(const AGuid: TGuid; AStream: TStream); overload;
RemoveOriginalnull306     function RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean;
307     procedure DeleteOriginal(AIndex: integer);
308     procedure NotifyLoaded; override;
309     procedure NotifySaving; override;
310     procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean = false; AFullSizeLayer: boolean = false); overload;
311     procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false); overload;
312     procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false); overload;
313     procedure RenderLayerFromOriginalIfNecessary(layer: integer; ADraft: boolean; var ABounds: TRect);
RenderOriginalsIfNecessarynull314     function RenderOriginalsIfNecessary(ADraft: boolean = false): TRect;
RenderOriginalIfNecessarynull315     function RenderOriginalIfNecessary(const AGuid: TGuid; ADraft: boolean = false): TRect;
316     procedure RemoveUnusedOriginals;
317     procedure UnloadOriginals;
318     procedure UnloadOriginal(AIndex: integer); overload;
319     procedure UnloadOriginal(const AGuid: TGuid); overload;
320 
321     destructor Destroy; override;
322     constructor Create; overload; override;
323     constructor Create(AWidth, AHeight: integer); overload; virtual;
GetLayerBitmapDirectlynull324     function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override;
GetLayerBitmapCopynull325     function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override;
GetLayerIndexFromIdnull326     function GetLayerIndexFromId(AIdentifier: integer): integer;
Duplicatenull327     function Duplicate(ASharedLayerIds: boolean = false): TBGRALayeredBitmap;
ProduceLayerUniqueIdnull328     function ProduceLayerUniqueId: integer;
329 
330     procedure RotateCW;
331     procedure RotateCCW;
332     procedure RotateUD; overload;
333     procedure RotateUD(ALayerIndex: integer); overload;
334     procedure HorizontalFlip; overload;
335     procedure HorizontalFlip(ALayerIndex: integer); overload;
336     procedure VerticalFlip; overload;
337     procedure VerticalFlip(ALayerIndex: integer); overload;
338     procedure Resample(AWidth, AHeight: integer; AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter = rfLinear);
339     procedure SetLayerBitmap(layer: integer; ABitmap: TBGRABitmap; AOwned: boolean);
TakeLayerBitmapnull340     function TakeLayerBitmap(layer: integer): TBGRABitmap;
341     procedure ApplyLayerOffset(ALayerIndex: integer; APadWithTranparentPixels: boolean);
342 
DrawEditornull343     function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload;
DrawEditornull344     function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload;
GetEditorBoundsnull345     function GetEditorBounds(ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload;
GetEditorBoundsnull346     function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload;
GetEditorBoundsnull347     function GetEditorBounds(ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload;
GetEditorBoundsnull348     function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload;
349     procedure ClearEditor;
350     procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
351     procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
352     procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
353     procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
354     procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
355     procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
356     procedure KeyDown(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean);
357     procedure KeyUp(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean);
358     procedure KeyPress(UTF8Key: string; out AHandled: boolean);
359 
360     property Width : integer read GetWidth;
361     property Height: integer read GetHeight;
362     property NbLayers: integer read GetNbLayers;
363     property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation write SetBlendOperation;
364     property LayerVisible[layer: integer]: boolean read GetLayerVisible write SetLayerVisible;
365     property LayerOpacity[layer: integer]: byte read GetLayerOpacity write SetLayerOpacity;
366     property LayerName[layer: integer]: string read GetLayerName write SetLayerName;
367     property LayerBitmap[layer: integer]: TBGRABitmap read GetLayerBitmapDirectly;
368     property LayerOffset[layer: integer]: TPoint read GetLayerOffset write SetLayerOffset;
369     property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId write SetLayerUniqueId;
370     property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal;
371     property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown;
372     property LayerOriginalClass[layer: integer]: TBGRALayerOriginalAny read GetLayerOriginalClass;
373     property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid write SetLayerOriginalGuid;
374     property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix write SetLayerOriginalMatrix;
375     property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus write SetLayerOriginalRenderStatus;
376 
IndexOfOriginalnull377     function IndexOfOriginal(const AGuid: TGuid): integer; overload; override;
IndexOfOriginalnull378     function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; override;
379     property OriginalCount: integer read GetOriginalCount;
380     property Original[AIndex: integer]: TBGRALayerCustomOriginal read GetOriginalByIndex;
381     property OriginalGuid[AIndex: integer]: TGUID read GetOriginalGuid;
382     property OriginalKnown[AIndex: integer]: boolean read GetOriginalByIndexKnown;
383     property OriginalClass[AIndex: integer]: TBGRALayerOriginalAny read GetOriginalByIndexClass;
384     property OnOriginalChange: TEmbeddedOriginalChangeEvent read FOriginalChange write FOriginalChange;
385     property OnOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent read FOriginalEditingChange write FOriginalEditingChange;
386     property OnOriginalLoadError: TEmbeddedOriginalLoadErrorEvent read FOnOriginalLoadError write FOnOriginalLoadError;
387     property EditorFocused: boolean read FEditorFocused write SetEditorFocused;
388     property OnEditorFocusChanged: TNotifyEvent read FOnEditorFocusChanged write FOnEditorFocusChanged;
389     property OriginalEditor: TBGRAOriginalEditor read GetOriginalEditor;
390     property OnActionProgress: TLayeredActionProgressEvent read FOnActionProgress write SetOnActionProgress;
391     property OnActionDone: TNotifyEvent read FOnActionDone write SetOnActionDone;
392   end;
393 
394   TAffineMatrix = BGRABitmapTypes.TAffineMatrix;
395 
396 procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
397 procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
TryCreateLayeredBitmapWriternull398 function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap;
TryCreateLayeredBitmapReadernull399 function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap;
400 
401 var
402   LayeredBitmapSaveToStreamProc : TBGRALayeredBitmapSaveToStreamProc;
403   LayeredBitmapLoadFromStreamProc : TBGRALayeredBitmapLoadFromStreamProc;
404   LayeredBitmapCheckStreamProc: TBGRALayeredBitmapCheckStreamProc;
405 
406 type
407   TOnLayeredBitmapLoadStartProc = procedure(AFilenameUTF8: string) of object;
408   TOnLayeredBitmapLoadProgressProc = procedure(APercentage: integer) of object;
409   TOnLayeredBitmapLoadedProc = procedure() of object;
410 
411 procedure OnLayeredBitmapLoadFromStreamStart;
412 procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
413 procedure OnLayeredBitmapLoadProgress(APercentage: integer);
414 procedure OnLayeredBitmapLoaded;
415 procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
416      ADone: TOnLayeredBitmapLoadedProc);
417 procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
418      ADone: TOnLayeredBitmapLoadedProc);
419 
420 type
421   TOnLayeredBitmapSaveStartProc = procedure(AFilenameUTF8: string) of object;
422   TOnLayeredBitmapSaveProgressProc = procedure(APercentage: integer) of object;
423   TOnLayeredBitmapSavedProc = procedure() of object;
424 
425 procedure OnLayeredBitmapSaveToStreamStart;
426 procedure OnLayeredBitmapSaveStart(AFilenameUTF8: string);
427 procedure OnLayeredBitmapSaveProgress(APercentage: integer);
428 procedure OnLayeredBitmapSaved;
429 procedure RegisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; AProgress: TOnLayeredBitmapSaveProgressProc;
430      ADone: TOnLayeredBitmapSavedProc);
431 procedure UnregisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc; AProgress: TOnLayeredBitmapSaveProgressProc;
432      ADone: TOnLayeredBitmapSavedProc);
433 
434 const
435   RenderTempSubDirectory = 'temp';
436 
437 implementation
438 
439 uses BGRAUTF8, BGRABlend, BGRAMultiFileType, math;
440 
441 const
442   OriginalsDirectory = 'originals';
443   LayersDirectory = 'layers';
444   RenderSubDirectory = 'render';
445   RegistrySubDirectory = 'registry';
446 
447 type
448   TOnLayeredBitmapLoadStartProcList = specialize TFPGList<TOnLayeredBitmapLoadStartProc>;
449   TOnLayeredBitmapLoadProgressProcList = specialize TFPGList<TOnLayeredBitmapLoadProgressProc>;
450   TOnLayeredBitmapLoadedProcList = specialize TFPGList<TOnLayeredBitmapLoadedProc>;
451   TOnLayeredBitmapSaveStartProcList = specialize TFPGList<TOnLayeredBitmapSaveStartProc>;
452   TOnLayeredBitmapSaveProgressProcList = specialize TFPGList<TOnLayeredBitmapSaveProgressProc>;
453   TOnLayeredBitmapSavedProcList = specialize TFPGList<TOnLayeredBitmapSavedProc>;
454 
455 var
456   LayeredBitmapLoadEvents: record
457     OnStart: TOnLayeredBitmapLoadStartProcList;
458     OnProgress: TOnLayeredBitmapLoadProgressProcList;
459     OnDone: TOnLayeredBitmapLoadedProcList;
460   end;
461   LayeredBitmapSaveEvents: record
462     OnStart: TOnLayeredBitmapSaveStartProcList;
463     OnProgress: TOnLayeredBitmapSaveProgressProcList;
464     OnDone: TOnLayeredBitmapSavedProcList;
465   end;
466 
467 var
468   NextLayerUniqueId: LongWord;
469   LayeredBitmapReaders: array of record
470      extension: string;
471      theClass: TBGRACustomLayeredBitmapClass;
472   end;
473   LayeredBitmapWriters: array of record
474      extension: string;
475      theClass: TBGRALayeredBitmapClass;
476   end;
477 
478 { TBGRALayerOriginalEntry }
479 
480 class operator TBGRALayerOriginalEntry.=(const AEntry1,
481   AEntry2: TBGRALayerOriginalEntry): boolean;
482 begin
483   result := AEntry1.Guid = AEntry2.Guid;
484 end;
485 
BGRALayerOriginalEntrynull486 function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry;
487 begin
488   result.Guid := AGuid;
489   result.Instance := nil;
490 end;
491 
BGRALayerOriginalEntrynull492 function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry;
493 begin
494   result.Guid := AInstance.Guid;
495   result.Instance := AInstance;
496 end;
497 
498 { TBGRALayeredBitmap }
499 
GetLayerUniqueIdnull500 function TBGRALayeredBitmap.GetLayerUniqueId(layer: integer): integer;
501 begin
502   if (layer < 0) or (layer >= NbLayers) then
503     raise Exception.Create('Index out of bounds')
504   else
505     Result:= FLayers[layer].UniqueId;
506 end;
507 
TBGRALayeredBitmap.GetLayerOriginalnull508 function TBGRALayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal;
509 var
510   idxOrig: Integer;
511 begin
512   if (layer < 0) or (layer >= NbLayers) then
513     raise Exception.Create('Index out of bounds')
514   else
515   begin
516     if FLayers[layer].OriginalGuid = GUID_NULL then exit(nil);
517     idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid);
518     if idxOrig = -1 then exit(nil);
519     result := Original[idxOrig];
520   end;
521 end;
522 
TBGRALayeredBitmap.GetLayerOriginalMatrixnull523 function TBGRALayeredBitmap.GetLayerOriginalMatrix(layer: integer
524   ): TAffineMatrix;
525 begin
526   if (layer < 0) or (layer >= NbLayers) then
527     raise Exception.Create('Index out of bounds')
528   else
529     result := FLayers[layer].OriginalMatrix;
530 end;
531 
TBGRALayeredBitmap.GetLayerOriginalGuidnull532 function TBGRALayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid;
533 begin
534   if (layer < 0) or (layer >= NbLayers) then
535     raise Exception.Create('Index out of bounds')
536   else
537     result := FLayers[layer].OriginalGuid;
538 end;
539 
TBGRALayeredBitmap.GetLayerOriginalRenderStatusnull540 function TBGRALayeredBitmap.GetLayerOriginalRenderStatus(layer: integer
541   ): TOriginalRenderStatus;
542 begin
543   if (layer < 0) or (layer >= NbLayers) then
544     raise Exception.Create('Index out of bounds')
545   else
546     result := FLayers[layer].OriginalRenderStatus;
547 end;
548 
549 procedure TBGRALayeredBitmap.SetLayerUniqueId(layer: integer; AValue: integer);
550 var i: integer;
551   layerDir: TMemDirectory;
552 begin
553   if (layer < 0) or (layer >= NbLayers) then
554     raise Exception.Create('Index out of bounds')
555   else
556   begin
557     for i := 0 to NbLayers-1 do
558       if (i <> layer) and (FLayers[i].UniqueId = AValue) then
559         raise Exception.Create('Another layer has the same identifier');
560     layerDir := GetLayerDirectory(layer,false);
561     if Assigned(layerDir) then
562       layerDir.ParentDirectory.Rename(inttostr(FLayers[layer].UniqueId),'',inttostr(AValue));
563     FLayers[layer].UniqueId := AValue;
564   end;
565 end;
566 
567 procedure TBGRALayeredBitmap.SetLayerOriginalMatrix(layer: integer;
568   AValue: TAffineMatrix);
569 begin
570   if (layer < 0) or (layer >= NbLayers) then
571     raise Exception.Create('Index out of bounds')
572   else
573   begin
574     if FLayers[layer].OriginalMatrix = AValue then exit;
575     FLayers[layer].OriginalMatrix := AValue;
576     if FLayers[layer].OriginalGuid <> GUID_NULL then
577     begin
578       FLayers[layer].OriginalRenderStatus := orsNone;
579       Unfreeze(layer);
580     end;
581   end;
582 end;
583 
584 procedure TBGRALayeredBitmap.SetLayerOriginalGuid(layer: integer;
585   const AValue: TGuid);
586 var
587   layerDir: TMemDirectory;
588 begin
589   if (layer < 0) or (layer >= NbLayers) then
590     raise Exception.Create('Index out of bounds')
591   else
592   begin
593     if FLayers[layer].OriginalGuid = AValue then exit;
594     FLayers[layer].OriginalGuid := AValue;
595     layerDir := GetLayerDirectory(layer, false);
596     if Assigned(layerDir) then
597       layerDir.Delete(RenderSubDirectory,'');
598 
599     if (AValue <> GUID_NULL) and (IndexOfOriginal(AValue) <> -1) then
600     begin
601       FLayers[layer].OriginalRenderStatus := orsNone;
602       Unfreeze(layer);
603     end;
604   end;
605 end;
606 
607 procedure TBGRALayeredBitmap.SetLayerOriginalRenderStatus(layer: integer;
608   AValue: TOriginalRenderStatus);
609 begin
610   if (layer < 0) or (layer >= NbLayers) then
611     raise Exception.Create('Index out of bounds')
612   else
613   begin
614     if FLayers[layer].OriginalRenderStatus = AValue then exit;
615     FLayers[layer].OriginalRenderStatus := AValue;
616     Unfreeze(layer);
617   end;
618 end;
619 
620 procedure TBGRALayeredBitmap.FindOriginal(AGuid: TGuid; out
621   ADir: TMemDirectory; out AClass: TBGRALayerOriginalAny);
622 var
623   c: String;
624 begin
625   ADir := nil;
626   AClass := nil;
627 
628   if HasMemFiles then
629   begin
630     ADir := MemDirectory.FindPath(OriginalsDirectory+'/'+GUIDToString(AGuid));
631     if ADir <> nil then
632     begin
633       c := ADir.RawStringByFilename['class'];
634       AClass := FindLayerOriginalClass(c);
635     end;
636   end;
637 end;
638 
639 procedure TBGRALayeredBitmap.StoreOriginal(AOriginal: TBGRALayerCustomOriginal);
640 var
641   dir, subdir: TMemDirectory;
642   storage: TBGRAMemOriginalStorage;
643 begin
644   if AOriginal.Guid = GUID_NULL then raise exception.Create('Original GUID undefined');
645   dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
646   subdir := dir.Directory[dir.AddDirectory(GUIDToString(AOriginal.Guid))];
647   storage := TBGRAMemOriginalStorage.Create(subdir);
648   try
649     AOriginal.SaveToStorage(storage);
650     storage.RawString['class'] := AOriginal.StorageClassName;
651   finally
652     storage.Free;
653   end;
654 end;
655 
656 procedure TBGRALayeredBitmap.OriginalChange(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff);
657 var
658   i: Integer;
659   orig: TBGRALayerCustomOriginal;
660   transfBounds: TRectF;
661 begin
662   orig := TBGRALayerCustomOriginal(ASender);
663   if not (Assigned(ABounds) and IsEmptyRectF(ABounds^)) then
664   begin
665     for i := 0 to NbLayers-1 do
666       if LayerOriginalGuid[i] = orig.Guid then
667       begin
668         if ABounds = nil then
669           LayerOriginalRenderStatus[i] := orsNone
670         else
671         begin
672           transfBounds := (LayerOriginalMatrix[i]*TAffineBox.AffineBox(ABounds^)).RectBoundsF;
673           case LayerOriginalRenderStatus[i] of
674           orsDraft: begin
675                       LayerOriginalRenderStatus[i] := orsPartialDraft;
676                       FLayers[i].OriginalInvalidatedBounds := transfBounds;
677                     end;
678           orsProof: begin
679                       LayerOriginalRenderStatus[i] := orsPartialProof;
680                       FLayers[i].OriginalInvalidatedBounds := transfBounds;
681                     end;
682           orsPartialDraft: FLayers[i].OriginalInvalidatedBounds :=
683                              FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true);
684           orsPartialProof: FLayers[i].OriginalInvalidatedBounds :=
685                              FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true);
686           end;
687         end;
688       end;
689   end;
690   if Assigned(FOriginalChange) then
691     FOriginalChange(self, orig, ADiff);
692 end;
693 
694 procedure TBGRALayeredBitmap.OriginalEditingChange(ASender: TObject);
695 var
696   orig: TBGRALayerCustomOriginal;
697 begin
698   orig := TBGRALayerCustomOriginal(ASender);
699   if Assigned(FOriginalEditingChange) then
700     FOriginalEditingChange(self, orig);
701 end;
702 
TBGRALayeredBitmap.GetLayerDirectorynull703 function TBGRALayeredBitmap.GetLayerDirectory(ALayerIndex: integer; ACanCreate: boolean): TMemDirectory;
704 var
705   layersDir: TMemDirectory;
706   id: LongInt;
707 begin
708   if (MemDirectory.IndexOf(LayersDirectory,'')=-1) and not ACanCreate then exit(nil);
709   layersDir := MemDirectory.Directory[MemDirectory.AddDirectory(LayersDirectory)];
710   id := LayerUniqueId[ALayerIndex];
711   if (layersDir.IndexOf(IntToStr(id),'')=-1) and not ACanCreate then exit(nil);
712   result := layersDir.Directory[layersDir.AddDirectory(IntToStr(id))];
713 end;
714 
715 procedure TBGRALayeredBitmap.UpdateOriginalEditor(ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single);
716 var
717   orig: TBGRALayerCustomOriginal;
718   editMatrix: TAffineMatrix;
719 begin
720   orig := LayerOriginal[ALayerIndex];
721 
722   if (orig = nil) or (orig.Guid <> FOriginalEditorOriginal) then
723   begin
724     FreeAndNil(FOriginalEditor);
725     if orig = nil then
726       FOriginalEditorOriginal := GUID_NULL
727       else FOriginalEditorOriginal := orig.Guid;
728   end;
729 
730   if Assigned(OriginalEditor) then
731     FOriginalEditor.Clear;
732 
733   if Assigned(orig) then
734   begin
735     if OriginalEditor = nil then
736     begin
737       FOriginalEditor := orig.CreateEditor;
738       if FOriginalEditor = nil then
739         raise exception.Create('Unexpected nil value');
740       FOriginalEditor.Focused := FEditorFocused;
741       FOriginalEditor.OnFocusChanged:=@EditorFocusedChanged;
742     end;
743 
744     editMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*LayerOriginalMatrix[ALayerIndex]*AffineMatrixTranslation(0.5,0.5);
745     if IsAffineMatrixInversible(editMatrix) then
746     begin
747       orig.ConfigureEditor(FOriginalEditor);
748       FOriginalEditorViewMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5);
749       FOriginalEditor.Matrix := editMatrix;
750       FOriginalEditor.PointSize := APointSize;
751     end;
752   end;
753 end;
754 
GetOriginalCountnull755 function TBGRALayeredBitmap.GetOriginalCount: integer;
756 begin
757   if Assigned(FOriginals) then
758     result := FOriginals.Count
759   else
760     result := 0;
761 end;
762 
TBGRALayeredBitmap.GetOriginalByIndexnull763 function TBGRALayeredBitmap.GetOriginalByIndex(AIndex: integer
764   ): TBGRALayerCustomOriginal;
765 var
766   dir: TMemDirectory;
767   c: TBGRALayerOriginalAny;
768   guid: TGuid;
769   storage: TBGRAMemOriginalStorage;
770   raiseError: Boolean;
771 begin
772   if (AIndex < 0) or (AIndex >= OriginalCount) then
773     raise ERangeError.Create('Index out of bounds');
774 
775   result := FOriginals[AIndex].Instance;
776   guid := FOriginals[AIndex].Guid;
777 
778   // load original on the fly
779   if (result = nil) and (guid <> GUID_NULL) then
780   begin
781     FindOriginal(guid, dir, c);
782     if not Assigned(dir) then
783       raise exception.Create('Original directory not found');
784     if not Assigned(c) then
785       raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)');
786 
787     result := c.Create;
788     result.Guid := guid;
789     storage := TBGRAMemOriginalStorage.Create(dir);
790     try
791       try
792         result.LoadFromStorage(storage);
793       finally
794         FOriginals[AIndex] := BGRALayerOriginalEntry(result);
795         result.OnChange:= @OriginalChange;
796         result.OnEditingChange:= @OriginalEditingChange;
797         storage.Free;
798       end;
799     except
800       on ex: Exception do
801       begin
802         raiseError := true;
803         if Assigned(FOnOriginalLoadError) then
804           FOnOriginalLoadError(self, ex.Message, raiseError);
805         if raiseError then
806           raise ex;
807       end;
808     end;
809   end;
810 end;
811 
GetLayerOriginalKnownnull812 function TBGRALayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean;
813 var
814   idxOrig: Integer;
815 begin
816   if (layer < 0) or (layer >= NbLayers) then
817     raise Exception.Create('Index out of bounds')
818   else
819   begin
820     if FLayers[layer].OriginalGuid = GUID_NULL then exit(true);
821     idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid);
822     if idxOrig = -1 then exit(false);
823     result := OriginalKnown[idxOrig];
824   end;
825 end;
826 
TBGRALayeredBitmap.GetOriginalByIndexKnownnull827 function TBGRALayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean;
828 var
829   dir: TMemDirectory;
830   c: TBGRALayerOriginalAny;
831   guid: TGuid;
832 begin
833   if (AIndex < 0) or (AIndex >= OriginalCount) then
834     raise ERangeError.Create('Index out of bounds');
835 
836   if Assigned(FOriginals[AIndex].Instance) then exit(true);
837   guid := FOriginals[AIndex].Guid;
838   if guid = GUID_NULL then exit(true);
839 
840   FindOriginal(guid, dir, c);
841   result:= Assigned(dir) and Assigned(c);
842 end;
843 
GetOriginalByIndexLoadednull844 function TBGRALayeredBitmap.GetOriginalByIndexLoaded(AIndex: integer): boolean;
845 begin
846   if (AIndex < 0) or (AIndex >= OriginalCount) then
847     raise ERangeError.Create('Index out of bounds');
848 
849   Result:= Assigned(FOriginals[AIndex].Instance);
850 end;
851 
TBGRALayeredBitmap.GetOriginalGuidnull852 function TBGRALayeredBitmap.GetOriginalGuid(AIndex: integer): TGUID;
853 begin
854   if (AIndex < 0) or (AIndex >= OriginalCount) then
855     raise ERangeError.Create('Index out of bounds');
856 
857   result := FOriginals[AIndex].Guid;
858 end;
859 
860 procedure TBGRALayeredBitmap.SetEditorFocused(AValue: boolean);
861 begin
862   if Assigned(OriginalEditor) then OriginalEditor.Focused := AValue
863   else
864   begin
865     if FEditorFocused=AValue then Exit;
866     FEditorFocused:=AValue;
867     if Assigned(FOnEditorFocusChanged) then FOnEditorFocusChanged(self);
868   end;
869 end;
870 
871 procedure TBGRALayeredBitmap.SetOnActionDone(AValue: TNotifyEvent);
872 begin
873   if FOnActionDone=AValue then Exit;
874   FOnActionDone:=AValue;
875 end;
876 
877 procedure TBGRALayeredBitmap.SetOnActionProgress(
878   AValue: TLayeredActionProgressEvent);
879 begin
880   if FOnActionProgress=AValue then Exit;
881   FOnActionProgress:=AValue;
882 end;
883 
GetLayerOriginalClassnull884 function TBGRALayeredBitmap.GetLayerOriginalClass(layer: integer): TBGRALayerOriginalAny;
885 var
886   idxOrig: Integer;
887 begin
888   if (layer < 0) or (layer >= NbLayers) then
889     raise Exception.Create('Index out of bounds')
890   else
891   begin
892     if FLayers[layer].OriginalGuid = GUID_NULL then exit(nil);
893     idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid);
894     if idxOrig = -1 then exit(nil);
895     result := OriginalClass[idxOrig];
896   end;
897 end;
898 
TBGRALayeredBitmap.GetOriginalEditornull899 function TBGRALayeredBitmap.GetOriginalEditor: TBGRAOriginalEditor;
900 begin
901   if Assigned(FOriginalEditor) and (IndexOfOriginal(FOriginalEditorOriginal)=-1) then
902   begin
903     FreeAndNil(FOriginalEditor);
904     FOriginalEditorOriginal := GUID_NULL;
905   end;
906   result := FOriginalEditor;
907 end;
908 
909 procedure TBGRALayeredBitmap.EditorFocusedChanged(Sender: TObject);
910 begin
911   if Assigned(OriginalEditor) then
912   begin
913     FEditorFocused := OriginalEditor.Focused;
914     if Assigned(FOnEditorFocusChanged) then FOnEditorFocusChanged(self);
915   end;
916 end;
917 
TBGRALayeredBitmap.GetOriginalByIndexClassnull918 function TBGRALayeredBitmap.GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny;
919 var
920   dir: TMemDirectory;
921   c: TBGRALayerOriginalAny;
922   guid: TGuid;
923 begin
924   if (AIndex < 0) or (AIndex >= OriginalCount) then
925     raise ERangeError.Create('Index out of bounds');
926 
927   if Assigned(FOriginals[AIndex].Instance) then exit(TBGRALayerOriginalAny(FOriginals[AIndex].Instance.ClassType));
928   guid := FOriginals[AIndex].Guid;
929   if guid = GUID_NULL then exit(nil);
930 
931   FindOriginal(guid, dir, c);
932   result:= c;
933 end;
934 
GetWidthnull935 function TBGRALayeredBitmap.GetWidth: integer;
936 begin
937   Result:= FWidth;
938 end;
939 
GetHeightnull940 function TBGRALayeredBitmap.GetHeight: integer;
941 begin
942   Result:= FHeight;
943 end;
944 
TBGRALayeredBitmap.GetNbLayersnull945 function TBGRALayeredBitmap.GetNbLayers: integer;
946 begin
947   Result:= FNbLayers;
948 end;
949 
TBGRALayeredBitmap.GetBlendOperationnull950 function TBGRALayeredBitmap.GetBlendOperation(Layer: integer): TBlendOperation;
951 begin
952   if (layer < 0) or (layer >= NbLayers) then
953     raise Exception.Create('Index out of bounds')
954   else
955     Result:= FLayers[layer].blendOp;
956 end;
957 
GetLayerVisiblenull958 function TBGRALayeredBitmap.GetLayerVisible(layer: integer): boolean;
959 begin
960   if (layer < 0) or (layer >= NbLayers) then
961     raise Exception.Create('Index out of bounds')
962   else
963     Result:= FLayers[layer].Visible;
964 end;
965 
TBGRALayeredBitmap.GetLayerOpacitynull966 function TBGRALayeredBitmap.GetLayerOpacity(layer: integer): byte;
967 begin
968   if (layer < 0) or (layer >= NbLayers) then
969     raise Exception.Create('Index out of bounds')
970   else
971     Result:= FLayers[layer].Opacity;
972 end;
973 
GetLayerOffsetnull974 function TBGRALayeredBitmap.GetLayerOffset(layer: integer): TPoint;
975 begin
976   if (layer < 0) or (layer >= NbLayers) then
977     raise Exception.Create('Index out of bounds')
978   else
979     with FLayers[layer] do
980       Result:= Point(x,y);
981 end;
982 
GetLayerNamenull983 function TBGRALayeredBitmap.GetLayerName(layer: integer): string;
984 begin
985   if (layer < 0) or (layer >= NbLayers) then
986     raise Exception.Create('Index out of bounds')
987   else
988   begin
989     if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then
990       Result := FLayers[layer].Source.Caption
991     else
992       Result:= FLayers[layer].Name;
993     if Result = '' then
994       result := inherited GetLayerName(layer);
995   end;
996 end;
997 
GetLayerFrozennull998 function TBGRALayeredBitmap.GetLayerFrozen(layer: integer): boolean;
999 begin
1000   if (layer < 0) or (layer >= NbLayers) then
1001     raise Exception.Create('Index out of bounds')
1002   else
1003     Result:= FLayers[layer].Frozen;
1004 end;
1005 
1006 procedure TBGRALayeredBitmap.SetBlendOperation(Layer: integer;
1007   op: TBlendOperation);
1008 begin
1009   if (layer < 0) or (layer >= NbLayers) then
1010     raise Exception.Create('Index out of bounds')
1011   else
1012   begin
1013     if FLayers[layer].blendOp <> op then
1014     begin
1015       FLayers[layer].blendOp := op;
1016       Unfreeze(layer);
1017     end;
1018   end;
1019 end;
1020 
1021 procedure TBGRALayeredBitmap.SetLayerVisible(layer: integer; AValue: boolean);
1022 begin
1023   if (layer < 0) or (layer >= NbLayers) then
1024     raise Exception.Create('Index out of bounds')
1025   else
1026   begin
1027     if FLayers[layer].Visible <> AValue then
1028     begin
1029       FLayers[layer].Visible := AValue;
1030       Unfreeze(layer);
1031     end;
1032   end;
1033 end;
1034 
1035 procedure TBGRALayeredBitmap.SetLayerOpacity(layer: integer; AValue: byte);
1036 begin
1037   if (layer < 0) or (layer >= NbLayers) then
1038     raise Exception.Create('Index out of bounds')
1039   else
1040   begin
1041     if FLayers[layer].Opacity <> AValue then
1042     begin
1043       FLayers[layer].Opacity := AValue;
1044       Unfreeze(layer);
1045     end;
1046   end;
1047 end;
1048 
1049 procedure TBGRALayeredBitmap.SetLayerOffset(layer: integer; AValue: TPoint);
1050 begin
1051   if (layer < 0) or (layer >= NbLayers) then
1052     raise Exception.Create('Index out of bounds')
1053   else
1054   begin
1055     if (FLayers[layer].x <> AValue.x) or
1056       (FLayers[layer].y <> AValue.y) then
1057     begin
1058       if FLayers[layer].OriginalGuid <> GUID_NULL then
1059         raise exception.Create('The offset of the layer is computed from an original. You can change it by changing the layer original matrix.');
1060 
1061       FLayers[layer].x := AValue.x;
1062       FLayers[layer].y := AValue.y;
1063       Unfreeze(layer);
1064     end;
1065   end;
1066 end;
1067 
1068 procedure TBGRALayeredBitmap.SetLayerName(layer: integer; AValue: string);
1069 begin
1070   if (layer < 0) or (layer >= NbLayers) then
1071     raise Exception.Create('Index out of bounds')
1072   else
1073   begin
1074     if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then
1075       FLayers[layer].Source.Caption := AValue
1076     else
1077       FLayers[layer].Name := AValue;
1078   end;
1079 end;
1080 
1081 procedure TBGRALayeredBitmap.SetLayerFrozen(layer: integer; AValue: boolean);
1082 begin
1083   if (layer < 0) or (layer >= NbLayers) then
1084     raise Exception.Create('Index out of bounds')
1085   else
1086     FLayers[layer].Frozen := AValue;
1087 end;
1088 
GetLayerBitmapDirectlynull1089 function TBGRALayeredBitmap.GetLayerBitmapDirectly(layer: integer): TBGRABitmap;
1090 begin
1091   if (layer < 0) or (layer >= NbLayers) then
1092     result := nil
1093   else
1094   begin
1095     if FLayers[layer].OriginalRenderStatus = orsNone then
1096       RenderLayerFromOriginal(layer, true)
1097     else if FLayers[layer].OriginalRenderStatus in [orsPartialDraft,orsPartialProof] then
1098       RenderLayerFromOriginal(layer, true, FLayers[layer].OriginalInvalidatedBounds);
1099     Result:= FLayers[layer].Source;
1100   end;
1101 end;
1102 
1103 procedure TBGRALayeredBitmap.LoadFromFile(const filenameUTF8: string);
1104 var bmp: TBGRABitmap;
1105     ext: string;
1106     temp: TBGRACustomLayeredBitmap;
1107     i: integer;
1108     stream: TFileStreamUTF8;
1109 begin
1110   ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
1111   for i := 0 to high(LayeredBitmapReaders) do
1112     if '.'+LayeredBitmapReaders[i].extension = ext then
1113     begin
1114       temp := LayeredBitmapReaders[i].theClass.Create;
1115       try
1116         temp.LoadFromFile(filenameUTF8);
1117         Assign(temp);
1118       finally
1119         temp.Free;
1120       end;
1121       exit;
1122     end;
1123 
1124   //when using "data" extension, simply deserialize
1125   if (ext='.dat') or (ext='.data') then
1126   begin
1127     if Assigned(LayeredBitmapLoadFromStreamProc) then
1128     begin
1129       stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead, fmShareDenyWrite);
1130       try
1131         LayeredBitmapLoadFromStreamProc(stream, self);
1132       finally
1133         stream.Free;
1134       end;
1135     end else
1136       raise exception.Create('Enable layer deserialization by calling BGRAStreamLayers.RegisterStreamLayers');
1137   end else
1138   begin
1139     bmp := TBGRABitmap.Create(filenameUTF8, True);
1140     Clear;
1141     SetSize(bmp.Width,bmp.Height);
1142     AddOwnedLayer(bmp);
1143   end;
1144 end;
1145 
1146 procedure TBGRALayeredBitmap.LoadFromStream(stream: TStream);
1147 var bmp: TBGRABitmap;
1148 begin
1149   if Assigned(LayeredBitmapLoadFromStreamProc) then
1150   begin
1151     if not Assigned(LayeredBitmapCheckStreamProc) or
1152       LayeredBitmapCheckStreamProc(stream) then
1153     begin
1154       LayeredBitmapLoadFromStreamProc(Stream, self);
1155       exit;
1156     end;
1157   end;
1158 
1159   bmp := TBGRABitmap.Create(stream);
1160   Clear;
1161   SetSize(bmp.Width,bmp.Height);
1162   AddOwnedLayer(bmp);
1163 end;
1164 
1165 procedure TBGRALayeredBitmap.LoadFromResource(AFilename: string);
1166 var
1167   stream: TStream;
1168 begin
1169   stream := BGRAResource.GetResourceStream(AFilename);
1170   try
1171     LoadFromStream(stream);
1172   finally
1173     stream.Free;
1174   end;
1175 end;
1176 
1177 procedure TBGRALayeredBitmap.SetSize(AWidth, AHeight: integer);
1178 begin
1179   Unfreeze;
1180   FWidth := AWidth;
1181   FHeight := AHeight;
1182 end;
1183 
1184 procedure TBGRALayeredBitmap.Clear;
1185 var i: integer;
1186 begin
1187   Unfreeze;
1188   for i := NbLayers-1 downto 0 do
1189     RemoveLayer(i);
1190   MemDirectory := nil;
1191   ClearOriginals;
1192 end;
1193 
1194 procedure TBGRALayeredBitmap.ClearOriginals;
1195 var
1196   i: Integer;
1197 begin
1198   if Assigned(FOriginals) then
1199   begin
1200     for i := 0 to OriginalCount-1 do
1201       FOriginals[i].Instance.Free;
1202     FreeAndNil(FOriginals);
1203   end;
1204 end;
1205 
1206 procedure TBGRALayeredBitmap.RemoveLayer(index: integer);
1207 var i: integer;
1208   id: LongInt;
1209   layersDir: TMemDirectory;
1210 begin
1211   if (index < 0) or (index >= NbLayers) then exit;
1212   Unfreeze;
1213   if Assigned(FMemDirectory) then
1214   begin
1215     id := LayerUniqueId[index];
1216     if FMemDirectory.IndexOf(LayersDirectory,'')<>-1 then
1217     begin
1218       layersDir := FMemDirectory.Directory[FMemDirectory.AddDirectory(LayersDirectory)];
1219       layersDir.Delete(IntToStr(id),'');
1220     end;
1221   end;
1222   if FLayers[index].Owner then FLayers[index].Source.Free;
1223   for i := index to FNbLayers-2 do
1224     FLayers[i] := FLayers[i+1];
1225   Dec(FNbLayers);
1226 end;
1227 
1228 procedure TBGRALayeredBitmap.InsertLayer(index: integer; fromIndex: integer);
1229 var info: TBGRALayerInfo;
1230     i: integer;
1231 begin
1232   if (index < 0) or (index > NbLayers) or (index = fromIndex) then exit;
1233   if (fromIndex < 0) or (fromIndex >= NbLayers) then exit;
1234   Unfreeze;
1235   info := FLayers[fromIndex];
1236   for i := fromIndex to FNbLayers-2 do
1237     FLayers[i] := FLayers[i+1];
1238   for i := FNbLayers-1 downto index+1 do
1239     FLayers[i] := FLayers[i-1];
1240   FLayers[index] := info;
1241 end;
1242 
1243 procedure TBGRALayeredBitmap.Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean;
1244   ACopyAdditionalMemData: boolean);
1245 var i,idx,idxOrig,idxNewOrig: integer;
1246     usedOriginals: array of record
1247        used: boolean;
1248        sourceGuid,newGuid: TGuid;
1249     end;
1250     orig: TBGRALayerCustomOriginal;
1251     stream: TMemoryStream;
1252     targetDir, layerDir: TMemDirectory;
1253 
1254 begin
1255   if ASource = nil then
1256     raise exception.Create('Unexpected nil reference');
1257   Clear;
1258   SetSize(ASource.Width,ASource.Height);
1259   LinearBlend:= ASource.LinearBlend;
1260   setlength(usedOriginals, ASource.GetOriginalCount);
1261   for idxOrig := 0 to high(usedOriginals) do
1262   with usedOriginals[idxOrig] do
1263   begin
1264     used:= false;
1265     newGuid := GUID_NULL;
1266   end;
1267   for i := 0 to ASource.NbLayers-1 do
1268   if (ASource.LayerOriginalGuid[i]<>GUID_NULL) and
1269      (ASource.LayerOriginalKnown[i] or (ASource is TBGRALayeredBitmap)) then
1270   begin
1271     idxOrig := ASource.IndexOfOriginal(ASource.LayerOriginalGuid[i]);
1272     if (idxOrig <> -1) and not usedOriginals[idxOrig].used then
1273     begin
1274       if ASource.GetOriginalByIndexLoaded(idxOrig) then
1275       begin
1276         orig := ASource.GetOriginalByIndex(idxOrig);
1277         idxNewOrig := AddOriginal(orig, false);
1278         usedOriginals[idxOrig].sourceGuid := orig.Guid;
1279       end else
1280       begin
1281         stream := TMemoryStream.Create;
1282         (ASource as TBGRALayeredBitmap).SaveOriginalToStream(idxOrig, stream);
1283         stream.Position:= 0;
1284         idxNewOrig := AddOriginalFromStream(stream,true);
1285         stream.Free;
1286         usedOriginals[idxOrig].sourceGuid := (ASource as TBGRALayeredBitmap).OriginalGuid[idxOrig];
1287       end;
1288       usedOriginals[idxOrig].newGuid := OriginalGuid[idxNewOrig];
1289       usedOriginals[idxOrig].used := true;
1290     end;
1291   end;
1292   for i := 0 to ASource.NbLayers-1 do
1293   begin
1294     idx := AddOwnedLayer(ASource.GetLayerBitmapCopy(i),ASource.LayerOffset[i],ASource.BlendOperation[i],ASource.LayerOpacity[i]);
1295     LayerName[idx] := ASource.LayerName[i];
1296     LayerVisible[idx] := ASource.LayerVisible[i];
1297     if ASharedLayerIds and (ASource is TBGRALayeredBitmap) then
1298       LayerUniqueId[idx] := TBGRALayeredBitmap(ASource).LayerUniqueId[i];
1299     for idxOrig := 0 to high(usedOriginals) do
1300       if usedOriginals[idxOrig].sourceGuid = ASource.LayerOriginalGuid[i] then
1301       begin
1302         LayerOriginalGuid[idx] := usedOriginals[idxOrig].newGuid;
1303         LayerOriginalMatrix[idx] := ASource.LayerOriginalMatrix[i];
1304         LayerOriginalRenderStatus[idx] := ASource.LayerOriginalRenderStatus[i];
1305         break;
1306       end;
1307     if ASource is TBGRALayeredBitmap then
1308     begin
1309       layerDir := TBGRALayeredBitmap(ASource).GetLayerDirectory(i,false);
1310       if Assigned(layerDir) then
1311         layerDir.CopyTo(GetLayerDirectory(idx,true), true);
1312     end;
1313   end;
1314   if ACopyAdditionalMemData and ASource.HasMemFiles then
1315     for i := 0 to ASource.GetMemDirectory.Count-1 do
1316     if (ASource.GetMemDirectory.Entry[i].CompareNameAndExtension(OriginalsDirectory,'')<>0) and
1317        (ASource.GetMemDirectory.Entry[i].CompareNameAndExtension(LayersDirectory,'')<>0) and
1318        (ASource.GetMemDirectory.IsDirectory[i]) then
1319     begin
1320       with ASource.GetMemDirectory.Entry[i] do
1321         targetDir := GetMemDirectory.Directory[GetMemDirectory.AddDirectory(Name,Extension)];
1322       ASource.GetMemDirectory.Directory[i].CopyTo(targetDir, true);
1323     end;
1324 end;
1325 
MoveLayerUpnull1326 function TBGRALayeredBitmap.MoveLayerUp(index: integer): integer;
1327 begin
1328   if (index >= 0) and (index <= NbLayers-2) then
1329   begin
1330     InsertLayer(index+1,index);
1331     result := index+1;
1332   end else
1333     result := -1;
1334 end;
1335 
TBGRALayeredBitmap.MoveLayerDownnull1336 function TBGRALayeredBitmap.MoveLayerDown(index: integer): integer;
1337 begin
1338   if (index > 0) and (index <= NbLayers-1) then
1339   begin
1340     InsertLayer(index-1,index);
1341     result := index-1;
1342   end else
1343     result := -1;
1344 end;
1345 
TBGRALayeredBitmap.AddLayernull1346 function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Opacity: byte
1347   ): integer;
1348 begin
1349   result := AddLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity, False);
1350 end;
1351 
TBGRALayeredBitmap.AddLayernull1352 function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint;
1353   BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer;
1354 begin
1355   result := AddLayer(Source.Caption,Source,Position,BlendOp,Opacity,Shared);
1356 end;
1357 
TBGRALayeredBitmap.AddLayernull1358 function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint;
1359   Opacity: byte): integer;
1360 begin
1361   result := AddLayer(Source,Position,DefaultBlendingOperation,Opacity);
1362 end;
1363 
TBGRALayeredBitmap.AddLayernull1364 function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap;
1365   BlendOp: TBlendOperation; Opacity: byte): integer;
1366 begin
1367   result := AddLayer(Source,Point(0,0),BlendOp,Opacity);
1368 end;
1369 
TBGRALayeredBitmap.AddLayernull1370 function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1371   Opacity: byte): integer;
1372 begin
1373   result := AddLayer(AName,Source,Point(0,0),Opacity);
1374 end;
1375 
TBGRALayeredBitmap.AddLayernull1376 function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1377   Position: TPoint; BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer;
1378 begin
1379   if length(FLayers) = FNbLayers then
1380     setlength(FLayers, length(FLayers)*2+1);
1381   FLayers[FNbLayers].Name := AName;
1382   FLayers[FNbLayers].X := Position.X;
1383   FLayers[FNbLayers].Y := Position.Y;
1384   FLayers[FNbLayers].blendOp := BlendOp;
1385   FLayers[FNbLayers].Opacity := Opacity;
1386   FLayers[FNbLayers].Visible := true;
1387   FLayers[FNbLayers].Frozen := false;
1388   FLayers[FNbLayers].UniqueId := ProduceLayerUniqueId;
1389   FLayers[FNbLayers].OriginalMatrix := AffineMatrixIdentity;
1390   FLayers[FNbLayers].OriginalRenderStatus := orsNone;
1391   FLayers[FNbLayers].OriginalGuid := GUID_NULL;
1392   if Shared then
1393   begin
1394     FLayers[FNbLayers].Source := Source;
1395     FLayers[FNbLayers].Owner := false;
1396   end else
1397   begin
1398     FLayers[FNbLayers].Source := Source.Duplicate;
1399     FLayers[FNbLayers].Owner := true;
1400   end;
1401   result := FNbLayers;
1402   inc(FNbLayers);
1403   if (FNbLayers = 1) and (FWidth = 0) and (FHeight = 0) and (Source <> nil) then
1404     SetSize(Source.Width,Source.Height);
1405 end;
1406 
TBGRALayeredBitmap.AddLayernull1407 function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1408   Position: TPoint; Opacity: byte): integer;
1409 begin
1410   result := AddLayer(AName, Source, Position, DefaultBlendingOperation, Opacity);
1411 end;
1412 
TBGRALayeredBitmap.AddLayernull1413 function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1414   BlendOp: TBlendOperation; Opacity: byte): integer;
1415 begin
1416   result := AddLayer(AName, Source, Point(0,0), blendOp, Opacity);
1417 end;
1418 
AddSharedLayernull1419 function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; Opacity: byte
1420   ): integer;
1421 begin
1422   result := AddSharedLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity);
1423 end;
1424 
AddSharedLayernull1425 function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1426   Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1427 begin
1428   result := AddLayer(Source, Position, BlendOp, Opacity, True);
1429 end;
1430 
AddSharedLayernull1431 function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1432   Position: TPoint; Opacity: byte): integer;
1433 begin
1434   result := AddSharedLayer(Source, Position, DefaultBlendingOperation, Opacity);
1435 end;
1436 
AddSharedLayernull1437 function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1438   BlendOp: TBlendOperation; Opacity: byte): integer;
1439 begin
1440   result := AddSharedLayer(Source, Point(0,0), blendOp, Opacity);
1441 end;
1442 
AddLayerFromFilenull1443 function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; Opacity: byte
1444   ): integer;
1445 begin
1446   result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Opacity);
1447   FLayers[result].Name := ExtractFileName(AFilename);
1448 end;
1449 
AddLayerFromFilenull1450 function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1451   Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1452 begin
1453   result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,BlendOp,Opacity);
1454   FLayers[result].Name := ExtractFileName(AFilename);
1455 end;
1456 
AddLayerFromFilenull1457 function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1458   Position: TPoint; Opacity: byte): integer;
1459 begin
1460   result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,Opacity);
1461   FLayers[result].Name := ExtractFileName(AFilename);
1462 end;
1463 
AddLayerFromFilenull1464 function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1465   BlendOp: TBlendOperation; Opacity: byte): integer;
1466 begin
1467   result := AddOwnedLayer(TBGRABitmap.Create(AFilename),BlendOp,Opacity);
1468   FLayers[result].Name := ExtractFileName(AFilename);
1469 end;
1470 
TBGRALayeredBitmap.AddOwnedLayernull1471 function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte
1472   ): integer;
1473 begin
1474   result := AddSharedLayer(ABitmap,Opacity);
1475   FLayers[result].Owner := True;
1476 end;
1477 
TBGRALayeredBitmap.AddOwnedLayernull1478 function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1479   Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1480 begin
1481   result := AddSharedLayer(ABitmap,Position,BlendOp,Opacity);
1482   FLayers[result].Owner := True;
1483 end;
1484 
TBGRALayeredBitmap.AddOwnedLayernull1485 function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1486   Position: TPoint; Opacity: byte): integer;
1487 begin
1488   result := AddSharedLayer(ABitmap,Position,Opacity);
1489   FLayers[result].Owner := True;
1490 end;
1491 
TBGRALayeredBitmap.AddOwnedLayernull1492 function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1493   BlendOp: TBlendOperation; Opacity: byte): integer;
1494 begin
1495   result := AddSharedLayer(ABitmap,BlendOp,Opacity);
1496   FLayers[result].Owner := True;
1497 end;
1498 
TBGRALayeredBitmap.AddLayerFromOriginalnull1499 function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid;
1500   Opacity: byte): integer;
1501 begin
1502   result := AddLayerFromOriginal(AGuid, DefaultBlendingOperation, Opacity);
1503 end;
1504 
TBGRALayeredBitmap.AddLayerFromOriginalnull1505 function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid;
1506   BlendOp: TBlendOperation; Opacity: byte): integer;
1507 begin
1508   result := AddLayerFromOriginal(AGuid, AffineMatrixIdentity, BlendOp, Opacity);
1509 end;
1510 
TBGRALayeredBitmap.AddLayerFromOriginalnull1511 function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid;
1512   Matrix: TAffineMatrix; Opacity: byte): integer;
1513 begin
1514   result := AddLayerFromOriginal(AGuid, Matrix, DefaultBlendingOperation, Opacity);
1515 end;
1516 
TBGRALayeredBitmap.AddLayerFromOriginalnull1517 function TBGRALayeredBitmap.AddLayerFromOriginal(const AGuid: TGuid;
1518   Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte): integer;
1519 begin
1520   result := AddOwnedLayer(TBGRABitmap.Create, BlendOp, Opacity);
1521   LayerOriginalGuid[result] := AGuid;
1522   LayerOriginalMatrix[result] := Matrix;
1523   if not Assigned(LayerOriginal[result]) then
1524     raise exception.Create('Original data or class not found');
1525 end;
1526 
TBGRALayeredBitmap.AddLayerFromOwnedOriginalnull1527 function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1528   AOriginal: TBGRALayerCustomOriginal; Opacity: byte): integer;
1529 begin
1530   if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1531   result := AddLayerFromOriginal(AOriginal.Guid, Opacity);
1532 end;
1533 
TBGRALayeredBitmap.AddLayerFromOwnedOriginalnull1534 function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1535   AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte): integer;
1536 begin
1537   if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1538   result := AddLayerFromOriginal(AOriginal.Guid, BlendOp, Opacity);
1539 end;
1540 
TBGRALayeredBitmap.AddLayerFromOwnedOriginalnull1541 function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1542   AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte): integer;
1543 begin
1544   if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1545   result := AddLayerFromOriginal(AOriginal.Guid, Matrix, Opacity);
1546 end;
1547 
TBGRALayeredBitmap.AddLayerFromOwnedOriginalnull1548 function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1549   AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix;
1550   BlendOp: TBlendOperation; Opacity: byte): integer;
1551 begin
1552   if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1553   result := AddLayerFromOriginal(AOriginal.Guid, Matrix, BlendOp, Opacity);
1554 end;
1555 
TBGRALayeredBitmap.IsValidRegistryIndentifiernull1556 class function TBGRALayeredBitmap.IsValidRegistryIndentifier(AIdentifier: string): boolean;
1557 var
1558   i: Integer;
1559 begin
1560   if length(AIdentifier) = 0 then exit(false);
1561   for i := 1 to length(AIdentifier) do
1562     if not (AIdentifier[i] in ['A'..'Z','a'..'z','0'..'9','_','-']) then exit(false);
1563   exit(true);
1564 end;
1565 
GetLayerRegistrynull1566 function TBGRALayeredBitmap.GetLayerRegistry(ALayerIndex: integer;
1567   ARegistryIdentifier: string): RawByteString;
1568 var
1569   layerDir, registryDir: TMemDirectory;
1570 begin
1571   if not IsValidRegistryIndentifier(ARegistryIdentifier) then
1572     raise exception.Create('Invalid registry identifier');
1573   layerDir := GetLayerDirectory(ALayerIndex, false);
1574   if layerDir = nil then exit('');
1575   registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')];
1576   result := registryDir.RawStringByFilename[ARegistryIdentifier]
1577 end;
1578 
1579 procedure TBGRALayeredBitmap.SetLayerRegistry(ALayerIndex: integer;
1580   ARegistryIdentifier: string; AValue: RawByteString);
1581 var
1582   layerDir, registryDir: TMemDirectory;
1583 begin
1584   if not IsValidRegistryIndentifier(ARegistryIdentifier) then
1585     raise exception.Create('Invalid registry identifier');
1586   layerDir := GetLayerDirectory(ALayerIndex, true);
1587   registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')];
1588   if length(AValue) = 0 then
1589     registryDir.Delete(ARegistryIdentifier,'')
1590   else registryDir.RawStringByFilename[ARegistryIdentifier] := AValue;
1591 end;
1592 
1593 procedure TBGRALayeredBitmap.SaveLayerRegistryToStream(ALayerIndex: integer;
1594   AStream: TStream);
1595 var
1596   layerDir, registryDir: TMemDirectory;
1597 begin
1598   layerDir := GetLayerDirectory(ALayerIndex, true);
1599   registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')];
1600   registryDir.SaveToStream(AStream);
1601 end;
1602 
1603 procedure TBGRALayeredBitmap.LoadLayerRegistryFromStream(ALayerIndex: integer;
1604   AStream: TStream);
1605 var
1606   layerDir, registryDir: TMemDirectory;
1607 begin
1608   layerDir := GetLayerDirectory(ALayerIndex, true);
1609   registryDir := layerDir.Directory[layerDir.AddDirectory(RegistrySubDirectory,'')];
1610   registryDir.LoadFromStream(AStream);
1611 end;
1612 
TBGRALayeredBitmap.GetGlobalRegistrynull1613 function TBGRALayeredBitmap.GetGlobalRegistry(ARegistryIdentifier: string): RawByteString;
1614 var
1615   registryDir: TMemDirectory;
1616 begin
1617   if not IsValidRegistryIndentifier(ARegistryIdentifier) then
1618     raise exception.Create('Invalid registry identifier');
1619   registryDir := MemDirectory.Directory[MemDirectory.AddDirectory(RegistrySubDirectory,'')];
1620   result := registryDir.RawStringByFilename[ARegistryIdentifier]
1621 end;
1622 
1623 procedure TBGRALayeredBitmap.SetGlobalRegistry(ARegistryIdentifier: string; AValue: RawByteString);
1624 var
1625   registryDir: TMemDirectory;
1626 begin
1627   if not IsValidRegistryIndentifier(ARegistryIdentifier) then
1628     raise exception.Create('Invalid registry identifier');
1629   registryDir := MemDirectory.Directory[MemDirectory.AddDirectory(RegistrySubDirectory,'')];
1630   if length(AValue) = 0 then
1631     registryDir.Delete(ARegistryIdentifier,'')
1632   else registryDir.RawStringByFilename[ARegistryIdentifier] := AValue;
1633 end;
1634 
AddOriginalnull1635 function TBGRALayeredBitmap.AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean): integer;
1636 var
1637   newGuid: TGuid;
1638 begin
1639   if AOriginal = nil then
1640     raise exception.Create('Unexpected nil reference');;
1641   if AOriginal.Guid = GUID_NULL then
1642   begin
1643     if CreateGUID(newGuid)<> 0 then
1644     begin
1645       if AOwned then AOriginal.Free;
1646       raise exception.Create('Error while creating GUID');
1647     end;
1648     AOriginal.Guid := newGuid;
1649   end else
1650   begin
1651     if IndexOfOriginal(AOriginal) <> -1 then
1652     begin
1653       if AOwned then AOriginal.Free;
1654       raise exception.Create('Original already added');
1655     end;
1656     if IndexOfOriginal(AOriginal.Guid) <> -1 then
1657     begin
1658       if AOwned then AOriginal.Free;
1659       raise exception.Create('GUID is already in use');
1660     end;
1661   end;
1662   if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create;
1663   if AOwned then
1664   begin
1665     result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal));
1666     AOriginal.OnChange:= @OriginalChange;
1667     AOriginal.OnEditingChange:= @OriginalEditingChange;
1668   end
1669   else
1670   begin
1671     StoreOriginal(AOriginal);
1672     result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal.Guid));
1673   end;
1674 end;
1675 
TBGRALayeredBitmap.AddOriginalFromStreamnull1676 function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream;
1677   ALateLoad: boolean): integer;
1678 var
1679   newGuid: TGUID;
1680 begin
1681   if CreateGUID(newGuid)<> 0 then raise exception.Create('Error while creating GUID');
1682   result := AddOriginalFromStream(AStream, newGuid, ALateLoad);
1683 end;
1684 
1685 
TBGRALayeredBitmap.AddOriginalFromStreamnull1686 function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream;
1687   const AGuid: TGuid; ALateLoad: boolean): integer;
1688 var
1689   storage: TBGRAMemOriginalStorage;
1690 begin
1691   storage:= TBGRAMemOriginalStorage.Create;
1692   storage.LoadFromStream(AStream);
1693   try
1694     result := AddOriginalFromStorage(storage, AGuid, ALateLoad);
1695   finally
1696     storage.Free;
1697   end;
1698 end;
1699 
TBGRALayeredBitmap.AddOriginalFromStoragenull1700 function TBGRALayeredBitmap.AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean): integer;
1701 var
1702   newGuid: TGUID;
1703 begin
1704   if CreateGUID(newGuid)<> 0 then raise exception.Create('Error while creating GUID');
1705   result := AddOriginalFromStorage(AStorage, newGuid, ALateLoad);
1706 end;
1707 
TBGRALayeredBitmap.AddOriginalFromStoragenull1708 function TBGRALayeredBitmap.AddOriginalFromStorage(
1709   AStorage: TBGRAMemOriginalStorage; const AGuid: TGuid; ALateLoad: boolean): integer;
1710 var
1711   origClassName: String;
1712   origClass: TBGRALayerOriginalAny;
1713   orig: TBGRALayerCustomOriginal;
1714   dir, subdir: TMemDirectory;
1715   raiseError: Boolean;
1716 begin
1717   result := -1;
1718   origClassName := AStorage.RawString['class'];
1719   if origClassName = '' then raise Exception.Create('Original class name not defined');
1720   if ALateLoad then
1721   begin
1722     if IndexOfOriginal(AGuid)<>-1 then
1723       raise exception.Create('Duplicate GUID');
1724 
1725     dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
1726     subdir := dir.Directory[dir.AddDirectory(GUIDToString(AGuid))];
1727     AStorage.CopyTo(subdir);
1728 
1729     if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create;
1730     result := FOriginals.Add(BGRALayerOriginalEntry(AGuid));
1731   end else
1732   begin
1733     origClass := FindLayerOriginalClass(origClassName);
1734     if origClass = nil then raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)');
1735     orig := origClass.Create;
1736     try
1737       orig.LoadFromStorage(AStorage);
1738       orig.Guid := AGuid;
1739       result := AddOriginal(orig, true);
1740     except on ex:exception do
1741       begin
1742         orig.Free;
1743         raiseError := true;
1744         if Assigned(FOnOriginalLoadError) then
1745           FOnOriginalLoadError(self, ex.Message, raiseError);
1746         if raiseError then
1747           raise ex;
1748       end;
1749     end;
1750   end;
1751 end;
1752 
1753 procedure TBGRALayeredBitmap.SaveOriginalToStream(AIndex: integer;
1754   AStream: TStream);
1755 var
1756   dir: TMemDirectory;
1757   c: TBGRALayerOriginalAny;
1758 begin
1759   if (AIndex < 0) or (AIndex >= OriginalCount) then
1760     raise ERangeError.Create('Index out of bounds');
1761 
1762   if Assigned(FOriginals[AIndex].Instance) then
1763     FOriginals[AIndex].Instance.SaveToStream(AStream)
1764   else
1765   begin
1766     FindOriginal(FOriginals[AIndex].Guid, dir, c);
1767     if dir = nil then
1768       raise exception.Create('Original directory not found');
1769     dir.SaveToStream(AStream);
1770   end;
1771 end;
1772 
1773 procedure TBGRALayeredBitmap.SaveOriginalToStream(const AGuid: TGuid;
1774   AStream: TStream);
1775 var
1776   idxOrig: Integer;
1777 begin
1778   idxOrig := IndexOfOriginal(AGuid);
1779   if idxOrig = -1 then raise exception.Create('Original not found');
1780   SaveOriginalToStream(idxOrig, AStream);
1781 end;
1782 
TBGRALayeredBitmap.RemoveOriginalnull1783 function TBGRALayeredBitmap.RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean;
1784 var
1785   idx: Integer;
1786 begin
1787   idx := IndexOfOriginal(AOriginal);
1788   if idx = -1 then exit(false);
1789   DeleteOriginal(idx);
1790   result := true;
1791 end;
1792 
1793 procedure TBGRALayeredBitmap.DeleteOriginal(AIndex: integer);
1794 var
1795   dir: TMemDirectory;
1796   i: Integer;
1797   guid: TGuid;
1798 begin
1799   if (AIndex < 0) or (AIndex >= OriginalCount) then
1800     raise ERangeError.Create('Index out of bounds');
1801 
1802   guid := FOriginals[AIndex].Guid;
1803   for i := 0 to NbLayers-1 do
1804     if LayerOriginalGuid[i] = guid then
1805     begin
1806       LayerOriginalGuid[i] := GUID_NULL;
1807       LayerOriginalMatrix[i] := AffineMatrixIdentity;
1808     end;
1809 
1810   dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
1811   dir.Delete(GUIDToString(guid),'');
1812 
1813   FOriginals[AIndex].Instance.Free;
1814   FOriginals.Delete(AIndex); //AOriginals freed
1815 end;
1816 
1817 procedure TBGRALayeredBitmap.NotifyLoaded;
1818 var
1819   foundGuid: array of TGuid;
1820   nbFoundGuid: integer;
1821 
1822   procedure AddGuid(const AGuid: TGuid);
1823   begin
1824     foundGuid[nbFoundGuid] := AGuid;
1825     inc(nbFoundGuid);
1826   end;
1827 
IndexOfGuidnull1828   function IndexOfGuid(AGuid: TGuid): integer;
1829   var
1830     i: Integer;
1831   begin
1832     for i := 0 to nbFoundGuid-1 do
1833       if foundGuid[i] = AGuid then exit(i);
1834     result := -1;
1835   end;
1836 
1837 var
1838   i: Integer;
1839   dir: TMemDirectory;
1840   newGuid: TGUID;
1841 
1842 begin
1843   inherited NotifyLoaded;
1844 
1845   //if there are no files in memory, we are sure that there are no originals
1846   if not HasMemFiles then
1847   begin
1848     ClearOriginals;
1849     exit;
1850   end;
1851 
1852   //determine list of GUID of originals
1853   dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
1854   setlength(foundGuid, dir.Count);
1855   nbFoundGuid:= 0;
1856   for i := 0 to dir.Count-1 do
1857     if dir.IsDirectory[i] and (dir.Entry[i].Extension = '') then
1858     begin
1859       if TryStringToGUID(dir.Entry[i].Name, newGuid) then
1860         AddGuid(newGuid);
1861     end;
1862 
1863   //remove originals that do not exist anymore
1864   for i := OriginalCount-1 downto 0 do
1865     if IndexOfGuid(FOriginals[i].Guid) = -1 then
1866       DeleteOriginal(i);
1867 
1868   //add originals from memory directory
1869   for i := 0 to nbFoundGuid-1 do
1870   begin
1871     if IndexOfOriginal(foundGuid[i]) = -1 then
1872     begin
1873       if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create;
1874       FOriginals.Add(BGRALayerOriginalEntry(foundGuid[i]));
1875     end;
1876   end;
1877 end;
1878 
1879 procedure TBGRALayeredBitmap.NotifySaving;
1880 var
1881   i, j, id, ErrPos: Integer;
1882   layersDir, renderDir: TMemDirectory;
1883 begin
1884   inherited NotifySaving;
1885 
1886   RenderOriginalsIfNecessary;
1887 
1888   for i := 0 to OriginalCount-1 do
1889     if Assigned(FOriginals[i].Instance) then
1890       StoreOriginal(FOriginals[i].Instance);
1891 
1892   //check layer storage
1893   if MemDirectory.IndexOf(LayersDirectory,'')<>-1 then
1894   begin
1895     layersDir := MemDirectory.Directory[MemDirectory.AddDirectory(LayersDirectory)];
1896     for i := layersDir.Count-1 downto 0 do
1897     if layersDir.IsDirectory[i] then
1898     begin
1899       renderDir := layersDir.Directory[i].FindPath(RenderSubDirectory);
1900 
1901       if Assigned(renderDir) then
1902       begin
1903         //discard temporary files
1904         renderDir.Delete(RenderTempSubDirectory,'');
1905 
1906         //compress significant files
1907         for j := 0 to renderDir.Count-1 do
1908         begin
1909           if renderDir.Entry[j].FileSize > 128 then
1910             renderDir.IsEntryCompressed[j] := true;
1911         end;
1912       end;
1913 
1914       //remove invalid layer references
1915       val(layersDir.Entry[i].Name, id, errPos);
1916       if (errPos <> 0) or (GetLayerIndexFromId(id)=-1) then
1917         layersDir.Delete(i);
1918     end;
1919     if layersDir.Count = 0 then
1920       MemDirectory.Delete(LayersDirectory,'');
1921   end;
1922 end;
1923 
1924 procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1925   ADraft: boolean; AFullSizeLayer: boolean = false);
1926 begin
1927   RenderLayerFromOriginal(layer, ADraft, rectF(0,0,Width,Height), AFullSizeLayer);
1928 end;
1929 
1930 procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1931   ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false);
1932 var
1933   orig: TBGRALayerCustomOriginal;
1934   rAll, rNewBounds, rInterRender: TRect;
1935   newSource: TBGRABitmap;
1936   layerDir, renderDir: TMemDirectory;
1937   j: integer;
1938 
1939   procedure FreeSource;
1940   begin
1941     if FLayers[layer].Owner then
1942       FreeAndNil(FLayers[layer].Source)
1943     else
1944       FLayers[layer].Source := nil;
1945   end;
1946 
1947 begin
1948   if (layer < 0) or (layer >= NbLayers) then
1949     raise Exception.Create('Index out of bounds');
1950 
1951   orig := LayerOriginal[layer];
1952   if Assigned(orig) then
1953   begin
1954     Unfreeze(layer);
1955     layerDir := GetLayerDirectory(layer, true);
1956     renderDir := layerDir.Directory[layerDir.AddDirectory(RenderSubDirectory)];
1957     //uncompress files for faster access
1958     for j := 0 to renderDir.Count-1 do
1959       renderDir.IsEntryCompressed[j] := false;
1960     orig.RenderStorage := TBGRAMemOriginalStorage.Create(renderDir);
1961 
1962     rAll := rect(0,0,Width,Height);
1963     if AFullSizeLayer then
1964       rNewBounds := rAll
1965     else
1966     begin
1967       rNewBounds := orig.GetRenderBounds(rAll,FLayers[layer].OriginalMatrix);
1968       rNewBounds.Intersect(rAll);
1969     end;
1970     rInterRender := TRect.Intersect(ARenderBounds, rNewBounds);
1971     if (FLayers[layer].x = rNewBounds.Left) and
1972       (FLayers[layer].y = rNewBounds.Top) and
1973       Assigned(FLayers[layer].Source) and
1974       (FLayers[layer].Source.Width = rNewBounds.Width) and
1975       (FLayers[layer].Source.Height = rNewBounds.Height) then
1976     begin
1977       rInterRender.Offset(-rNewBounds.Left, -rNewBounds.Top);
1978       FLayers[layer].Source.FillRect(rInterRender, BGRAPixelTransparent, dmSet);
1979       FLayers[layer].Source.ClipRect := rInterRender;
1980       orig.Render(FLayers[layer].Source, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft);
1981       FLayers[layer].Source.NoClip;
1982     end else
1983     begin
1984       if rInterRender = rNewBounds then
1985       begin
1986         FreeSource;
1987         newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height);
1988         orig.Render(newSource, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft);
1989       end else
1990       begin
1991         newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height);
1992         newSource.PutImage(FLayers[layer].x - rNewBounds.Left, FLayers[layer].y - rNewBounds.Top, FLayers[layer].Source, dmSet);
1993         FreeSource;
1994         rInterRender.Offset(-rNewBounds.Left, -rNewBounds.Top);
1995         if not rInterRender.IsEmpty then
1996         begin
1997           newSource.FillRect(rInterRender, BGRAPixelTransparent, dmSet);
1998           newSource.ClipRect := rInterRender;
1999           orig.Render(newSource, Point(-rNewBounds.Left,-rNewBounds.Top), FLayers[layer].OriginalMatrix, ADraft);
2000           newSource.NoClip;
2001         end;
2002       end;
2003       FLayers[layer].Source := newSource;
2004       FLayers[layer].x := rNewBounds.Left;
2005       FLayers[layer].y := rNewBounds.Top;
2006     end;
2007 
2008     orig.RenderStorage.AffineMatrix['last-matrix'] := FLayers[layer].OriginalMatrix;
2009     orig.RenderStorage.Free;
2010     orig.renderStorage := nil;
2011     if renderDir.Count = 1 then //only matrix
2012       layerDir.Delete(RenderSubDirectory,'');
2013   end;
2014   if ADraft then
2015     FLayers[layer].OriginalRenderStatus := orsDraft
2016   else
2017     FLayers[layer].OriginalRenderStatus := orsProof;
2018   FLayers[layer].OriginalInvalidatedBounds := EmptyRectF;
2019 end;
2020 
2021 procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
2022   ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false);
2023 var
2024   r: TRect;
2025 begin
2026   with ARenderBoundsF do
2027     r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
2028   RenderLayerFromOriginal(layer, ADraft, r, AFullSizeLayer);
2029 end;
2030 
2031 procedure TBGRALayeredBitmap.RenderLayerFromOriginalIfNecessary(layer: integer;
2032   ADraft: boolean; var ABounds: TRect);
2033   procedure UnionLayerArea(ALayer: integer);
2034   var
2035     r: TRect;
2036   begin
2037     if (FLayers[ALayer].Source = nil) or
2038       (FLayers[ALayer].Source.Width = 0) or
2039       (FLayers[ALayer].Source.Height = 0) then exit;
2040 
2041     r := RectWithSize(LayerOffset[ALayer].X, LayerOffset[ALayer].Y,
2042                       FLayers[ALayer].Source.Width, FLayers[ALayer].Source.Height);
2043     if ABounds.IsEmpty then ABounds := r else
2044       ABounds.Union(r);
2045   end;
2046 
2047 var
2048   r: TRect;
2049 
2050 begin
2051   case LayerOriginalRenderStatus[layer] of
2052   orsNone:
2053        begin
2054          UnionLayerArea(layer);
2055          RenderLayerFromOriginal(layer, ADraft);
2056          UnionLayerArea(layer);
2057        end;
2058   orsDraft: if not ADraft then
2059        begin
2060          UnionLayerArea(layer);
2061          RenderLayerFromOriginal(layer, ADraft);
2062          UnionLayerArea(layer);
2063        end;
2064   orsPartialDraft,orsPartialProof:
2065        if not ADraft and (LayerOriginalRenderStatus[layer] = orsPartialDraft) then
2066        begin
2067          UnionLayerArea(layer);
2068          RenderLayerFromOriginal(layer, ADraft, rect(0,0,Width,Height), true);
2069          UnionLayerArea(layer);
2070        end
2071        else
2072        begin
2073          with FLayers[layer].OriginalInvalidatedBounds do
2074            r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
2075          RenderLayerFromOriginal(layer, ADraft, r, true);
2076          if not r.Isempty then
2077          begin
2078            if ABounds.IsEmpty then
2079              ABounds := r
2080            else
2081              ABounds.Union(r);
2082          end;
2083        end;
2084   end;
2085 end;
2086 
TBGRALayeredBitmap.RenderOriginalsIfNecessarynull2087 function TBGRALayeredBitmap.RenderOriginalsIfNecessary(ADraft: boolean): TRect;
2088 var
2089   i: Integer;
2090 begin
2091   result:= EmptyRect;
2092   for i := 0 to NbLayers-1 do
2093     RenderLayerFromOriginalIfNecessary(i, ADraft, result);
2094 end;
2095 
RenderOriginalIfNecessarynull2096 function TBGRALayeredBitmap.RenderOriginalIfNecessary(const AGuid: TGuid;
2097   ADraft: boolean): TRect;
2098 var
2099   i: Integer;
2100 begin
2101   result:= EmptyRect;
2102   for i := 0 to NbLayers-1 do
2103     if LayerOriginalGuid[i] = AGuid then
2104       RenderLayerFromOriginalIfNecessary(i, ADraft, result);
2105 end;
2106 
2107 procedure TBGRALayeredBitmap.RemoveUnusedOriginals;
2108 var useCount: array of integer;
2109   i, idxOrig: Integer;
2110 begin
2111   if OriginalCount = 0 then exit;
2112   setlength(useCount, OriginalCount);
2113   for i := 0 to NbLayers-1 do
2114   begin
2115     idxOrig := IndexOfOriginal(LayerOriginalGuid[i]);
2116     if idxOrig <> -1 then inc(useCount[idxOrig]);
2117   end;
2118   for i := high(useCount) downto 0 do
2119     if useCount[i] = 0 then DeleteOriginal(i);
2120 end;
2121 
2122 procedure TBGRALayeredBitmap.UnloadOriginals;
2123 var
2124   i: Integer;
2125 begin
2126   for i := 0 to OriginalCount-1 do
2127     UnloadOriginal(i);
2128 end;
2129 
2130 procedure TBGRALayeredBitmap.UnloadOriginal(AIndex: integer);
2131 var
2132   origInfo: TBGRALayerOriginalEntry;
2133 begin
2134   if (AIndex >= 0) and (AIndex < OriginalCount) then
2135   begin
2136     origInfo := FOriginals[AIndex];
2137     if Assigned(origInfo.Instance) then
2138     begin
2139       StoreOriginal(origInfo.Instance);
2140       FreeAndNil(origInfo.Instance);
2141       FOriginals[AIndex] := origInfo;
2142     end;
2143   end;
2144 end;
2145 
2146 procedure TBGRALayeredBitmap.UnloadOriginal(const AGuid: TGuid);
2147 begin
2148   UnloadOriginal(IndexOfOriginal(AGuid));
2149 end;
2150 
2151 destructor TBGRALayeredBitmap.Destroy;
2152 begin
2153   FOriginalEditor.Free;
2154   inherited Destroy;
2155 end;
2156 
2157 constructor TBGRALayeredBitmap.Create;
2158 begin
2159   inherited Create;
2160   FWidth := 0;
2161   FHeight := 0;
2162   FNbLayers:= 0;
2163   FOriginals := nil;
2164 end;
2165 
2166 constructor TBGRALayeredBitmap.Create(AWidth, AHeight: integer);
2167 begin
2168   inherited Create;
2169   if AWidth < 0 then
2170     FWidth := 0
2171   else
2172     FWidth := AWidth;
2173   if AHeight < 0 then
2174     FHeight := 0
2175   else
2176     FHeight := AHeight;
2177   FNbLayers:= 0;
2178 end;
2179 
GetLayerBitmapCopynull2180 function TBGRALayeredBitmap.GetLayerBitmapCopy(layer: integer): TBGRABitmap;
2181 begin
2182   result := GetLayerBitmapDirectly(layer).Duplicate;
2183 end;
2184 
GetLayerIndexFromIdnull2185 function TBGRALayeredBitmap.GetLayerIndexFromId(AIdentifier: integer): integer;
2186 var i: integer;
2187 begin
2188   for i := 0 to NbLayers-1 do
2189     if FLayers[i].UniqueId = AIdentifier then
2190     begin
2191       result := i;
2192       exit;
2193     end;
2194   result := -1; //not found
2195 end;
2196 
Duplicatenull2197 function TBGRALayeredBitmap.Duplicate(ASharedLayerIds: boolean): TBGRALayeredBitmap;
2198 begin
2199   result := TBGRALayeredBitmap.Create;
2200   result.Assign(self, ASharedLayerIds);
2201 end;
2202 
TBGRALayeredBitmap.ProduceLayerUniqueIdnull2203 function TBGRALayeredBitmap.ProduceLayerUniqueId: integer;
2204 begin
2205   result := InterLockedIncrement(NextLayerUniqueId);
2206 end;
2207 
2208 procedure TBGRALayeredBitmap.RotateCW;
2209 var i: integer;
2210   newBmp: TBGRABitmap;
2211   newOfs: TPointF;
2212   m: TAffineMatrix;
2213 begin
2214   SetSize(Height,Width); //unfreeze
2215   m := AffineMatrixTranslation(Width,0)*AffineMatrixRotationDeg(90);
2216   for i := 0 to NbLayers-1 do
2217   begin
2218     if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers));
2219     newOfs:= m*PointF(FLayers[i].x,FLayers[i].y+FLayers[i].Source.Height);
2220     newBmp := FLayers[i].Source.RotateCW;
2221     if FLayers[i].Owner then FreeAndNil(FLayers[i].Source);
2222     FLayers[i].Source := newBmp;
2223     FLayers[i].Owner := true;
2224     FLayers[i].x := round(newOfs.x);
2225     FLayers[i].y := round(newOfs.y);
2226     FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix;
2227   end;
2228   if Assigned(OnActionDone) then OnActionDone(self);
2229 end;
2230 
2231 procedure TBGRALayeredBitmap.RotateCCW;
2232 var i: integer;
2233   newBmp: TBGRABitmap;
2234   newOfs: TPointF;
2235   m: TAffineMatrix;
2236 begin
2237   SetSize(Height,Width); //unfreeze
2238   m := AffineMatrixTranslation(0,Height)*AffineMatrixRotationDeg(-90);
2239   for i := 0 to NbLayers-1 do
2240   begin
2241     if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers));
2242     newOfs:= m*PointF(FLayers[i].x+FLayers[i].Source.Width,FLayers[i].y);
2243     newBmp := FLayers[i].Source.RotateCCW;
2244     if FLayers[i].Owner then FreeAndNil(FLayers[i].Source);
2245     FLayers[i].Source := newBmp;
2246     FLayers[i].Owner := true;
2247     FLayers[i].x := round(newOfs.x);
2248     FLayers[i].y := round(newOfs.y);
2249     FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix;
2250   end;
2251   if Assigned(OnActionDone) then OnActionDone(self);
2252 end;
2253 
2254 procedure TBGRALayeredBitmap.RotateUD;
2255 var i: integer;
2256 begin
2257   Unfreeze;
2258   for i := 0 to NbLayers-1 do
2259   begin
2260     if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers));
2261     RotateUD(i);
2262   end;
2263   if Assigned(OnActionDone) then OnActionDone(self);
2264 end;
2265 
2266 procedure TBGRALayeredBitmap.RotateUD(ALayerIndex: integer);
2267 begin
2268   if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then
2269     raise ERangeError.Create('Index out of bounds');
2270   Unfreeze(ALayerIndex);
2271   if FLayers[ALayerIndex].Owner then
2272     FLayers[ALayerIndex].Source.RotateUDInplace
2273   else
2274   begin
2275     FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.RotateUD;
2276     FLayers[ALayerIndex].Owner := true;
2277   end;
2278   FLayers[ALayerIndex].x := Width-FLayers[ALayerIndex].x-FLayers[ALayerIndex].Source.Width;
2279   FLayers[ALayerIndex].y := Height-FLayers[ALayerIndex].y-FLayers[ALayerIndex].Source.Height;
2280   FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(+Width/2,+Height/2)*AffineMatrixScale(-1,-1)*AffineMatrixTranslation(-Width/2,-Height/2)*FLayers[ALayerIndex].OriginalMatrix;
2281 end;
2282 
2283 procedure TBGRALayeredBitmap.HorizontalFlip;
2284 var i: integer;
2285 begin
2286   Unfreeze;
2287   for i := 0 to NbLayers-1 do
2288   begin
2289     if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers));
2290     HorizontalFlip(i);
2291   end;
2292   if Assigned(OnActionDone) then OnActionDone(self);
2293 end;
2294 
2295 procedure TBGRALayeredBitmap.HorizontalFlip(ALayerIndex: integer);
2296 begin
2297   if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then
2298     raise ERangeError.Create('Index out of bounds');
2299   Unfreeze(ALayerIndex);
2300   if FLayers[ALayerIndex].Owner then
2301     FLayers[ALayerIndex].Source.HorizontalFlip
2302   else
2303   begin
2304     FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True);
2305     FLayers[ALayerIndex].Source.HorizontalFlip;
2306     FLayers[ALayerIndex].Owner := true;
2307   end;
2308   FLayers[ALayerIndex].x := Width-FLayers[ALayerIndex].x-FLayers[ALayerIndex].Source.Width;
2309   FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(+Width/2,0)*AffineMatrixScale(-1,1)*AffineMatrixTranslation(-Width/2,0)*FLayers[ALayerIndex].OriginalMatrix;
2310 end;
2311 
2312 procedure TBGRALayeredBitmap.VerticalFlip;
2313 var i: integer;
2314 begin
2315   Unfreeze;
2316   for i := 0 to NbLayers-1 do
2317   begin
2318     if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers));
2319     VerticalFlip(i);
2320   end;
2321   if Assigned(OnActionDone) then OnActionDone(self);
2322 end;
2323 
2324 procedure TBGRALayeredBitmap.VerticalFlip(ALayerIndex: integer);
2325 begin
2326   if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then
2327     raise ERangeError.Create('Index out of bounds');
2328   Unfreeze(ALayerIndex);
2329   if FLayers[ALayerIndex].Owner then
2330     FLayers[ALayerIndex].Source.VerticalFlip
2331   else
2332   begin
2333     FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True);
2334     FLayers[ALayerIndex].Source.VerticalFlip;
2335     FLayers[ALayerIndex].Owner := true;
2336   end;
2337   FLayers[ALayerIndex].y := Height-FLayers[ALayerIndex].y-FLayers[ALayerIndex].Source.Height;
2338   FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(0,+Height/2)*AffineMatrixScale(1,-1)*AffineMatrixTranslation(0,-Height/2)*FLayers[ALayerIndex].OriginalMatrix;
2339 end;
2340 
2341 procedure TBGRALayeredBitmap.Resample(AWidth, AHeight: integer;
2342   AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter);
2343 var i, prevWidth, prevHeight: integer;
2344     resampled: TBGRABitmap;
2345     oldFilter : TResampleFilter;
2346     dummyRect: TRect;
2347 begin
2348   if (AWidth < 0) or (AHeight < 0) then
2349     raise exception.Create('Invalid size');
2350   prevWidth := Width;
2351   if prevWidth < 1 then prevWidth := AWidth;
2352   prevHeight := Height;
2353   if prevHeight < 1 then prevHeight := AHeight;
2354   SetSize(AWidth, AHeight); //unfreeze
2355   dummyRect := EmptyRect;
2356   for i := 0 to NbLayers-1 do
2357   begin
2358     if Assigned(OnActionProgress) then OnActionProgress(self, round(i*100/NbLayers));
2359     if (FLayers[i].OriginalGuid <> GUID_NULL) and LayerOriginalKnown[i] then
2360     begin
2361       LayerOriginalMatrix[i] := AffineMatrixScale(AWidth/prevWidth,AHeight/prevHeight)*LayerOriginalMatrix[i];
2362       if AResampleMode = rmFineResample then RenderLayerFromOriginalIfNecessary(i, false, dummyRect);
2363     end else
2364     begin
2365       if LayerBitmap[i].NbPixels <> 0 then
2366       begin
2367         oldFilter := LayerBitmap[i].ResampleFilter;
2368         LayerBitmap[i].ResampleFilter := AFineResampleFilter;
2369         resampled := LayerBitmap[i].Resample(max(1,round(LayerBitmap[i].Width*AWidth/prevWidth)),
2370           max(1,round(LayerBitmap[i].Height*AHeight/prevHeight)), AResampleMode);
2371         LayerBitmap[i].ResampleFilter := oldFilter;
2372         SetLayerBitmap(i, resampled, True);
2373       end;
2374       with LayerOffset[i] do
2375         LayerOffset[i] := Point(round(X*AWidth/prevWidth),round(Y*AHeight/prevHeight));
2376     end;
2377   end;
2378   if Assigned(OnActionDone) then OnActionDone(self);
2379 end;
2380 
2381 procedure TBGRALayeredBitmap.SetLayerBitmap(layer: integer;
2382   ABitmap: TBGRABitmap; AOwned: boolean);
2383 var
2384   layerDir: TMemDirectory;
2385 begin
2386   if (layer < 0) or (layer >= NbLayers) then
2387     raise Exception.Create('Index out of bounds')
2388   else
2389   begin
2390     if ABitmap = FLayers[layer].Source then exit;
2391     Unfreeze(layer);
2392     if FLayers[layer].Owner then FLayers[layer].Source.Free;
2393     FLayers[layer].Source := ABitmap;
2394     FLayers[layer].Owner := AOwned;
2395     FLayers[layer].OriginalGuid := GUID_NULL;
2396     FLayers[layer].OriginalMatrix := AffineMatrixIdentity;
2397     layerDir := GetLayerDirectory(layer, false);
2398     if Assigned(layerDir) then
2399       layerDir.Delete(RenderSubDirectory,'');
2400   end;
2401 end;
2402 
TBGRALayeredBitmap.TakeLayerBitmapnull2403 function TBGRALayeredBitmap.TakeLayerBitmap(layer: integer): TBGRABitmap;
2404 begin
2405   result := GetLayerBitmapDirectly(layer);
2406   if Assigned(result) then
2407   begin
2408     if FLayers[layer].Owner then FLayers[layer].Owner := false
2409     else result := result.Duplicate;
2410   end;
2411 end;
2412 
2413 procedure TBGRALayeredBitmap.ApplyLayerOffset(ALayerIndex: integer;
2414   APadWithTranparentPixels: boolean);
2415 var
2416   r: TRect;
2417   newBmp: TBGRABitmap;
2418 begin
2419   if APadWithTranparentPixels then
2420   begin
2421     if (LayerOffset[ALayerIndex].X=0) and (LayerOffset[ALayerIndex].Y=0) and
2422        (LayerBitmap[ALayerIndex].Width=Width) and (LayerBitmap[ALayerIndex].Height=Height) then exit;
2423     newBmp := TBGRABitmap.Create(Width,Height);
2424     newBmp.PutImage(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y, LayerBitmap[ALayerIndex], dmSet);
2425     if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free;
2426     FLayers[ALayerIndex].Source := newBmp;
2427     FLayers[ALayerIndex].Owner := true;
2428     FLayers[ALayerIndex].x := 0;
2429     FLayers[ALayerIndex].y := 0;
2430   end else
2431   begin
2432     if (LayerOffset[ALayerIndex].X>=0) and (LayerOffset[ALayerIndex].Y>=0) and
2433        (LayerOffset[ALayerIndex].X+LayerBitmap[ALayerIndex].Width <= Width) and
2434        (LayerOffset[ALayerIndex].Y+LayerBitmap[ALayerIndex].Height <= Height) then exit;
2435     r := RectWithSize(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y,
2436                       LayerBitmap[ALayerIndex].Width, LayerBitmap[ALayerIndex].Height);
2437     r.Intersect( rect(0,0,Width,Height) );
2438     newBmp := TBGRABitmap.Create(r.Width,r.Height);
2439     newBmp.PutImage(LayerOffset[ALayerIndex].X - r.Left, LayerOffset[ALayerIndex].Y - r.Top, LayerBitmap[ALayerIndex], dmSet);
2440     if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free;
2441     FLayers[ALayerIndex].Source := newBmp;
2442     FLayers[ALayerIndex].Owner := true;
2443     FLayers[ALayerIndex].x := r.Left;
2444     FLayers[ALayerIndex].y := r.Top;
2445   end;
2446 end;
2447 
DrawEditornull2448 function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap;
2449   ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect;
2450 begin
2451   result := DrawEditor(ADest, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
2452 end;
2453 
DrawEditornull2454 function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer;
2455   AMatrix: TAffineMatrix; APointSize: single): TRect;
2456 begin
2457   UpdateOriginalEditor(ALayerIndex, AMatrix, APointSize);
2458   if Assigned(OriginalEditor) then
2459     result := OriginalEditor.Render(ADest, rect(0,0,ADest.Width,ADest.Height))
2460     else result := EmptyRect;
2461 end;
2462 
TBGRALayeredBitmap.GetEditorBoundsnull2463 function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer; X,
2464   Y: Integer; APointSize: single): TRect;
2465 begin
2466   result := GetEditorBounds(ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
2467 end;
2468 
TBGRALayeredBitmap.GetEditorBoundsnull2469 function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect;
2470   ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect;
2471 begin
2472   result := GetEditorBounds(ADestRect, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
2473 end;
2474 
TBGRALayeredBitmap.GetEditorBoundsnull2475 function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer;
2476   AMatrix: TAffineMatrix; APointSize: single): TRect;
2477 begin
2478   result := GetEditorBounds(rect(-maxLongint,-maxLongint,maxLongint,maxLongint), ALayerIndex, AMatrix, APointSize);
2479 end;
2480 
TBGRALayeredBitmap.GetEditorBoundsnull2481 function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect; ALayerIndex: integer;
2482   AMatrix: TAffineMatrix; APointSize: single): TRect;
2483 begin
2484   UpdateOriginalEditor(ALayerIndex, AMatrix, APointSize);
2485 
2486   if Assigned(OriginalEditor) then
2487     result := OriginalEditor.GetRenderBounds(ADestRect)
2488     else result := EmptyRect;
2489 end;
2490 
2491 procedure TBGRALayeredBitmap.ClearEditor;
2492 begin
2493   if Assigned(FOriginalEditor) then FOriginalEditor.Clear;
2494   FOriginalEditorOriginal := GUID_NULL;
2495 end;
2496 
2497 procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out
2498   ACursor: TOriginalEditorCursor);
2499 var
2500   handled: boolean;
2501 begin
2502   MouseMove(Shift, ImageX,ImageY, ACursor, handled);
2503 end;
2504 
2505 procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean;
2506   Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
2507 var
2508   handled: boolean;
2509 begin
2510   MouseDown(RightButton, Shift, ImageX,ImageY, ACursor, handled);
2511 end;
2512 
2513 procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState;
2514   ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
2515 var
2516   handled: boolean;
2517 begin
2518   MouseUp(RightButton, Shift, ImageX,ImageY, ACursor, handled);
2519 end;
2520 
2521 procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out
2522   ACursor: TOriginalEditorCursor; out AHandled: boolean);
2523 var
2524   viewPt: TPointF;
2525 begin
2526   if Assigned(OriginalEditor) then
2527   begin
2528     viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY);
2529     OriginalEditor.MouseMove(Shift, viewPt.X, viewPt.Y, ACursor, AHandled);
2530   end
2531   else
2532   begin
2533     ACursor:= oecDefault;
2534     AHandled:= false;
2535   end;
2536 end;
2537 
2538 procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean;
2539   Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out
2540   AHandled: boolean);
2541 var
2542   viewPt: TPointF;
2543 begin
2544   if Assigned(OriginalEditor) then
2545   begin
2546     viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY);
2547     OriginalEditor.MouseDown(RightButton, Shift, viewPt.X, viewPt.Y, ACursor, AHandled);
2548   end
2549   else
2550   begin
2551     ACursor:= oecDefault;
2552     AHandled:= false;
2553   end;
2554 end;
2555 
2556 procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState;
2557   ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
2558 var
2559   viewPt: TPointF;
2560 begin
2561   if Assigned(OriginalEditor) then
2562   begin
2563     viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY);
2564     OriginalEditor.MouseUp(RightButton, Shift, viewPt.X,viewPt.Y, ACursor, AHandled);
2565   end
2566   else
2567   begin
2568     ACursor:= oecDefault;
2569     AHandled:= false;
2570   end;
2571 end;
2572 
2573 procedure TBGRALayeredBitmap.KeyDown(Shift: TShiftState; Key: TSpecialKey; out
2574   AHandled: boolean);
2575 begin
2576   if Assigned(OriginalEditor) then
2577     OriginalEditor.KeyDown(Shift, Key, AHandled)
2578   else
2579     AHandled := false;
2580 end;
2581 
2582 procedure TBGRALayeredBitmap.KeyUp(Shift: TShiftState; Key: TSpecialKey; out
2583   AHandled: boolean);
2584 begin
2585   if Assigned(OriginalEditor) then
2586     OriginalEditor.KeyUp(Shift, Key, AHandled)
2587   else
2588     AHandled := false;
2589 end;
2590 
2591 procedure TBGRALayeredBitmap.KeyPress(UTF8Key: string; out AHandled: boolean);
2592 begin
2593   if Assigned(OriginalEditor) then
2594     OriginalEditor.KeyPress(UTF8Key, AHandled)
2595   else
2596     AHandled := false;
2597 end;
2598 
TBGRALayeredBitmap.IndexOfOriginalnull2599 function TBGRALayeredBitmap.IndexOfOriginal(const AGuid: TGuid): integer;
2600 var
2601   i: Integer;
2602 begin
2603   for i := 0 to OriginalCount-1 do
2604     if FOriginals[i].Guid = AGuid then
2605     begin
2606       result := i;
2607       exit;
2608     end;
2609   result := -1
2610 end;
2611 
TBGRALayeredBitmap.IndexOfOriginalnull2612 function TBGRALayeredBitmap.IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer;
2613 begin
2614   if Assigned(FOriginals) then
2615     result := FOriginals.IndexOf(BGRALayerOriginalEntry(AOriginal))
2616   else
2617     result := -1;
2618 end;
2619 
2620 { TBGRACustomLayeredBitmap }
2621 
TBGRACustomLayeredBitmap.GetLinearBlendnull2622 function TBGRACustomLayeredBitmap.GetLinearBlend: boolean;
2623 begin
2624   result := FLinearBlend;
2625 end;
2626 
TBGRACustomLayeredBitmap.GetSelectionVisiblenull2627 function TBGRACustomLayeredBitmap.GetSelectionVisible: boolean;
2628 begin
2629   result := (FSelectionScanner <> nil) and (FSelectionLayerIndex >= 0) and
2630     (FSelectionLayerIndex < NbLayers) and FSelectionRect.IntersectsWith(rect(0,0,Width,Height));
2631 end;
2632 
GetMemDirectorynull2633 function TBGRACustomLayeredBitmap.GetMemDirectory: TMemDirectory;
2634 begin
2635   if FMemDirectory = nil then
2636   begin
2637     FMemDirectory:= TMemDirectory.Create;
2638     FMemDirectoryOwned := true;
2639   end;
2640   result := FMemDirectory;
2641 end;
2642 
TBGRACustomLayeredBitmap.GetDefaultBlendingOperationnull2643 function TBGRACustomLayeredBitmap.GetDefaultBlendingOperation: TBlendOperation;
2644 begin
2645   result := boTransparent;
2646 end;
2647 
GetHasMemFilesnull2648 function TBGRACustomLayeredBitmap.GetHasMemFiles: boolean;
2649 begin
2650   result := assigned(FMemDirectory) and (FMemDirectory.Count > 0);
2651 end;
2652 
TBGRACustomLayeredBitmap.GetLayerOriginalGuidnull2653 function TBGRACustomLayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid;
2654 begin
2655   result := GUID_NULL;
2656 end;
2657 
GetLayerOriginalRenderStatusnull2658 function TBGRACustomLayeredBitmap.GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus;
2659 begin
2660   result := orsProof;
2661 end;
2662 
GetOriginalCountnull2663 function TBGRACustomLayeredBitmap.GetOriginalCount: integer;
2664 begin
2665   result := 0;
2666 end;
2667 
TBGRACustomLayeredBitmap.GetOriginalByIndexnull2668 function TBGRACustomLayeredBitmap.GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal;
2669 begin
2670   result := nil;
2671   raise exception.Create('Not implemented');
2672 end;
2673 
GetOriginalByIndexKnownnull2674 function TBGRACustomLayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean;
2675 begin
2676   result := true;
2677 end;
2678 
TBGRACustomLayeredBitmap.GetOriginalByIndexLoadednull2679 function TBGRACustomLayeredBitmap.GetOriginalByIndexLoaded(AIndex: integer): boolean;
2680 begin
2681   result := true;
2682 end;
2683 
TBGRACustomLayeredBitmap.GetOriginalByIndexClassnull2684 function TBGRACustomLayeredBitmap.GetOriginalByIndexClass(AIndex: integer): TBGRALayerOriginalAny;
2685 begin
2686   result := nil;
2687 end;
2688 
TBGRACustomLayeredBitmap.GetLayerOriginalnull2689 function TBGRACustomLayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal;
2690 begin
2691   result := nil;
2692 end;
2693 
TBGRACustomLayeredBitmap.GetLayerOriginalKnownnull2694 function TBGRACustomLayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean;
2695 begin
2696   result := true;
2697 end;
2698 
TBGRACustomLayeredBitmap.GetLayerOriginalMatrixnull2699 function TBGRACustomLayeredBitmap.GetLayerOriginalMatrix(layer: integer): TAffineMatrix;
2700 begin
2701   result := AffineMatrixIdentity;
2702 end;
2703 
2704 procedure TBGRACustomLayeredBitmap.SetLinearBlend(AValue: boolean);
2705 begin
2706   Unfreeze;
2707   FLinearBlend := AValue;
2708 end;
2709 
2710 procedure TBGRACustomLayeredBitmap.SetMemDirectory(AValue: TMemDirectory);
2711 begin
2712   if AValue = FMemDirectory then exit;
2713   if FMemDirectoryOwned then FMemDirectory.Free;
2714   FMemDirectory := AValue;
2715   FMemDirectoryOwned := false;
2716 end;
2717 
GetLayerNamenull2718 function TBGRACustomLayeredBitmap.GetLayerName(layer: integer): string;
2719 begin
2720   result := 'Layer' + inttostr(layer+1);
2721 end;
2722 
2723 {$hints off}
GetLayerOffsetnull2724 function TBGRACustomLayeredBitmap.GetLayerOffset(layer: integer): TPoint;
2725 begin
2726   //optional function
resultnull2727   result := Point(0,0);
2728 end;
2729 {$hints on}
2730 
2731 {$hints off}
GetLayerBitmapDirectlynull2732 function TBGRACustomLayeredBitmap.GetLayerBitmapDirectly(layer: integer
2733   ): TBGRABitmap;
2734 begin
2735   //optional function
resultnull2736   result:= nil;
2737 end;
2738 
TBGRACustomLayeredBitmap.GetLayerFrozenRangenull2739 function TBGRACustomLayeredBitmap.GetLayerFrozenRange(layer: integer): integer;
2740 var i: integer;
2741 begin
2742   for i := 0 to high(FFrozenRange) do
2743     if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then
2744     begin
2745       result := i;
2746       exit;
2747     end;
2748   result := -1;
2749 end;
2750 
GetLayerFrozennull2751 function TBGRACustomLayeredBitmap.GetLayerFrozen(layer: integer): boolean;
2752 var i: integer;
2753 begin
2754   for i := 0 to high(FFrozenRange) do
2755     if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then
2756     begin
2757       result := true;
2758       exit;
2759     end;
2760   result := false;
2761 end;
2762 
TBGRACustomLayeredBitmap.GetLayerUniqueIdnull2763 function TBGRACustomLayeredBitmap.GetLayerUniqueId(layer: integer): integer;
2764 begin
2765   result := layer;
2766 end;
2767 
2768 procedure TBGRACustomLayeredBitmap.SetLayerFrozen(layer: integer;
2769   AValue: boolean);
2770 begin
2771   //nothing
2772 end;
2773 
RangeIntersectnull2774 function TBGRACustomLayeredBitmap.RangeIntersect(first1, last1, first2,
2775   last2: integer): boolean;
2776 begin
2777   result := (first1 <= last2) and (last1 >= first2);
2778 end;
2779 
2780 procedure TBGRACustomLayeredBitmap.RemoveFrozenRange(index: integer);
2781 var j,i: integer;
2782 begin
2783   for j := FFrozenRange[index].firstLayer to FFrozenRange[index].lastLayer do
2784     SetLayerFrozen(j,False);
2785   FFrozenRange[index].image.Free;
2786   for i := index to high(FFrozenRange)-1 do
2787     FFrozenRange[i] := FFrozenRange[i+1];
2788   setlength(FFrozenRange,length(FFrozenRange)-1);
2789 end;
2790 
TBGRACustomLayeredBitmap.ContainsFrozenRangenull2791 function TBGRACustomLayeredBitmap.ContainsFrozenRange(first, last: integer): boolean;
2792 var i: integer;
2793 begin
2794   for i := 0 to high(FFrozenRange) do
2795     if (FFrozenRange[i].firstLayer = first) and (FFrozenRange[i].lastLayer = last) then
2796     begin
2797       result := true;
2798       exit;
2799     end;
2800   result := false;
2801 end;
2802 
GetLayerDrawModenull2803 function TBGRACustomLayeredBitmap.GetLayerDrawMode(AIndex: integer): TDrawMode;
2804 begin
2805   if (BlendOperation[AIndex] = boTransparent) and not LinearBlend then
2806     result := dmDrawWithTransparency
2807     else result := dmLinearBlend;
2808 end;
2809 
GetEmptynull2810 function TBGRACustomLayeredBitmap.GetEmpty: boolean;
2811 begin
2812   result := (NbLayers = 0) and (Width = 0) and (Height = 0);
2813 end;
2814 
TBGRACustomLayeredBitmap.IndexOfOriginalnull2815 function TBGRACustomLayeredBitmap.IndexOfOriginal(const AGuid: TGuid): integer;
2816 begin
2817   result := -1;
2818 end;
2819 
TBGRACustomLayeredBitmap.IndexOfOriginalnull2820 function TBGRACustomLayeredBitmap.IndexOfOriginal(
2821   AOriginal: TBGRALayerCustomOriginal): integer;
2822 begin
2823   result := -1;
2824 end;
2825 
2826 procedure TBGRACustomLayeredBitmap.SetWidth(Value: Integer);
2827 begin
2828   //nothing
2829 end;
2830 
2831 procedure TBGRACustomLayeredBitmap.SetHeight(Value: Integer);
2832 begin
2833   //nothing
2834 end;
2835 
GetTransparentnull2836 function TBGRACustomLayeredBitmap.GetTransparent: Boolean;
2837 begin
2838   result := true;
2839 end;
2840 
2841 procedure TBGRACustomLayeredBitmap.SetTransparent(Value: Boolean);
2842 begin
2843   //nothing
2844 end;
2845 
2846 procedure TBGRACustomLayeredBitmap.SaveToFile(const filenameUTF8: string);
2847 var bmp: TBGRABitmap;
2848     ext: string;
2849     temp: TBGRALayeredBitmap;
2850     i: integer;
2851     stream: TFileStreamUTF8;
2852 begin
2853   ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
2854   for i := 0 to high(LayeredBitmapWriters) do
2855     if '.'+LayeredBitmapWriters[i].extension = ext then
2856     begin
2857       temp := LayeredBitmapWriters[i].theClass.Create;
2858       try
2859         temp.Assign(self);
2860         temp.SaveToFile(filenameUTF8);
2861       finally
2862         temp.Free;
2863       end;
2864       exit;
2865     end;
2866 
2867   //when using "data" extension, simply serialize
2868   if (ext='.dat') or (ext='.data') then
2869   begin
2870     if Assigned(LayeredBitmapLoadFromStreamProc) then
2871     begin
2872       stream := TFileStreamUTF8.Create(filenameUTF8, fmCreate);
2873       try
2874         LayeredBitmapSaveToStreamProc(stream, self);
2875       finally
2876         stream.Free;
2877       end;
2878     end else
2879       raise exception.Create('Enable layer serialization by calling BGRAStreamLayers.RegisterStreamLayers');
2880   end else
2881   begin
2882     bmp := ComputeFlatImage;
2883     try
2884       bmp.SaveToFileUTF8(filenameUTF8);
2885     finally
2886       bmp.Free;
2887     end;
2888   end;
2889 end;
2890 
2891 procedure TBGRACustomLayeredBitmap.SaveToStream(Stream: TStream);
2892 begin
2893   if Assigned(LayeredBitmapSaveToStreamProc) then
2894     LayeredBitmapSaveToStreamProc(Stream, self)
2895   else
2896     raise exception.Create('Call BGRAStreamLayers.RegisterStreamLayers first');
2897 end;
2898 
2899 procedure TBGRACustomLayeredBitmap.SaveToStreamAs(Stream: TStream;
2900   AExtension: string);
2901 var bmp: TBGRABitmap;
2902     ext: string;
2903     format: TBGRAImageFormat;
2904     temp: TBGRALayeredBitmap;
2905     i: integer;
2906 begin
2907   ext := UTF8LowerCase(AExtension);
2908   if ext[1] <> '.' then ext := '.'+ext;
2909 
2910   for i := 0 to high(LayeredBitmapWriters) do
2911     if '.'+LayeredBitmapWriters[i].extension = ext then
2912     begin
2913       temp := LayeredBitmapWriters[i].theClass.Create;
2914       try
2915         temp.Assign(self, true, true);
2916         temp.SaveToStream(Stream);
2917       finally
2918         temp.Free;
2919       end;
2920       exit;
2921     end;
2922 
2923   format := SuggestImageFormat(ext);
2924   bmp := ComputeFlatImage;
2925   try
2926     bmp.SaveToStreamAs(Stream, format);
2927   finally
2928     bmp.Free;
2929   end;
2930 end;
2931 
2932 constructor TBGRACustomLayeredBitmap.Create;
2933 begin
2934   FFrozenRange := nil;
2935   FLinearBlend:= True;
2936   FMemDirectory := nil;
2937   FMemDirectoryOwned:= false;
2938   FSelectionDrawMode:= dmDrawWithTransparency;
2939   FSelectionLayerIndex:= -1;
2940   FSelectionRect:= EmptyRect;
2941   FSelectionScanner:= nil;
2942   FSelectionScannerOffset:= Point(0,0);
2943 end;
2944 
2945 {$hints on}
2946 
ToStringnull2947 function TBGRACustomLayeredBitmap.ToString: ansistring;
2948 var
2949   i: integer;
2950 begin
2951   Result := 'LayeredBitmap' + LineEnding + LineEnding;
2952   for i := 0 to NbLayers - 1 do
2953   begin
2954     AppendStr(Result, LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding);
2955   end;
2956 end;
2957 
2958 procedure TBGRACustomLayeredBitmap.DiscardSelection;
2959 begin
2960   fillchar(FSelectionScanner, sizeof(FSelectionScanner), 0);
2961   FSelectionRect := EmptyRect;
2962   FSelectionLayerIndex := -1;
2963   FSelectionScannerOffset:= Point(0,0);
2964 end;
2965 
ComputeFlatImagenull2966 function TBGRACustomLayeredBitmap.ComputeFlatImage(ASeparateXorMask: boolean): TBGRABitmap;
2967 begin
2968   result := ComputeFlatImage(rect(0,0,Width,Height), 0, NbLayers - 1, ASeparateXorMask);
2969 end;
2970 
ComputeFlatImagenull2971 function TBGRACustomLayeredBitmap.ComputeFlatImage(firstLayer,
2972   lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap;
2973 begin
2974   result := ComputeFlatImage(rect(0,0,Width,Height), firstLayer,LastLayer,ASeparateXorMask);
2975 end;
2976 
ComputeFlatImagenull2977 function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect;
2978   ASeparateXorMask: boolean): TBGRABitmap;
2979 begin
2980   result := ComputeFlatImage(ARect,0, NbLayers - 1, ASeparateXorMask);
2981 end;
2982 
2983 destructor TBGRACustomLayeredBitmap.Destroy;
2984 begin
2985   DiscardSelection;
2986   Clear;
2987 end;
2988 
ComputeFlatImagenull2989 function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap;
2990 var
2991   i,j: integer;
2992   destEmpty: boolean;
2993 
2994 begin
2995   if (firstLayer < 0) or (lastLayer > NbLayers-1) then
2996     raise ERangeError.Create('Layer index out of bounds');
2997   If (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then
2998   begin
2999     result := TBGRABitmap.Create(0,0);
3000     exit;
3001   end;
3002   Result := TBGRABitmap.Create(ARect.Right-ARect.Left, ARect.Bottom-ARect.Top);
3003   destEmpty := true;
3004   if SelectionVisible then Unfreeze(SelectionLayerIndex);
3005   i := firstLayer;
3006   while i <= lastLayer do
3007   begin
3008     if LayerFrozen[i] then
3009     begin
3010       j := GetLayerFrozenRange(i);
3011       if j <> -1 then
3012       begin
3013         if i = 0 then
3014           Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmSet) else
3015         if not FFrozenRange[j].linearBlend then
3016           Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmDrawWithTransparency)
3017         else
3018           Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmLinearBlend);
3019         i := FFrozenRange[j].lastLayer+1;
3020         destEmpty := false;
3021         continue;
3022       end;
3023     end;
3024     if DrawLayer(result, -ARect.Left, -ARect.Top, i, ASeparateXorMask, destEmpty) then
3025       destEmpty := false;
3026     inc(i);
3027   end;
3028   if result.XorMask <> nil then
3029     AlphaFillInline(result.XorMask.Data, 0, result.XorMask.NbPixels);
3030 end;
3031 
3032 procedure TBGRACustomLayeredBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
3033 var temp: TBGRABitmap;
3034 begin
3035   if (Rect.Right <= Rect.Left) or (Rect.Bottom <= Rect.Top) then exit;
3036   if (Rect.Right-Rect.Left = Width) and (Rect.Bottom-Rect.Top = Height) then
3037     Draw(ACanvas, Rect.Left,Rect.Top) else
3038   begin
3039     temp := ComputeFlatImage;
3040     BGRAReplace(temp,temp.Resample(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top));
3041     temp.Draw(ACanvas, Rect.Left,Rect.Top, False);
3042     temp.Free;
3043   end;
3044 end;
3045 
3046 procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer);
3047 begin
3048   Draw(Canvas,x,y,0,NbLayers-1);
3049 end;
3050 
3051 procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer; firstLayer, lastLayer: integer);
3052 var temp: TBGRABitmap;
3053 begin
3054   temp := ComputeFlatImage(firstLayer,lastLayer);
3055   temp.Draw(Canvas,x,y,False);
3056   temp.Free;
3057 end;
3058 
3059 procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer);
3060 begin
3061   Draw(Dest, x, y, 0, NbLayers-1);
3062 end;
3063 
3064 procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer;
3065   ASeparateXorMask: boolean; ADestinationEmpty: boolean);
3066 begin
3067   Draw(Dest, x, y, 0, NbLayers-1, ASeparateXorMask, ADestinationEmpty);
3068 end;
3069 
3070 procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; AX, AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean);
3071 var
3072   temp: TBGRABitmap;
3073   i,j: integer;
3074   NewClipRect: TRect;
3075 begin
3076   NewClipRect := TRect.Intersect(rect(AX,AY,AX+Width,AY+Height), Dest.ClipRect);
3077   if NewClipRect.IsEmpty then exit;
3078 
3079   for i := firstLayer to lastLayer do
3080     if LayerVisible[i] and
3081       (not (BlendOperation[i] in[boTransparent,boLinearBlend]) or
3082        ( (SelectionLayerIndex = i) and SelectionVisible
3083          and (SelectionDrawMode <> GetLayerDrawMode(i)) ) ) then
3084     begin
3085       temp := ComputeFlatImage(rect(NewClipRect.Left-AX,NewClipRect.Top-AY,NewClipRect.Right-AX,NewClipRect.Bottom-AY), ASeparateXorMask);
3086       if ADestinationEmpty then
3087         Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmSet) else
3088       if self.LinearBlend then
3089         Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmLinearBlend)
3090         else Dest.PutImage(NewClipRect.Left, NewClipRect.Top, temp, dmDrawWithTransparency);
3091       temp.Free;
3092       exit;
3093     end;
3094 
3095   i := firstLayer;
3096   while i <= lastLayer do
3097   begin
3098     if LayerFrozen[i] then
3099     begin
3100       j := GetLayerFrozenRange(i);
3101       if j <> -1 then
3102       begin
3103         if ADestinationEmpty then
3104           Dest.PutImage(AX, AY, FFrozenRange[j].image, dmSet) else
3105         if not FFrozenRange[j].linearBlend then
3106           Dest.PutImage(AX, AY, FFrozenRange[j].image, dmDrawWithTransparency)
3107           else Dest.PutImage(AX, AY, FFrozenRange[j].image, dmLinearBlend);
3108         i := FFrozenRange[j].lastLayer+1;
3109         ADestinationEmpty := false;
3110         continue;
3111       end;
3112     end;
3113     if DrawLayer(Dest, AX,AY, i, ASeparateXorMask, ADestinationEmpty) then
3114       ADestinationEmpty := false;
3115     inc(i);
3116   end;
3117 end;
3118 
DrawLayernull3119 function TBGRACustomLayeredBitmap.DrawLayer(Dest: TBGRABitmap; X, Y: Integer;
3120   AIndex: integer; ASeparateXorMask: boolean; ADestinationEmpty: boolean): boolean;
3121 type IntArray4 = array[1..4] of integer;
3122 
MergeSortnull3123   function MergeSort(const ATab: IntArray4): IntArray4;
3124   var
3125     posA, posB, pos: Integer;
3126   begin
3127     posA := 1;
3128     posB := 3;
3129     pos := 1;
3130     while (posA <= 2) and (posB <= 4) do
3131     begin
3132       if ATab[posA] <= ATab[posB] then
3133       begin
3134         result[pos] := ATab[posA];
3135         inc(posA);
3136       end else
3137       begin
3138         result[pos] := ATab[posB];
3139         inc(posB);
3140       end;
3141       inc(pos);
3142     end;
3143     while posA <= 2 do
3144     begin
3145       result[pos] := ATab[posA];
3146       inc(posA); inc(pos);
3147     end;
3148     while posB <= 4 do
3149     begin
3150       result[pos] := ATab[posB];
3151       inc(posB); inc(pos);
3152     end;
3153   end;
3154 
3155 var
3156   opacity: Byte;
3157 
3158   procedure Blend(ADestRect: TRect; AScan: IBGRAScanner; AScanOfsX, AScanOfsY: integer; ABlendOp: TBlendOperation);
3159   begin
3160     //XOR mask
3161     if (ABlendOp = boXor) and ASeparateXorMask then
3162     begin
3163       Dest.NeedXorMask;
3164       Dest.XorMask.BlendImageOver(ADestRect, AScan, AScanOfsX, AScanOfsY, ABlendOp, opacity, LinearBlend);
3165     end else
3166     //first layer is simply the background
3167     if ADestinationEmpty and (ABlendOp <> boMask) then
3168     begin
3169       Dest.FillRect(ADestRect, AScan, dmSet, Point(AScanOfsX, AScanOfsY));
3170       Dest.ApplyGlobalOpacity(ADestRect, opacity);
3171     end
3172     else
3173       Dest.BlendImageOver(ADestRect, AScan, AScanOfsX, AScanOfsY, ABlendOp, opacity, LinearBlend);
3174   end;
3175 
3176 var
3177   tempLayer: TBGRABitmap;
3178   tempLayerScanOfs, selScanOfs: TPoint;
3179   blendOp: TBlendOperation;
3180 
3181   procedure BlendBoth(ATile: TRect);
3182   var
3183     mergeBuf: PByte;
3184     pTemp: PByte;
3185     tempStride, rowSize, destStride: PtrInt;
3186     tileWidth, yb: LongInt;
3187     pDest: PByte;
3188   begin
3189     tileWidth := ATile.Width;
3190     rowSize := tileWidth * sizeof(TBGRAPixel);
3191     if not ADestinationEmpty then
3192       getmem(mergeBuf, rowSize)
3193       else mergeBuf := nil;
3194     try
3195       if tempLayer.LineOrder = riloTopToBottom then
3196         tempStride := tempLayer.RowSize else tempStride := -tempLayer.RowSize;
3197       pTemp := tempLayer.GetPixelAddress(ATile.Left + tempLayerScanOfs.X,
3198                  ATile.Top + tempLayerScanOfs.Y);
3199       pDest := Dest.GetPixelAddress(ATile.Left, ATile.Top);
3200       if Dest.LineOrder = riloTopToBottom then
3201         destStride := Dest.RowSize else destStride := -Dest.RowSize;
3202       if ADestinationEmpty then
3203       begin
3204         for yb := ATile.Top to ATile.Bottom-1 do
3205         begin
3206           move(pTemp^, pDest^, rowSize);
3207           SelectionScanner.ScanMoveTo(ATile.Left + selScanOfs.X, yb + selScanOfs.Y);
3208           ScannerPutPixels(SelectionScanner, PBGRAPixel(pDest), tileWidth, SelectionDrawMode);
3209           inc(pTemp, tempStride);
3210           inc(pDest, destStride);
3211         end;
3212         Dest.ApplyGlobalOpacity(ATile, opacity);
3213       end else
3214       begin
3215         for yb := ATile.Top to ATile.Bottom-1 do
3216         begin
3217           move(pTemp^, mergeBuf^, rowSize);
3218           SelectionScanner.ScanMoveTo(ATile.Left + selScanOfs.X, yb + selScanOfs.Y);
3219           ScannerPutPixels(SelectionScanner, PBGRAPixel(mergeBuf), tileWidth, SelectionDrawMode);
3220           BlendPixelsOver(PBGRAPixel(pDest), PBGRAPixel(mergeBuf),
3221               blendOp, tileWidth, opacity, LinearBlend);
3222           inc(pTemp, tempStride);
3223           inc(pDest, destStride);
3224         end;
3225       end;
3226     finally
3227       freemem(mergeBuf);
3228     end;
3229   end;
3230 
3231 var
3232   mustFreeCopy, containsSel, containsLayer: Boolean;
3233   ofs: TPoint;
3234   rSel, oldClip, rLayer, rTile: TRect;
3235   xTab,yTab: IntArray4;
3236   xb, yb: Integer;
3237 begin
3238   if not LayerVisible[AIndex] then exit(false);
3239   opacity := LayerOpacity[AIndex];
3240   if opacity = 0 then exit(false);
3241 
3242   tempLayer := GetLayerBitmapDirectly(AIndex);
3243   if tempLayer <> nil then mustFreeCopy := false else
3244     begin
3245       mustFreeCopy := true;
3246       tempLayer := GetLayerBitmapCopy(AIndex);
3247     end;
3248 
3249   ofs := LayerOffset[AIndex];
3250   oldClip := Dest.IntersectClip(rect(X,Y,X+self.Width,Y+self.Height));
3251 
3252   if (SelectionLayerIndex = AIndex) and SelectionVisible then
3253   begin
3254     rSel := SelectionRect;
3255     rSel.Offset(X, Y);
3256     rSel.Intersect(Dest.ClipRect);
3257   end else
3258     rSel := EmptyRect;
3259 
3260   if Assigned(tempLayer) then
3261   begin
3262     rLayer := RectWithSize(ofs.x + X, ofs.y + Y, tempLayer.Width, tempLayer.Height);
3263     rLayer.Intersect(Dest.ClipRect);
3264   end else
3265     rLayer := EmptyRect;
3266 
3267   if (tempLayer <> nil) and (not rLayer.IsEmpty or not rSel.IsEmpty) then
3268   begin
3269     if AIndex = 0 then blendOp := boTransparent else blendOp := BlendOperation[AIndex];
3270     tempLayerScanOfs := Point(-(ofs.X+X), -(ofs.Y+Y));
3271 
3272     if rSel.IsEmpty then
3273       Blend(rLayer, tempLayer, tempLayerScanOfs.X, tempLayerScanOfs.y, blendOp)
3274     else
3275     begin
3276       selScanOfs := Point(SelectionScannerOffset.X - X, SelectionScannerOffset.Y - Y);
3277 
3278       xTab[1] := rSel.Left;    yTab[1] := rSel.Top;
3279       xTab[2] := rSel.Right;   yTab[2] := rSel.Bottom;
3280       xTab[3] := rLayer.Left;  yTab[3] := rLayer.Top;
3281       xTab[4] := rLayer.Right; yTab[4] := rLayer.Bottom;
3282       xTab := MergeSort(xTab); yTab := MergeSort(yTab);
3283 
3284       for yb := 1 to 3 do
3285       begin
3286         rTile.Top := yTab[yb];
3287         rTile.Bottom := yTab[yb+1];
3288         if rTile.Bottom > rTile.Top then
3289           for xb := 1 to 3 do
3290           begin
3291             rTile.Left := xTab[xb];
3292             rTile.Right := xTab[xb+1];
3293             if rTile.Right > rTile.Left then
3294             begin
3295               containsSel := rTile.IntersectsWith(rSel);
3296               containsLayer := rTile.IntersectsWith(rLayer);
3297               if containsLayer then
3298               begin
3299                 if not containsSel then
3300                   Blend(rTile, tempLayer, tempLayerScanOfs.X, tempLayerScanOfs.y, blendOp)
3301                 else
3302                   BlendBoth(rTile);
3303               end else
3304               if containsSel then
3305                 Blend(rTile, SelectionScanner, selScanOfs.X, selScanOfs.Y, blendOp)
3306             end;
3307           end;
3308       end;
3309     end;
3310 
3311     result := true;
3312   end else
3313     result := false;
3314 
3315   Dest.ClipRect := oldClip;
3316   if mustFreeCopy then tempLayer.Free;
3317 end;
3318 
3319 procedure TBGRACustomLayeredBitmap.FreezeExceptOneLayer(layer: integer);
3320 begin
3321   if (layer < 0) or (layer >= NbLayers) then
3322   begin
3323     Freeze;
3324     exit;
3325   end;
3326   Unfreeze(layer,layer);
3327   if layer > 1 then
3328     Freeze(0,layer-1);
3329   if layer < NbLayers-2 then
3330     Freeze(layer+1,NbLayers-1);
3331 end;
3332 
3333 procedure TBGRACustomLayeredBitmap.Freeze(firstLayer, lastLayer: integer);
3334 
3335   procedure DoFreeze(first,last: integer; linear: boolean);
3336   var i,nbVisible: integer;
3337     computedImage: TBGRABitmap;
3338   begin
3339     if last <= first then exit; //at least 2 frozen layers
3340     nbVisible := 0;
3341     for i := first to last do
3342       if LayerVisible[i] and (LayerOpacity[i] > 0) then inc(nbVisible);
3343     if nbvisible < 2 then exit;  //at least 2 frozen layers
3344 
3345     if ContainsFrozenRange(first,last) then exit; //already frozen
3346     Unfreeze(first,last);
3347 
3348     computedImage := ComputeFlatImage(first,last); //must compute before layers are considered as frozen
3349     setlength(FFrozenRange, length(FFrozenRange)+1);
3350     with FFrozenRange[high(FFrozenRange)] do
3351     begin
3352       firstLayer := first;
3353       lastLayer:= last;
3354       image := computedImage;
3355       linearBlend := linear;
3356     end;
3357     for i := first to last do
3358       SetLayerFrozen(i,True);
3359   end;
3360 
3361 var j: integer;
3362   start: integer;
3363   linear,nextLinear: boolean;
3364 begin
3365   start := -1;
3366   linear := false; //to avoid hint
3367   for j := firstlayer to lastLayer do
3368   if ((BlendOperation[j] in [boTransparent,boLinearBlend]) or (start = 0) or ((firstlayer= 0) and (j=0)))
3369      and (not SelectionVisible or (j <> SelectionLayerIndex)) then
3370   begin
3371     nextLinear := (BlendOperation[j] = boLinearBlend) or self.LinearBlend;
3372     if start = -1 then
3373     begin
3374       start := j;
3375       linear := nextLinear;
3376     end else
3377     begin
3378       if linear <> nextLinear then
3379       begin
3380         DoFreeze(start,j-1,linear);
3381         start := j;
3382         linear := nextLinear;
3383       end;
3384     end;
3385   end else
3386   begin
3387     if start <> -1 then
3388     begin
3389       DoFreeze(start,j-1,linear);
3390       start := -1;
3391     end;
3392   end;
3393   if start <> -1 then
3394     DoFreeze(start,lastLayer,linear);
3395 end;
3396 
3397 procedure TBGRACustomLayeredBitmap.Freeze;
3398 begin
3399   Freeze(0,NbLayers-1);
3400 end;
3401 
3402 procedure TBGRACustomLayeredBitmap.Unfreeze;
3403 begin
3404   Unfreeze(0,NbLayers-1);
3405 end;
3406 
3407 procedure TBGRACustomLayeredBitmap.Unfreeze(layer: integer);
3408 begin
3409   Unfreeze(layer,layer);
3410 end;
3411 
3412 procedure TBGRACustomLayeredBitmap.Unfreeze(firstLayer, lastLayer: integer);
3413 var i: integer;
3414 begin
3415   for i := high(FFrozenRange) downto 0 do
3416     if RangeIntersect(firstLayer,lastLayer,FFrozenRange[i].firstLayer,FFrozenRange[i].lastLayer) then
3417       RemoveFrozenRange(i);
3418 end;
3419 
3420 procedure TBGRACustomLayeredBitmap.NotifyLoaded;
3421 begin
3422   //nothing
3423 end;
3424 
3425 procedure TBGRACustomLayeredBitmap.NotifySaving;
3426 begin
3427   //nothing
3428 end;
3429 
3430 procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
3431 begin
3432   setlength(LayeredBitmapReaders,length(LayeredBitmapReaders)+1);
3433   with LayeredBitmapReaders[high(LayeredBitmapReaders)] do
3434   begin
3435     extension:= UTF8LowerCase(AExtensionUTF8);
3436     theClass := AReader;
3437   end;
3438 end;
3439 
TryCreateLayeredBitmapWriternull3440 function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap;
3441 var
3442   i: Integer;
3443 begin
3444   AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8);
3445   if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then
3446     AExtensionUTF8:= '.'+AExtensionUTF8;
3447   for i := 0 to high(LayeredBitmapWriters) do
3448     if '.'+LayeredBitmapWriters[i].extension = AExtensionUTF8 then
3449     begin
3450       result := LayeredBitmapWriters[i].theClass.Create;
3451       exit;
3452     end;
3453   result := nil;
3454 end;
3455 
TryCreateLayeredBitmapReadernull3456 function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap;
3457 var
3458   i: Integer;
3459 begin
3460   AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8);
3461   if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then
3462     AExtensionUTF8:= '.'+AExtensionUTF8;
3463   for i := 0 to high(LayeredBitmapReaders) do
3464     if '.'+LayeredBitmapReaders[i].extension = AExtensionUTF8 then
3465     begin
3466       result := LayeredBitmapReaders[i].theClass.Create;
3467       exit;
3468     end;
3469   result := nil;
3470 end;
3471 
3472 procedure OnLayeredBitmapLoadFromStreamStart;
3473 begin
3474   OnLayeredBitmapLoadStart('<Stream>');
3475 end;
3476 
3477 procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
3478 var i: Integer;
3479 begin
3480   with LayeredBitmapLoadEvents do if Assigned(OnStart) then
3481     for i := 0 to OnStart.Count-1 do OnStart[i](AFilenameUTF8);
3482 end;
3483 
3484 procedure OnLayeredBitmapLoadProgress(APercentage: integer);
3485 var i: Integer;
3486 begin
3487   with LayeredBitmapLoadEvents do if Assigned(OnProgress) then
3488     for i := 0 to OnProgress.Count-1 do OnProgress[i](APercentage);
3489 end;
3490 
3491 procedure OnLayeredBitmapLoaded;
3492 var i: Integer;
3493 begin
3494   with LayeredBitmapLoadEvents do if Assigned(OnDone) then
3495     for i := 0 to OnDone.Count-1 do OnDone[i];
3496 end;
3497 
3498 procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
3499   AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc);
3500 begin
3501   with LayeredBitmapLoadEvents do begin
3502     if (AStart <> nil) and ((OnStart = nil) or (OnStart.IndexOf(AStart) = -1)) then
3503     begin
3504       if OnStart = nil then OnStart := TOnLayeredBitmapLoadStartProcList.Create;
3505       OnStart.Add(AStart);
3506     end;
3507     if (AProgress <> nil) and ((OnProgress = nil) or (OnProgress.IndexOf(AProgress) = -1)) then
3508     begin
3509       if OnProgress = nil then OnProgress := TOnLayeredBitmapLoadProgressProcList.Create;
3510       OnProgress.Add(AProgress);
3511     end;
3512     if (ADone <> nil) and ((OnDone = nil) or (OnDone.IndexOf(ADone) = -1)) then
3513     begin
3514       if OnDone = nil then OnDone := TOnLayeredBitmapLoadedProcList.Create;
3515       OnDone.Add(ADone);
3516     end;
3517   end;
3518 end;
3519 
3520 procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
3521   AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc);
3522 begin
3523   with LayeredBitmapLoadEvents do begin
3524     if Assigned(OnStart) then OnStart.Remove(AStart);
3525     if Assigned(OnProgress) then OnProgress.Remove(AProgress);
3526     if Assigned(OnDone) then OnDone.Remove(ADone);
3527   end;
3528 end;
3529 
3530 procedure OnLayeredBitmapSaveToStreamStart;
3531 begin
3532   OnLayeredBitmapSaveStart('<Stream>');
3533 end;
3534 
3535 procedure OnLayeredBitmapSaveStart(AFilenameUTF8: string);
3536 var i: Integer;
3537 begin
3538   with LayeredBitmapSaveEvents do if Assigned(OnStart) then
3539     for i := 0 to OnStart.Count-1 do OnStart[i](AFilenameUTF8);
3540 end;
3541 
3542 procedure OnLayeredBitmapSaveProgress(APercentage: integer);
3543 var i: Integer;
3544 begin
3545   with LayeredBitmapSaveEvents do if Assigned(OnProgress) then
3546     for i := 0 to OnProgress.Count-1 do OnProgress[i](APercentage);
3547 end;
3548 
3549 procedure OnLayeredBitmapSaved;
3550 var i: Integer;
3551 begin
3552   with LayeredBitmapSaveEvents do if Assigned(OnDone) then
3553     for i := 0 to OnDone.Count-1 do OnDone[i];
3554 end;
3555 
3556 procedure RegisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc;
3557   AProgress: TOnLayeredBitmapSaveProgressProc; ADone: TOnLayeredBitmapSavedProc);
3558 begin
3559   with LayeredBitmapSaveEvents do begin
3560     if (AStart <> nil) and ((OnStart = nil) or (OnStart.IndexOf(AStart) = -1)) then
3561     begin
3562       if OnStart = nil then OnStart := TOnLayeredBitmapSaveStartProcList.Create;
3563       OnStart.Add(AStart);
3564     end;
3565     if (AProgress <> nil) and ((OnProgress = nil) or (OnProgress.IndexOf(AProgress) = -1)) then
3566     begin
3567       if OnProgress = nil then OnProgress := TOnLayeredBitmapSaveProgressProcList.Create;
3568       OnProgress.Add(AProgress);
3569     end;
3570     if (ADone <> nil) and ((OnDone = nil) or (OnDone.IndexOf(ADone) = -1)) then
3571     begin
3572       if OnDone = nil then OnDone := TOnLayeredBitmapSavedProcList.Create;
3573       OnDone.Add(ADone);
3574     end;
3575   end;
3576 end;
3577 
3578 procedure UnregisterSavingHandler(AStart: TOnLayeredBitmapSaveStartProc;
3579   AProgress: TOnLayeredBitmapSaveProgressProc; ADone: TOnLayeredBitmapSavedProc);
3580 begin
3581   with LayeredBitmapSaveEvents do begin
3582     if Assigned(OnStart) then OnStart.Remove(AStart);
3583     if Assigned(OnProgress) then OnProgress.Remove(AProgress);
3584     if Assigned(OnDone) then OnDone.Remove(ADone);
3585   end;
3586 end;
3587 
3588 procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
3589 begin
3590   while (length(AExtensionUTF8)>0) and (AExtensionUTF8[1]='.') do delete(AExtensionUTF8,1,1);
3591   setlength(LayeredBitmapWriters,length(LayeredBitmapWriters)+1);
3592   with LayeredBitmapWriters[high(LayeredBitmapWriters)] do
3593   begin
3594     extension:= UTF8LowerCase(AExtensionUTF8);
3595     theClass := AWriter;
3596   end;
3597 end;
3598 
3599 initialization
3600 
3601   NextLayerUniqueId := 1;
3602 
3603 finalization
3604 
3605   with LayeredBitmapLoadEvents do begin
3606     OnStart.Free;
3607     OnProgress.Free;
3608     OnDone.Free;
3609   end;
3610   with LayeredBitmapSaveEvents do begin
3611     OnStart.Free;
3612     OnProgress.Free;
3613     OnDone.Free;
3614   end;
3615 
3616 end.
3617 
3618