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