source: trunk/Packages/bgrabitmap/bgralayers.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 92.3 KB
Line 
1unit BGRALayers;
2
3{$mode objfpc}{$H+}
4{$MODESWITCH ADVANCEDRECORDS}
5
6interface
7
8uses
9 BGRAGraphics, Classes, SysUtils, Types, BGRABitmapTypes, BGRABitmap,
10 BGRAMemDirectory, BGRATransform, fgl, BGRALayerOriginal;
11
12type
13 TBGRACustomLayeredBitmap = class;
14 TBGRACustomLayeredBitmapClass = class of TBGRACustomLayeredBitmap;
15
16 { TBGRALayerOriginalEntry }
17
18 TBGRALayerOriginalEntry = record
19 Guid: TGuid;
20 Instance: TBGRALayerCustomOriginal;
21 class operator = (const AEntry1,AEntry2: TBGRALayerOriginalEntry): boolean;
22 end;
23
24function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry;
25function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry;
26
27type
28 TBGRALayerOriginalList = specialize TFPGList<TBGRALayerOriginalEntry>;
29
30 TBGRALayeredBitmap = class;
31 TBGRALayeredBitmapClass = class of TBGRALayeredBitmap;
32
33 TBGRALayeredBitmapSaveToStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
34 TBGRALayeredBitmapLoadFromStreamProc = procedure(AStream: TStream; ALayers: TBGRACustomLayeredBitmap);
35 TBGRALayeredBitmapCheckStreamProc = function(AStream: TStream): boolean;
36 TOriginalRenderStatus = (orsNone, orsDraft, orsPartialDraft, orsProof, orsPartialProof);
37
38 { TBGRACustomLayeredBitmap }
39
40 TBGRACustomLayeredBitmap = class(TGraphic)
41 private
42 FFrozenRange: array of record
43 firstLayer,lastLayer: integer;
44 image: TBGRABitmap;
45 linearBlend: boolean;
46 end;
47 FLinearBlend: boolean;
48 FMemDirectory: TMemDirectory;
49 FMemDirectoryOwned: boolean;
50 function GetDefaultBlendingOperation: TBlendOperation;
51 function GetHasMemFiles: boolean;
52 function GetLinearBlend: boolean;
53 procedure SetLinearBlend(AValue: boolean);
54
55 protected
56 function GetNbLayers: integer; virtual; abstract;
57 function GetMemDirectory: TMemDirectory;
58 function GetBlendOperation(Layer: integer): TBlendOperation; virtual; abstract;
59 function GetLayerVisible(layer: integer): boolean; virtual; abstract;
60 function GetLayerOpacity(layer: integer): byte; virtual; abstract;
61 function GetLayerName(layer: integer): string; virtual;
62 function GetLayerOffset(layer: integer): TPoint; virtual;
63 function GetLayerFrozenRange(layer: integer): integer;
64 function GetLayerFrozen(layer: integer): boolean; virtual;
65 function GetLayerUniqueId(layer: integer): integer; virtual;
66 function GetLayerOriginal({%H-}layer: integer): TBGRALayerCustomOriginal; virtual;
67 function GetLayerOriginalKnown({%H-}layer: integer): boolean; virtual;
68 function GetLayerOriginalMatrix({%H-}layer: integer): TAffineMatrix; virtual;
69 function GetLayerOriginalGuid({%H-}layer: integer): TGuid; virtual;
70 function GetLayerOriginalRenderStatus({%H-}layer: integer): TOriginalRenderStatus; virtual;
71 function GetOriginalCount: integer; virtual;
72 function GetOriginalByIndex({%H-}AIndex: integer): TBGRALayerCustomOriginal; virtual;
73 function GetOriginalByIndexKnown({%H-}AIndex: integer): boolean; virtual;
74 function GetTransparent: Boolean; override;
75 function GetEmpty: boolean; override;
76
77 function IndexOfOriginal(AGuid: TGuid): integer; overload; virtual;
78 function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; virtual;
79
80 procedure SetWidth(Value: Integer); override;
81 procedure SetHeight(Value: Integer); override;
82 procedure SetMemDirectory(AValue: TMemDirectory);
83 procedure SetTransparent(Value: Boolean); override;
84
85 procedure SetLayerFrozen(layer: integer; AValue: boolean); virtual;
86 function RangeIntersect(first1,last1,first2,last2: integer): boolean;
87 procedure RemoveFrozenRange(index: integer);
88 function ContainsFrozenRange(first,last: integer): boolean;
89
90 public
91 procedure SaveToFile(const filenameUTF8: string); override;
92 procedure SaveToStream(Stream: TStream); override;
93 procedure SaveToStreamAs(Stream: TStream; AExtension: string);
94 constructor Create; override;
95 destructor Destroy; override;
96 function ToString: ansistring; override;
97 function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; virtual;
98 function GetLayerBitmapCopy(layer: integer): TBGRABitmap; virtual; abstract;
99 function ComputeFlatImage(ASeparateXorMask: boolean = false): TBGRABitmap; overload;
100 function ComputeFlatImage(firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload;
101 function ComputeFlatImage(ARect: TRect; ASeparateXorMask: boolean = false): TBGRABitmap; overload;
102 function ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false): TBGRABitmap; overload;
103 procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; overload;
104 procedure Draw(Canvas: TCanvas; x,y: integer); overload;
105 procedure Draw(Canvas: TCanvas; x,y: integer; firstLayer, lastLayer: integer); overload;
106 procedure Draw(Dest: TBGRABitmap; x,y: integer); overload;
107 procedure Draw(Dest: TBGRABitmap; x,y: integer; ASeparateXorMask: boolean); overload;
108 procedure Draw(Dest: TBGRABitmap; AX,AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean = false); overload;
109
110 procedure FreezeExceptOneLayer(layer: integer); overload;
111 procedure Freeze(firstLayer, lastLayer: integer); overload;
112 procedure Freeze; overload;
113 procedure Unfreeze; overload;
114 procedure Unfreeze(layer: integer); overload;
115 procedure Unfreeze(firstLayer, lastLayer: integer); overload;
116
117 procedure NotifyLoaded; virtual;
118 procedure NotifySaving; virtual;
119
120 property NbLayers: integer read GetNbLayers;
121 property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation;
122 property LayerVisible[layer: integer]: boolean read GetLayerVisible;
123 property LayerOpacity[layer: integer]: byte read GetLayerOpacity;
124 property LayerName[layer: integer]: string read GetLayerName;
125 property LayerOffset[layer: integer]: TPoint read GetLayerOffset;
126 property LayerFrozen[layer: integer]: boolean read GetLayerFrozen;
127 property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId;
128 property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal;
129 property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown;
130 property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid;
131 property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix;
132 property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus;
133 property LinearBlend: boolean read GetLinearBlend write SetLinearBlend; //use linear blending unless specified
134 property DefaultBlendingOperation: TBlendOperation read GetDefaultBlendingOperation;
135 property MemDirectory: TMemDirectory read GetMemDirectory write SetMemDirectory;
136 property MemDirectoryOwned: boolean read FMemDirectoryOwned write FMemDirectoryOwned;
137 property HasMemFiles: boolean read GetHasMemFiles;
138 end;
139
140 TEmbeddedOriginalChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal) of object;
141 TEmbeddedOriginalEditingChangeEvent = procedure (ASender: TObject; AOriginal: TBGRALayerCustomOriginal) of object;
142
143 TBGRALayerInfo = record
144 UniqueId: integer;
145 Name: string;
146 x, y: integer;
147 Source: TBGRABitmap;
148 blendOp: TBlendOperation;
149 Opacity: byte;
150 Visible: boolean;
151 Owner: boolean;
152 Frozen: boolean;
153 OriginalMatrix: TAffineMatrix;
154 OriginalRenderStatus: TOriginalRenderStatus;
155 OriginalGuid: TGuid;
156 OriginalInvalidatedBounds: TRectF;
157 end;
158
159 { TBGRALayeredBitmap }
160
161 TBGRALayeredBitmap = class(TBGRACustomLayeredBitmap)
162 private
163 FNbLayers: integer;
164 FLayers: array of TBGRALayerInfo;
165 FOriginalChange: TEmbeddedOriginalChangeEvent;
166 FOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent;
167 FWidth,FHeight: integer;
168 FOriginals: TBGRALayerOriginalList;
169 FOriginalEditor: TBGRAOriginalEditor;
170 FOriginalEditorOriginal: TBGRALayerCustomOriginal;
171 FOriginalEditorViewMatrix: TAffineMatrix;
172 function GetOriginalGuid(AIndex: integer): TGUID;
173
174 protected
175 function GetWidth: integer; override;
176 function GetHeight: integer; override;
177 function GetNbLayers: integer; override;
178 function GetBlendOperation(Layer: integer): TBlendOperation; override;
179 function GetLayerVisible(layer: integer): boolean; override;
180 function GetLayerOpacity(layer: integer): byte; override;
181 function GetLayerOffset(layer: integer): TPoint; override;
182 function GetLayerName(layer: integer): string; override;
183 function GetLayerFrozen(layer: integer): boolean; override;
184 function GetLayerUniqueId(layer: integer): integer; override;
185 function GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal; override;
186 function GetLayerOriginalKnown(layer: integer): boolean; override;
187 function GetLayerOriginalMatrix(layer: integer): TAffineMatrix; override;
188 function GetLayerOriginalGuid(layer: integer): TGuid; override;
189 function GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus; override;
190 function GetOriginalCount: integer; override;
191 function GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal; override;
192 function GetOriginalByIndexKnown(AIndex: integer): boolean; override;
193 procedure SetBlendOperation(Layer: integer; op: TBlendOperation);
194 procedure SetLayerVisible(layer: integer; AValue: boolean);
195 procedure SetLayerOpacity(layer: integer; AValue: byte);
196 procedure SetLayerOffset(layer: integer; AValue: TPoint);
197 procedure SetLayerName(layer: integer; AValue: string);
198 procedure SetLayerFrozen(layer: integer; AValue: boolean); override;
199 procedure SetLayerUniqueId(layer: integer; AValue: integer);
200 procedure SetLayerOriginalMatrix(layer: integer; AValue: TAffineMatrix);
201 procedure SetLayerOriginalGuid(layer: integer; const AValue: TGuid);
202 procedure SetLayerOriginalRenderStatus(layer: integer; AValue: TOriginalRenderStatus);
203
204 procedure FindOriginal(AGuid: TGuid;
205 out ADir: TMemDirectory;
206 out AClass: TBGRALayerOriginalAny);
207 procedure StoreOriginal(AOriginal: TBGRALayerCustomOriginal);
208 procedure OriginalChange(ASender: TObject; ABounds: PRectF = nil);
209 procedure OriginalEditingChange(ASender: TObject);
210
211 public
212 procedure LoadFromFile(const filenameUTF8: string); override;
213 procedure LoadFromStream(stream: TStream); override;
214 procedure LoadFromResource(AFilename: string);
215 procedure SetSize(AWidth, AHeight: integer); virtual;
216 procedure Clear; override;
217 procedure ClearOriginals;
218 procedure RemoveLayer(index: integer);
219 procedure InsertLayer(index: integer; fromIndex: integer);
220 procedure Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean = false); overload;
221 function MoveLayerUp(index: integer): integer;
222 function MoveLayerDown(index: integer): integer;
223
224 function AddLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload;
225 function AddLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload;
226 function AddLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
227 function AddLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
228 function AddLayer(AName: string; Source: TBGRABitmap; Opacity: byte = 255): integer; overload;
229 function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255; Shared: boolean = false): integer; overload;
230 function AddLayer(AName: string; Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
231 function AddLayer(AName: string; Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
232 function AddSharedLayer(Source: TBGRABitmap; Opacity: byte = 255): integer; overload;
233 function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
234 function AddSharedLayer(Source: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
235 function AddSharedLayer(Source: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
236 function AddLayerFromFile(AFileName: string; Opacity: byte = 255): integer; overload;
237 function AddLayerFromFile(AFileName: string; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
238 function AddLayerFromFile(AFileName: string; Position: TPoint; Opacity: byte = 255): integer; overload;
239 function AddLayerFromFile(AFileName: string; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
240 function AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte = 255): integer; overload;
241 function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
242 function AddOwnedLayer(ABitmap: TBGRABitmap; Position: TPoint; Opacity: byte = 255): integer; overload;
243 function AddOwnedLayer(ABitmap: TBGRABitmap; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
244 function AddLayerFromOriginal(AGuid: TGuid; Opacity: byte = 255): integer; overload;
245 function AddLayerFromOriginal(AGuid: TGuid; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
246 function AddLayerFromOriginal(AGuid: TGuid; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload;
247 function AddLayerFromOriginal(AGuid: TGuid; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
248 function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Opacity: byte = 255): integer; overload;
249 function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
250 function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte = 255): integer; overload;
251 function AddLayerFromOwnedOriginal(AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte = 255): integer; overload;
252
253 function AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean = true): integer;
254 function AddOriginalFromStream(AStream: TStream; ALateLoad: boolean = false): integer;
255 function AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean = false): integer;
256 procedure SaveOriginalToStream(AIndex: integer; AStream: TStream); overload;
257 procedure SaveOriginalToStream(AGuid: TGUID; AStream: TStream); overload;
258 function RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean;
259 procedure DeleteOriginal(AIndex: integer);
260 procedure NotifyLoaded; override;
261 procedure NotifySaving; override;
262 procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean = false; AFullSizeLayer: boolean = false); overload;
263 procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false); overload;
264 procedure RenderLayerFromOriginal(layer: integer; ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false); overload;
265 function RenderOriginalsIfNecessary(ADraft: boolean = false): TRect;
266 procedure RemoveUnusedOriginals;
267
268 destructor Destroy; override;
269 constructor Create; overload; override;
270 constructor Create(AWidth, AHeight: integer); overload; virtual;
271 function GetLayerBitmapDirectly(layer: integer): TBGRABitmap; override;
272 function GetLayerBitmapCopy(layer: integer): TBGRABitmap; override;
273 function GetLayerIndexFromId(AIdentifier: integer): integer;
274 function Duplicate(ASharedLayerIds: boolean = false): TBGRALayeredBitmap;
275 function ProduceLayerUniqueId: integer;
276
277 procedure RotateCW;
278 procedure RotateCCW;
279 procedure HorizontalFlip; overload;
280 procedure HorizontalFlip(ALayerIndex: integer); overload;
281 procedure VerticalFlip; overload;
282 procedure VerticalFlip(ALayerIndex: integer); overload;
283 procedure Resample(AWidth, AHeight: integer; AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter = rfLinear);
284 procedure SetLayerBitmap(layer: integer; ABitmap: TBGRABitmap; AOwned: boolean);
285 procedure ApplyLayerOffset(ALayerIndex: integer; APadWithTranparentPixels: boolean);
286
287 function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload;
288 function DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload;
289 function GetEditorBounds(ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload;
290 function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect; overload;
291 function GetEditorBounds(ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload;
292 function GetEditorBounds(ADestRect: TRect; ALayerIndex: integer; AMatrix: TAffineMatrix; APointSize: single): TRect; overload;
293 procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
294 procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
295 procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
296 procedure MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
297 procedure MouseDown(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
298 procedure MouseUp(RightButton: boolean; Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
299 procedure KeyDown(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean);
300 procedure KeyUp(Shift: TShiftState; Key: TSpecialKey; out AHandled: boolean);
301 procedure KeyPress(UTF8Key: string; out AHandled: boolean);
302
303 property Width : integer read GetWidth;
304 property Height: integer read GetHeight;
305 property NbLayers: integer read GetNbLayers;
306 property BlendOperation[layer: integer]: TBlendOperation read GetBlendOperation write SetBlendOperation;
307 property LayerVisible[layer: integer]: boolean read GetLayerVisible write SetLayerVisible;
308 property LayerOpacity[layer: integer]: byte read GetLayerOpacity write SetLayerOpacity;
309 property LayerName[layer: integer]: string read GetLayerName write SetLayerName;
310 property LayerBitmap[layer: integer]: TBGRABitmap read GetLayerBitmapDirectly;
311 property LayerOffset[layer: integer]: TPoint read GetLayerOffset write SetLayerOffset;
312 property LayerUniqueId[layer: integer]: integer read GetLayerUniqueId write SetLayerUniqueId;
313 property LayerOriginal[layer: integer]: TBGRALayerCustomOriginal read GetLayerOriginal;
314 property LayerOriginalKnown[layer: integer]: boolean read GetLayerOriginalKnown;
315 property LayerOriginalGuid[layer: integer]: TGuid read GetLayerOriginalGuid write SetLayerOriginalGuid;
316 property LayerOriginalMatrix[layer: integer]: TAffineMatrix read GetLayerOriginalMatrix write SetLayerOriginalMatrix;
317 property LayerOriginalRenderStatus[layer: integer]: TOriginalRenderStatus read GetLayerOriginalRenderStatus write SetLayerOriginalRenderStatus;
318
319 function IndexOfOriginal(AGuid: TGuid): integer; overload; override;
320 function IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer; overload; override;
321 property OriginalCount: integer read GetOriginalCount;
322 property Original[AIndex: integer]: TBGRALayerCustomOriginal read GetOriginalByIndex;
323 property OriginalGuid[AIndex: integer]: TGUID read GetOriginalGuid;
324 property OriginalKnown[AIndex: integer]: boolean read GetOriginalByIndexKnown;
325 property OnOriginalChange: TEmbeddedOriginalChangeEvent read FOriginalChange write FOriginalChange;
326 property OnOriginalEditingChange: TEmbeddedOriginalEditingChangeEvent read FOriginalEditingChange write FOriginalEditingChange;
327 property OriginalEditor: TBGRAOriginalEditor read FOriginalEditor;
328 end;
329
330 TAffineMatrix = BGRABitmapTypes.TAffineMatrix;
331
332procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
333procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
334function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap;
335function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap;
336
337var
338 LayeredBitmapSaveToStreamProc : TBGRALayeredBitmapSaveToStreamProc;
339 LayeredBitmapLoadFromStreamProc : TBGRALayeredBitmapLoadFromStreamProc;
340 LayeredBitmapCheckStreamProc: TBGRALayeredBitmapCheckStreamProc;
341
342type
343 TOnLayeredBitmapLoadStartProc = procedure(AFilenameUTF8: string) of object;
344 TOnLayeredBitmapLoadProgressProc = procedure(APercentage: integer) of object;
345 TOnLayeredBitmapLoadedProc = procedure() of object;
346
347procedure OnLayeredBitmapLoadFromStreamStart;
348procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
349procedure OnLayeredBitmapLoadProgress(APercentage: integer);
350procedure OnLayeredBitmapLoaded();
351procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
352 ADone: TOnLayeredBitmapLoadedProc);
353procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
354 ADone: TOnLayeredBitmapLoadedProc);
355
356implementation
357
358uses BGRAUTF8, BGRABlend, BGRAMultiFileType, math;
359
360const
361 OriginalsDirectory = 'originals';
362
363var
364 OnLayeredBitmapLoadStartProc: TOnLayeredBitmapLoadStartProc;
365 OnLayeredBitmapLoadProgressProc: TOnLayeredBitmapLoadProgressProc;
366 OnLayeredBitmapLoadedProc: TOnLayeredBitmapLoadedProc;
367
368var
369 NextLayerUniqueId: cardinal;
370 LayeredBitmapReaders: array of record
371 extension: string;
372 theClass: TBGRACustomLayeredBitmapClass;
373 end;
374 LayeredBitmapWriters: array of record
375 extension: string;
376 theClass: TBGRALayeredBitmapClass;
377 end;
378
379{ TBGRALayerOriginalEntry }
380
381class operator TBGRALayerOriginalEntry.=(const AEntry1,
382 AEntry2: TBGRALayerOriginalEntry): boolean;
383begin
384 result := AEntry1.Guid = AEntry2.Guid;
385end;
386
387function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry;
388begin
389 result.Guid := AGuid;
390 result.Instance := nil;
391end;
392
393function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry;
394begin
395 result.Guid := AInstance.Guid;
396 result.Instance := AInstance;
397end;
398
399{ TBGRALayeredBitmap }
400
401function TBGRALayeredBitmap.GetLayerUniqueId(layer: integer): integer;
402begin
403 if (layer < 0) or (layer >= NbLayers) then
404 raise Exception.Create('Index out of bounds')
405 else
406 Result:= FLayers[layer].UniqueId;
407end;
408
409function TBGRALayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal;
410var
411 idxOrig: Integer;
412begin
413 if (layer < 0) or (layer >= NbLayers) then
414 raise Exception.Create('Index out of bounds')
415 else
416 begin
417 if FLayers[layer].OriginalGuid = GUID_NULL then exit(nil);
418 idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid);
419 if idxOrig = -1 then exit(nil);
420 result := Original[idxOrig];
421 end;
422end;
423
424function TBGRALayeredBitmap.GetLayerOriginalMatrix(layer: integer
425 ): TAffineMatrix;
426begin
427 if (layer < 0) or (layer >= NbLayers) then
428 raise Exception.Create('Index out of bounds')
429 else
430 result := FLayers[layer].OriginalMatrix;
431end;
432
433function TBGRALayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid;
434begin
435 if (layer < 0) or (layer >= NbLayers) then
436 raise Exception.Create('Index out of bounds')
437 else
438 result := FLayers[layer].OriginalGuid;
439end;
440
441function TBGRALayeredBitmap.GetLayerOriginalRenderStatus(layer: integer
442 ): TOriginalRenderStatus;
443begin
444 if (layer < 0) or (layer >= NbLayers) then
445 raise Exception.Create('Index out of bounds')
446 else
447 result := FLayers[layer].OriginalRenderStatus;
448end;
449
450procedure TBGRALayeredBitmap.SetLayerUniqueId(layer: integer; AValue: integer);
451var i: integer;
452begin
453 if (layer < 0) or (layer >= NbLayers) then
454 raise Exception.Create('Index out of bounds')
455 else
456 begin
457 for i := 0 to NbLayers-1 do
458 if (i <> layer) and (FLayers[i].UniqueId = AValue) then
459 raise Exception.Create('Another layer has the same identifier');
460 FLayers[layer].UniqueId := AValue;
461 end;
462end;
463
464procedure TBGRALayeredBitmap.SetLayerOriginalMatrix(layer: integer;
465 AValue: TAffineMatrix);
466begin
467 if (layer < 0) or (layer >= NbLayers) then
468 raise Exception.Create('Index out of bounds')
469 else
470 begin
471 if FLayers[layer].OriginalMatrix = AValue then exit;
472 FLayers[layer].OriginalMatrix := AValue;
473 if FLayers[layer].OriginalGuid <> GUID_NULL then
474 begin
475 FLayers[layer].OriginalRenderStatus := orsNone;
476 Unfreeze(layer);
477 end;
478 end;
479end;
480
481procedure TBGRALayeredBitmap.SetLayerOriginalGuid(layer: integer;
482 const AValue: TGuid);
483begin
484 if (layer < 0) or (layer >= NbLayers) then
485 raise Exception.Create('Index out of bounds')
486 else
487 begin
488 if FLayers[layer].OriginalGuid = AValue then exit;
489 FLayers[layer].OriginalGuid := AValue;
490
491 if (AValue <> GUID_NULL) and (IndexOfOriginal(AValue) <> -1) then
492 begin
493 FLayers[layer].OriginalRenderStatus := orsNone;
494 Unfreeze(layer);
495 end;
496 end;
497end;
498
499procedure TBGRALayeredBitmap.SetLayerOriginalRenderStatus(layer: integer;
500 AValue: TOriginalRenderStatus);
501begin
502 if (layer < 0) or (layer >= NbLayers) then
503 raise Exception.Create('Index out of bounds')
504 else
505 begin
506 if FLayers[layer].OriginalRenderStatus = AValue then exit;
507 FLayers[layer].OriginalRenderStatus := AValue;
508 Unfreeze(layer);
509 end;
510end;
511
512procedure TBGRALayeredBitmap.FindOriginal(AGuid: TGuid; out
513 ADir: TMemDirectory; out AClass: TBGRALayerOriginalAny);
514var
515 c: String;
516begin
517 ADir := nil;
518 AClass := nil;
519
520 if HasMemFiles then
521 begin
522 ADir := MemDirectory.FindPath(OriginalsDirectory+'/'+GUIDToString(AGuid));
523 if ADir <> nil then
524 begin
525 c := ADir.RawStringByFilename['class'];
526 AClass := FindLayerOriginalClass(c);
527 end;
528 end;
529end;
530
531procedure TBGRALayeredBitmap.StoreOriginal(AOriginal: TBGRALayerCustomOriginal);
532var
533 dir, subdir: TMemDirectory;
534 storage: TBGRAMemOriginalStorage;
535begin
536 if AOriginal.Guid = GUID_NULL then raise exception.Create('Original GUID undefined');
537 dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
538 subdir := dir.Directory[dir.AddDirectory(GUIDToString(AOriginal.Guid))];
539 storage := TBGRAMemOriginalStorage.Create(subdir);
540 try
541 AOriginal.SaveToStorage(storage);
542 storage.RawString['class'] := AOriginal.StorageClassName;
543 finally
544 storage.Free;
545 end;
546end;
547
548procedure TBGRALayeredBitmap.OriginalChange(ASender: TObject; ABounds: PRectF);
549var
550 i: Integer;
551 orig: TBGRALayerCustomOriginal;
552 transfBounds: TRectF;
553begin
554 orig := TBGRALayerCustomOriginal(ASender);
555 if not (Assigned(ABounds) and IsEmptyRectF(ABounds^)) then
556 begin
557 for i := 0 to NbLayers-1 do
558 if LayerOriginalGuid[i] = orig.Guid then
559 begin
560 if ABounds = nil then
561 LayerOriginalRenderStatus[i] := orsNone
562 else
563 begin
564 transfBounds := (LayerOriginalMatrix[i]*TAffineBox.AffineBox(ABounds^)).RectBoundsF;
565 case LayerOriginalRenderStatus[i] of
566 orsDraft: begin
567 LayerOriginalRenderStatus[i] := orsPartialDraft;
568 FLayers[i].OriginalInvalidatedBounds := transfBounds;
569 end;
570 orsProof: begin
571 LayerOriginalRenderStatus[i] := orsPartialProof;
572 FLayers[i].OriginalInvalidatedBounds := transfBounds;
573 end;
574 orsPartialDraft: FLayers[i].OriginalInvalidatedBounds :=
575 FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true);
576 orsPartialProof: FLayers[i].OriginalInvalidatedBounds :=
577 FLayers[i].OriginalInvalidatedBounds.Union(transfBounds, true);
578 end;
579 end;
580 end;
581 end;
582 if Assigned(FOriginalChange) then
583 FOriginalChange(self, orig);
584end;
585
586procedure TBGRALayeredBitmap.OriginalEditingChange(ASender: TObject);
587var
588 orig: TBGRALayerCustomOriginal;
589begin
590 orig := TBGRALayerCustomOriginal(ASender);
591 if Assigned(FOriginalEditingChange) then
592 FOriginalEditingChange(self, orig);
593end;
594
595function TBGRALayeredBitmap.GetOriginalCount: integer;
596begin
597 if Assigned(FOriginals) then
598 result := FOriginals.Count
599 else
600 result := 0;
601end;
602
603function TBGRALayeredBitmap.GetOriginalByIndex(AIndex: integer
604 ): TBGRALayerCustomOriginal;
605var
606 dir: TMemDirectory;
607 c: TBGRALayerOriginalAny;
608 guid: TGuid;
609 storage: TBGRAMemOriginalStorage;
610begin
611 if (AIndex < 0) or (AIndex >= OriginalCount) then
612 raise ERangeError.Create('Index out of bounds');
613
614 result := FOriginals[AIndex].Instance;
615 guid := FOriginals[AIndex].Guid;
616
617 // load original on the fly
618 if (result = nil) and (guid <> GUID_NULL) then
619 begin
620 FindOriginal(guid, dir, c);
621 if not Assigned(dir) then
622 raise exception.Create('Original directory not found');
623 if not Assigned(c) then
624 raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)');
625
626 result := c.Create;
627 result.Guid := guid;
628 storage := TBGRAMemOriginalStorage.Create(dir);
629 try
630 result.LoadFromStorage(storage);
631 finally
632 storage.Free;
633 end;
634 FOriginals[AIndex] := BGRALayerOriginalEntry(result);
635 result.OnChange:= @OriginalChange;
636 result.OnEditingChange:= @OriginalEditingChange;
637 end;
638end;
639
640function TBGRALayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean;
641var
642 idxOrig: Integer;
643begin
644 if (layer < 0) or (layer >= NbLayers) then
645 raise Exception.Create('Index out of bounds')
646 else
647 begin
648 if FLayers[layer].OriginalGuid = GUID_NULL then exit(true);
649 idxOrig := IndexOfOriginal(FLayers[layer].OriginalGuid);
650 if idxOrig = -1 then exit(false);
651 result := OriginalKnown[idxOrig];
652 end;
653end;
654
655function TBGRALayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean;
656var
657 dir: TMemDirectory;
658 c: TBGRALayerOriginalAny;
659 guid: TGuid;
660begin
661 if (AIndex < 0) or (AIndex >= OriginalCount) then
662 raise ERangeError.Create('Index out of bounds');
663
664 if Assigned(FOriginals[AIndex].Instance) then exit(true);
665 guid := FOriginals[AIndex].Guid;
666 if guid = GUID_NULL then exit(true);
667
668 FindOriginal(guid, dir, c);
669 result:= Assigned(dir) and Assigned(c);
670end;
671
672function TBGRALayeredBitmap.GetOriginalGuid(AIndex: integer): TGUID;
673begin
674 if (AIndex < 0) or (AIndex >= OriginalCount) then
675 raise ERangeError.Create('Index out of bounds');
676
677 result := FOriginals[AIndex].Guid;
678end;
679
680function TBGRALayeredBitmap.GetWidth: integer;
681begin
682 Result:= FWidth;
683end;
684
685function TBGRALayeredBitmap.GetHeight: integer;
686begin
687 Result:= FHeight;
688end;
689
690function TBGRALayeredBitmap.GetNbLayers: integer;
691begin
692 Result:= FNbLayers;
693end;
694
695function TBGRALayeredBitmap.GetBlendOperation(Layer: integer): TBlendOperation;
696begin
697 if (layer < 0) or (layer >= NbLayers) then
698 raise Exception.Create('Index out of bounds')
699 else
700 Result:= FLayers[layer].blendOp;
701end;
702
703function TBGRALayeredBitmap.GetLayerVisible(layer: integer): boolean;
704begin
705 if (layer < 0) or (layer >= NbLayers) then
706 raise Exception.Create('Index out of bounds')
707 else
708 Result:= FLayers[layer].Visible;
709end;
710
711function TBGRALayeredBitmap.GetLayerOpacity(layer: integer): byte;
712begin
713 if (layer < 0) or (layer >= NbLayers) then
714 raise Exception.Create('Index out of bounds')
715 else
716 Result:= FLayers[layer].Opacity;
717end;
718
719function TBGRALayeredBitmap.GetLayerOffset(layer: integer): TPoint;
720begin
721 if (layer < 0) or (layer >= NbLayers) then
722 raise Exception.Create('Index out of bounds')
723 else
724 with FLayers[layer] do
725 Result:= Point(x,y);
726end;
727
728function TBGRALayeredBitmap.GetLayerName(layer: integer): string;
729begin
730 if (layer < 0) or (layer >= NbLayers) then
731 raise Exception.Create('Index out of bounds')
732 else
733 begin
734 if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then
735 Result := FLayers[layer].Source.Caption
736 else
737 Result:= FLayers[layer].Name;
738 if Result = '' then
739 result := inherited GetLayerName(layer);
740 end;
741end;
742
743function TBGRALayeredBitmap.GetLayerFrozen(layer: integer): boolean;
744begin
745 if (layer < 0) or (layer >= NbLayers) then
746 raise Exception.Create('Index out of bounds')
747 else
748 Result:= FLayers[layer].Frozen;
749end;
750
751procedure TBGRALayeredBitmap.SetBlendOperation(Layer: integer;
752 op: TBlendOperation);
753begin
754 if (layer < 0) or (layer >= NbLayers) then
755 raise Exception.Create('Index out of bounds')
756 else
757 begin
758 if FLayers[layer].blendOp <> op then
759 begin
760 FLayers[layer].blendOp := op;
761 Unfreeze(layer);
762 end;
763 end;
764end;
765
766procedure TBGRALayeredBitmap.SetLayerVisible(layer: integer; AValue: boolean);
767begin
768 if (layer < 0) or (layer >= NbLayers) then
769 raise Exception.Create('Index out of bounds')
770 else
771 begin
772 if FLayers[layer].Visible <> AValue then
773 begin
774 FLayers[layer].Visible := AValue;
775 Unfreeze(layer);
776 end;
777 end;
778end;
779
780procedure TBGRALayeredBitmap.SetLayerOpacity(layer: integer; AValue: byte);
781begin
782 if (layer < 0) or (layer >= NbLayers) then
783 raise Exception.Create('Index out of bounds')
784 else
785 begin
786 if FLayers[layer].Opacity <> AValue then
787 begin
788 FLayers[layer].Opacity := AValue;
789 Unfreeze(layer);
790 end;
791 end;
792end;
793
794procedure TBGRALayeredBitmap.SetLayerOffset(layer: integer; AValue: TPoint);
795begin
796 if (layer < 0) or (layer >= NbLayers) then
797 raise Exception.Create('Index out of bounds')
798 else
799 begin
800 if (FLayers[layer].x <> AValue.x) or
801 (FLayers[layer].y <> AValue.y) then
802 begin
803 if FLayers[layer].OriginalGuid <> GUID_NULL then
804 raise exception.Create('The offset of the layer is computed from an original. You can change it by changing the layer original matrix.');
805
806 FLayers[layer].x := AValue.x;
807 FLayers[layer].y := AValue.y;
808 Unfreeze(layer);
809 end;
810 end;
811end;
812
813procedure TBGRALayeredBitmap.SetLayerName(layer: integer; AValue: string);
814begin
815 if (layer < 0) or (layer >= NbLayers) then
816 raise Exception.Create('Index out of bounds')
817 else
818 begin
819 if not FLayers[layer].Owner and (FLayers[layer].Source <> nil) then
820 FLayers[layer].Source.Caption := AValue
821 else
822 FLayers[layer].Name := AValue;
823 end;
824end;
825
826procedure TBGRALayeredBitmap.SetLayerFrozen(layer: integer; AValue: boolean);
827begin
828 if (layer < 0) or (layer >= NbLayers) then
829 raise Exception.Create('Index out of bounds')
830 else
831 FLayers[layer].Frozen := AValue;
832end;
833
834function TBGRALayeredBitmap.GetLayerBitmapDirectly(layer: integer): TBGRABitmap;
835begin
836 if (layer < 0) or (layer >= NbLayers) then
837 result := nil
838 else
839 begin
840 if FLayers[layer].OriginalRenderStatus = orsNone then
841 RenderLayerFromOriginal(layer, true)
842 else if FLayers[layer].OriginalRenderStatus in [orsPartialDraft,orsPartialProof] then
843 RenderLayerFromOriginal(layer, true, FLayers[layer].OriginalInvalidatedBounds);
844 Result:= FLayers[layer].Source;
845 end;
846end;
847
848procedure TBGRALayeredBitmap.LoadFromFile(const filenameUTF8: string);
849var bmp: TBGRABitmap;
850 ext: string;
851 temp: TBGRACustomLayeredBitmap;
852 i: integer;
853 stream: TFileStreamUTF8;
854begin
855 ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
856 for i := 0 to high(LayeredBitmapReaders) do
857 if '.'+LayeredBitmapReaders[i].extension = ext then
858 begin
859 temp := LayeredBitmapReaders[i].theClass.Create;
860 try
861 temp.LoadFromFile(filenameUTF8);
862 Assign(temp);
863 finally
864 temp.Free;
865 end;
866 exit;
867 end;
868
869 //when using "data" extension, simply deserialize
870 if (ext='.dat') or (ext='.data') then
871 begin
872 if Assigned(LayeredBitmapLoadFromStreamProc) then
873 begin
874 stream := TFileStreamUTF8.Create(filenameUTF8, fmOpenRead, fmShareDenyWrite);
875 try
876 LayeredBitmapLoadFromStreamProc(stream, self);
877 finally
878 stream.Free;
879 end;
880 end else
881 raise exception.Create('Enable layer deserialization by calling BGRAStreamLayers.RegisterStreamLayers');
882 end else
883 begin
884 bmp := TBGRABitmap.Create(filenameUTF8, True);
885 Clear;
886 SetSize(bmp.Width,bmp.Height);
887 AddOwnedLayer(bmp);
888 end;
889end;
890
891procedure TBGRALayeredBitmap.LoadFromStream(stream: TStream);
892var bmp: TBGRABitmap;
893begin
894 if Assigned(LayeredBitmapLoadFromStreamProc) then
895 begin
896 if not Assigned(LayeredBitmapCheckStreamProc) or
897 LayeredBitmapCheckStreamProc(stream) then
898 begin
899 LayeredBitmapLoadFromStreamProc(Stream, self);
900 exit;
901 end;
902 end;
903
904 bmp := TBGRABitmap.Create(stream);
905 Clear;
906 SetSize(bmp.Width,bmp.Height);
907 AddOwnedLayer(bmp);
908end;
909
910procedure TBGRALayeredBitmap.LoadFromResource(AFilename: string);
911var
912 stream: TStream;
913begin
914 stream := BGRAResource.GetResourceStream(AFilename);
915 try
916 LoadFromStream(stream);
917 finally
918 stream.Free;
919 end;
920end;
921
922procedure TBGRALayeredBitmap.SetSize(AWidth, AHeight: integer);
923begin
924 Unfreeze;
925 FWidth := AWidth;
926 FHeight := AHeight;
927end;
928
929procedure TBGRALayeredBitmap.Clear;
930var i: integer;
931begin
932 Unfreeze;
933 for i := NbLayers-1 downto 0 do
934 RemoveLayer(i);
935 MemDirectory := nil;
936 ClearOriginals;
937end;
938
939procedure TBGRALayeredBitmap.ClearOriginals;
940var
941 i: Integer;
942begin
943 if Assigned(FOriginals) then
944 begin
945 for i := 0 to OriginalCount-1 do
946 FOriginals[i].Instance.Free;
947 FreeAndNil(FOriginals);
948 end;
949end;
950
951procedure TBGRALayeredBitmap.RemoveLayer(index: integer);
952var i: integer;
953begin
954 if (index < 0) or (index >= NbLayers) then exit;
955 Unfreeze;
956 if FLayers[index].Owner then FLayers[index].Source.Free;
957 for i := index to FNbLayers-2 do
958 FLayers[i] := FLayers[i+1];
959 Dec(FNbLayers);
960end;
961
962procedure TBGRALayeredBitmap.InsertLayer(index: integer; fromIndex: integer);
963var info: TBGRALayerInfo;
964 i: integer;
965begin
966 if (index < 0) or (index > NbLayers) or (index = fromIndex) then exit;
967 if (fromIndex < 0) or (fromIndex >= NbLayers) then exit;
968 Unfreeze;
969 info := FLayers[fromIndex];
970 for i := fromIndex to FNbLayers-2 do
971 FLayers[i] := FLayers[i+1];
972 for i := FNbLayers-1 downto index+1 do
973 FLayers[i] := FLayers[i-1];
974 FLayers[index] := info;
975end;
976
977procedure TBGRALayeredBitmap.Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean);
978var i,idx,idxOrig,idxNewOrig: integer;
979 usedOriginals: array of record
980 used: boolean;
981 sourceGuid,newGuid: TGuid;
982 end;
983 orig: TBGRALayerCustomOriginal;
984 stream: TMemoryStream;
985
986begin
987 if ASource = nil then
988 raise exception.Create('Unexpected nil reference');
989 Clear;
990 SetSize(ASource.Width,ASource.Height);
991 LinearBlend:= ASource.LinearBlend;
992 setlength(usedOriginals, ASource.GetOriginalCount);
993 for idxOrig := 0 to high(usedOriginals) do
994 with usedOriginals[idxOrig] do
995 begin
996 used:= false;
997 newGuid := GUID_NULL;
998 end;
999 for i := 0 to ASource.NbLayers-1 do
1000 if (ASource.LayerOriginalGuid[i]<>GUID_NULL) and
1001 (ASource.LayerOriginalKnown[i] or (ASource is TBGRALayeredBitmap)) then
1002 begin
1003 idxOrig := ASource.IndexOfOriginal(ASource.LayerOriginalGuid[i]);
1004 if not usedOriginals[idxOrig].used then
1005 begin
1006 if ASource.LayerOriginalKnown[i] then
1007 begin
1008 orig := ASource.GetOriginalByIndex(idxOrig);
1009 idxNewOrig := AddOriginal(orig, false);
1010 usedOriginals[idxOrig].sourceGuid := orig.Guid;
1011 end else
1012 begin
1013 stream := TMemoryStream.Create;
1014 (ASource as TBGRALayeredBitmap).SaveOriginalToStream(idxOrig, stream);
1015 stream.Position:= 0;
1016 idxNewOrig := AddOriginalFromStream(stream,true);
1017 stream.Free;
1018 usedOriginals[idxOrig].sourceGuid := (ASource as TBGRALayeredBitmap).OriginalGuid[idxOrig];
1019 end;
1020 usedOriginals[idxOrig].newGuid := OriginalGuid[idxNewOrig];
1021 usedOriginals[idxOrig].used := true;
1022 end;
1023 end;
1024 for i := 0 to ASource.NbLayers-1 do
1025 begin
1026 idx := AddOwnedLayer(ASource.GetLayerBitmapCopy(i),ASource.LayerOffset[i],ASource.BlendOperation[i],ASource.LayerOpacity[i]);
1027 LayerName[idx] := ASource.LayerName[i];
1028 LayerVisible[idx] := ASource.LayerVisible[i];
1029 if ASharedLayerIds and (ASource is TBGRALayeredBitmap) then
1030 LayerUniqueId[idx] := TBGRALayeredBitmap(ASource).LayerUniqueId[i];
1031 for idxOrig := 0 to high(usedOriginals) do
1032 if usedOriginals[i].sourceGuid = ASource.LayerOriginalGuid[i] then
1033 begin
1034 LayerOriginalGuid[idx] := usedOriginals[i].newGuid;
1035 LayerOriginalMatrix[idx] := ASource.LayerOriginalMatrix[i];
1036 LayerOriginalRenderStatus[idx] := ASource.LayerOriginalRenderStatus[i];
1037 end;
1038 end;
1039end;
1040
1041function TBGRALayeredBitmap.MoveLayerUp(index: integer): integer;
1042begin
1043 if (index >= 0) and (index <= NbLayers-2) then
1044 begin
1045 InsertLayer(index+1,index);
1046 result := index+1;
1047 end else
1048 result := -1;
1049end;
1050
1051function TBGRALayeredBitmap.MoveLayerDown(index: integer): integer;
1052begin
1053 if (index > 0) and (index <= NbLayers-1) then
1054 begin
1055 InsertLayer(index-1,index);
1056 result := index-1;
1057 end else
1058 result := -1;
1059end;
1060
1061function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Opacity: byte
1062 ): integer;
1063begin
1064 result := AddLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity, False);
1065end;
1066
1067function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint;
1068 BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer;
1069begin
1070 result := AddLayer(Source.Caption,Source,Position,BlendOp,Opacity,Shared);
1071end;
1072
1073function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint;
1074 Opacity: byte): integer;
1075begin
1076 result := AddLayer(Source,Position,DefaultBlendingOperation,Opacity);
1077end;
1078
1079function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap;
1080 BlendOp: TBlendOperation; Opacity: byte): integer;
1081begin
1082 result := AddLayer(Source,Point(0,0),BlendOp,Opacity);
1083end;
1084
1085function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1086 Opacity: byte): integer;
1087begin
1088 result := AddLayer(AName,Source,Point(0,0),Opacity);
1089end;
1090
1091function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1092 Position: TPoint; BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer;
1093begin
1094 if length(FLayers) = FNbLayers then
1095 setlength(FLayers, length(FLayers)*2+1);
1096 FLayers[FNbLayers].Name := AName;
1097 FLayers[FNbLayers].X := Position.X;
1098 FLayers[FNbLayers].Y := Position.Y;
1099 FLayers[FNbLayers].blendOp := BlendOp;
1100 FLayers[FNbLayers].Opacity := Opacity;
1101 FLayers[FNbLayers].Visible := true;
1102 FLayers[FNbLayers].Frozen := false;
1103 FLayers[FNbLayers].UniqueId := ProduceLayerUniqueId;
1104 FLayers[FNbLayers].OriginalMatrix := AffineMatrixIdentity;
1105 FLayers[FNbLayers].OriginalRenderStatus := orsNone;
1106 FLayers[FNbLayers].OriginalGuid := GUID_NULL;
1107 if Shared then
1108 begin
1109 FLayers[FNbLayers].Source := Source;
1110 FLayers[FNbLayers].Owner := false;
1111 end else
1112 begin
1113 FLayers[FNbLayers].Source := Source.Duplicate as TBGRABitmap;
1114 FLayers[FNbLayers].Owner := true;
1115 end;
1116 result := FNbLayers;
1117 inc(FNbLayers);
1118 if (FNbLayers = 1) and (FWidth = 0) and (FHeight = 0) and (Source <> nil) then
1119 SetSize(Source.Width,Source.Height);
1120end;
1121
1122function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1123 Position: TPoint; Opacity: byte): integer;
1124begin
1125 result := AddLayer(AName, Source, Position, DefaultBlendingOperation, Opacity);
1126end;
1127
1128function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1129 BlendOp: TBlendOperation; Opacity: byte): integer;
1130begin
1131 result := AddLayer(AName, Source, Point(0,0), blendOp, Opacity);
1132end;
1133
1134function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; Opacity: byte
1135 ): integer;
1136begin
1137 result := AddSharedLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity);
1138end;
1139
1140function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1141 Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1142begin
1143 result := AddLayer(Source, Position, BlendOp, Opacity, True);
1144end;
1145
1146function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1147 Position: TPoint; Opacity: byte): integer;
1148begin
1149 result := AddSharedLayer(Source, Position, DefaultBlendingOperation, Opacity);
1150end;
1151
1152function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1153 BlendOp: TBlendOperation; Opacity: byte): integer;
1154begin
1155 result := AddSharedLayer(Source, Point(0,0), blendOp, Opacity);
1156end;
1157
1158function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; Opacity: byte
1159 ): integer;
1160begin
1161 result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Opacity);
1162 FLayers[result].Name := ExtractFileName(AFilename);
1163end;
1164
1165function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1166 Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1167begin
1168 result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,BlendOp,Opacity);
1169 FLayers[result].Name := ExtractFileName(AFilename);
1170end;
1171
1172function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1173 Position: TPoint; Opacity: byte): integer;
1174begin
1175 result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,Opacity);
1176 FLayers[result].Name := ExtractFileName(AFilename);
1177end;
1178
1179function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1180 BlendOp: TBlendOperation; Opacity: byte): integer;
1181begin
1182 result := AddOwnedLayer(TBGRABitmap.Create(AFilename),BlendOp,Opacity);
1183 FLayers[result].Name := ExtractFileName(AFilename);
1184end;
1185
1186function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte
1187 ): integer;
1188begin
1189 result := AddSharedLayer(ABitmap,Opacity);
1190 FLayers[result].Owner := True;
1191end;
1192
1193function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1194 Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1195begin
1196 result := AddSharedLayer(ABitmap,Position,BlendOp,Opacity);
1197 FLayers[result].Owner := True;
1198end;
1199
1200function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1201 Position: TPoint; Opacity: byte): integer;
1202begin
1203 result := AddSharedLayer(ABitmap,Position,Opacity);
1204 FLayers[result].Owner := True;
1205end;
1206
1207function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1208 BlendOp: TBlendOperation; Opacity: byte): integer;
1209begin
1210 result := AddSharedLayer(ABitmap,BlendOp,Opacity);
1211 FLayers[result].Owner := True;
1212end;
1213
1214function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1215 Opacity: byte): integer;
1216begin
1217 result := AddLayerFromOriginal(AGuid, DefaultBlendingOperation, Opacity);
1218end;
1219
1220function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1221 BlendOp: TBlendOperation; Opacity: byte): integer;
1222begin
1223 result := AddLayerFromOriginal(AGuid, AffineMatrixIdentity, BlendOp, Opacity);
1224end;
1225
1226function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1227 Matrix: TAffineMatrix; Opacity: byte): integer;
1228begin
1229 result := AddLayerFromOriginal(AGuid, Matrix, DefaultBlendingOperation, Opacity);
1230end;
1231
1232function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1233 Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte): integer;
1234begin
1235 result := AddOwnedLayer(TBGRABitmap.Create, BlendOp, Opacity);
1236 LayerOriginalGuid[result] := AGuid;
1237 LayerOriginalMatrix[result] := Matrix;
1238 if not Assigned(LayerOriginal[result]) then
1239 raise exception.Create('Original data or class not found');
1240end;
1241
1242function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1243 AOriginal: TBGRALayerCustomOriginal; Opacity: byte): integer;
1244begin
1245 if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1246 result := AddLayerFromOriginal(AOriginal.Guid, Opacity);
1247end;
1248
1249function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1250 AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte): integer;
1251begin
1252 if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1253 result := AddLayerFromOriginal(AOriginal.Guid, BlendOp, Opacity);
1254end;
1255
1256function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1257 AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte): integer;
1258begin
1259 if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1260 result := AddLayerFromOriginal(AOriginal.Guid, Matrix, Opacity);
1261end;
1262
1263function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1264 AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix;
1265 BlendOp: TBlendOperation; Opacity: byte): integer;
1266begin
1267 if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1268 result := AddLayerFromOriginal(AOriginal.Guid, Matrix, BlendOp, Opacity);
1269end;
1270
1271function TBGRALayeredBitmap.AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean): integer;
1272var
1273 newGuid: TGuid;
1274begin
1275 if AOriginal = nil then
1276 raise exception.Create('Unexpected nil reference');;
1277 if AOriginal.Guid = GUID_NULL then
1278 begin
1279 if CreateGUID(newGuid)<> 0 then
1280 begin
1281 if AOwned then AOriginal.Free;
1282 raise exception.Create('Error while creating GUID');
1283 end;
1284 AOriginal.Guid := newGuid;
1285 end else
1286 begin
1287 if IndexOfOriginal(AOriginal) <> -1 then
1288 begin
1289 if AOwned then AOriginal.Free;
1290 raise exception.Create('Original already added');
1291 end;
1292 if IndexOfOriginal(AOriginal.Guid) <> -1 then
1293 begin
1294 if AOwned then AOriginal.Free;
1295 raise exception.Create('GUID is already in use');
1296 end;
1297 end;
1298 StoreOriginal(AOriginal);
1299 if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create;
1300 if AOwned then
1301 begin
1302 result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal));
1303 AOriginal.OnChange:= @OriginalChange;
1304 AOriginal.OnEditingChange:= @OriginalEditingChange;
1305 end
1306 else
1307 result := FOriginals.Add(BGRALayerOriginalEntry(AOriginal.Guid));
1308end;
1309
1310function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream;
1311 ALateLoad: boolean): integer;
1312var
1313 storage: TBGRAMemOriginalStorage;
1314begin
1315 storage:= TBGRAMemOriginalStorage.Create;
1316 storage.LoadFromStream(AStream);
1317 try
1318 result := AddOriginalFromStorage(storage, ALateLoad);
1319 finally
1320 storage.Free;
1321 end;
1322end;
1323
1324function TBGRALayeredBitmap.AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean): integer;
1325var
1326 origClassName: String;
1327 origClass: TBGRALayerOriginalAny;
1328 orig: TBGRALayerCustomOriginal;
1329 newGuid: TGuid;
1330 dir, subdir: TMemDirectory;
1331begin
1332 result := -1;
1333 origClassName := AStorage.RawString['class'];
1334 if origClassName = '' then raise Exception.Create('Original class name not defined');
1335 if ALateLoad then
1336 begin
1337 if CreateGUID(newGuid)<> 0 then
1338 raise exception.Create('Error while creating GUID');
1339 if IndexOfOriginal(newGuid)<>-1 then
1340 raise exception.Create('Duplicate GUID');
1341
1342 dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
1343 subdir := dir.Directory[dir.AddDirectory(GUIDToString(newGuid))];
1344 AStorage.CopyTo(subdir);
1345
1346 if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create;
1347 result := FOriginals.Add(BGRALayerOriginalEntry(newGuid));
1348 end else
1349 begin
1350 origClass := FindLayerOriginalClass(origClassName);
1351 if origClass = nil then raise exception.Create('Original class not found (it can be registered with the RegisterLayerOriginal function)');
1352 orig := origClass.Create;
1353 try
1354 orig.LoadFromStorage(AStorage);
1355 result := AddOriginal(orig, true);
1356 except on ex:exception do
1357 begin
1358 orig.Free;
1359 raise exception.Create('Error loading original. '+ ex.Message);
1360 end;
1361 end;
1362 end;
1363end;
1364
1365procedure TBGRALayeredBitmap.SaveOriginalToStream(AIndex: integer;
1366 AStream: TStream);
1367var
1368 dir: TMemDirectory;
1369 c: TBGRALayerOriginalAny;
1370begin
1371 if (AIndex < 0) or (AIndex >= OriginalCount) then
1372 raise ERangeError.Create('Index out of bounds');
1373
1374 if Assigned(FOriginals[AIndex].Instance) then
1375 FOriginals[AIndex].Instance.SaveToStream(AStream)
1376 else
1377 begin
1378 FindOriginal(FOriginals[AIndex].Guid, dir, c);
1379 if dir = nil then
1380 raise exception.Create('Originals directory not found');
1381 dir.SaveToStream(AStream);
1382 end;
1383end;
1384
1385procedure TBGRALayeredBitmap.SaveOriginalToStream(AGuid: TGUID; AStream: TStream);
1386var
1387 idxOrig: Integer;
1388begin
1389 idxOrig := IndexOfOriginal(AGuid);
1390 if idxOrig = -1 then raise exception.Create('Original not found');
1391 SaveOriginalToStream(idxOrig, AStream);
1392end;
1393
1394function TBGRALayeredBitmap.RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean;
1395var
1396 idx: Integer;
1397begin
1398 idx := IndexOfOriginal(AOriginal);
1399 if idx = -1 then exit(false);
1400 DeleteOriginal(idx);
1401 result := true;
1402end;
1403
1404procedure TBGRALayeredBitmap.DeleteOriginal(AIndex: integer);
1405var
1406 dir: TMemDirectory;
1407 i: Integer;
1408 guid: TGuid;
1409begin
1410 if (AIndex < 0) or (AIndex >= OriginalCount) then
1411 raise ERangeError.Create('Index out of bounds');
1412
1413 guid := FOriginals[AIndex].Guid;
1414 for i := 0 to NbLayers-1 do
1415 if LayerOriginalGuid[i] = guid then
1416 begin
1417 LayerOriginalGuid[i] := GUID_NULL;
1418 LayerOriginalMatrix[i] := AffineMatrixIdentity;
1419 end;
1420
1421 dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
1422 dir.Delete(GUIDToString(guid),'');
1423
1424 FOriginals[AIndex].Instance.Free;
1425 FOriginals.Delete(AIndex); //AOriginals freed
1426end;
1427
1428procedure TBGRALayeredBitmap.NotifyLoaded;
1429var
1430 foundGuid: array of TGuid;
1431 nbFoundGuid: integer;
1432
1433 procedure AddGuid(const AGuid: TGuid);
1434 begin
1435 foundGuid[nbFoundGuid] := AGuid;
1436 inc(nbFoundGuid);
1437 end;
1438
1439 function IndexOfGuid(AGuid: TGuid): integer;
1440 var
1441 i: Integer;
1442 begin
1443 for i := 0 to nbFoundGuid-1 do
1444 if foundGuid[i] = AGuid then exit(i);
1445 result := -1;
1446 end;
1447
1448var
1449 i: Integer;
1450 dir: TMemDirectory;
1451 newGuid: TGUID;
1452
1453begin
1454 inherited NotifyLoaded;
1455
1456 //if there are no files in memory, we are sure that there are no originals
1457 if not HasMemFiles then
1458 begin
1459 ClearOriginals;
1460 exit;
1461 end;
1462
1463 //determine list of GUID of originals
1464 dir := MemDirectory.Directory[MemDirectory.AddDirectory(OriginalsDirectory)];
1465 setlength(foundGuid, dir.Count);
1466 nbFoundGuid:= 0;
1467 for i := 0 to dir.Count-1 do
1468 if dir.IsDirectory[i] and (dir.Entry[i].Extension = '') then
1469 begin
1470 if TryStringToGUID(dir.Entry[i].Name, newGuid) then
1471 AddGuid(newGuid);
1472 end;
1473
1474 //remove originals that do not exist anymore
1475 for i := OriginalCount-1 downto 0 do
1476 if IndexOfGuid(FOriginals[i].Guid) = -1 then
1477 DeleteOriginal(i);
1478
1479 //add originals from memory directory
1480 for i := 0 to nbFoundGuid-1 do
1481 begin
1482 if IndexOfOriginal(foundGuid[i]) = -1 then
1483 begin
1484 if FOriginals = nil then FOriginals := TBGRALayerOriginalList.Create;
1485 FOriginals.Add(BGRALayerOriginalEntry(foundGuid[i]));
1486 end;
1487 end;
1488end;
1489
1490procedure TBGRALayeredBitmap.NotifySaving;
1491var
1492 i: Integer;
1493begin
1494 inherited NotifySaving;
1495
1496 RenderOriginalsIfNecessary;
1497
1498 for i := 0 to OriginalCount-1 do
1499 if Assigned(FOriginals[i].Instance) then
1500 StoreOriginal(FOriginals[i].Instance);
1501end;
1502
1503procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1504 ADraft: boolean; AFullSizeLayer: boolean = false);
1505begin
1506 RenderLayerFromOriginal(layer, ADraft, rectF(0,0,Width,Height), AFullSizeLayer);
1507end;
1508
1509procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1510 ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false);
1511var
1512 orig: TBGRALayerCustomOriginal;
1513 rAll, rNewBounds, rInterRender: TRect;
1514 newSource: TBGRABitmap;
1515
1516 procedure FreeSource;
1517 begin
1518 if FLayers[layer].Owner then
1519 FreeAndNil(FLayers[layer].Source)
1520 else
1521 FLayers[layer].Source := nil;
1522 end;
1523
1524begin
1525 if (layer < 0) or (layer >= NbLayers) then
1526 raise Exception.Create('Index out of bounds');
1527
1528 orig := LayerOriginal[layer];
1529 if Assigned(orig) then
1530 begin
1531 rAll := rect(0,0,Width,Height);
1532 if AFullSizeLayer then
1533 rNewBounds := rAll
1534 else
1535 begin
1536 rNewBounds := orig.GetRenderBounds(rAll,FLayers[layer].OriginalMatrix);
1537 IntersectRect({%H-}rNewBounds, rNewBounds, rAll);
1538 end;
1539 IntersectRect({%H-}rInterRender, ARenderBounds, rNewBounds);
1540 if (FLayers[layer].x = rNewBounds.Left) and
1541 (FLayers[layer].y = rNewBounds.Top) and
1542 (FLayers[layer].Source.Width = rNewBounds.Width) and
1543 (FLayers[layer].Source.Height = rNewBounds.Height) then
1544 begin
1545 OffsetRect(rInterRender, -rNewBounds.Left, -rNewBounds.Top);
1546 FLayers[layer].Source.FillRect(rInterRender, BGRAPixelTransparent, dmSet);
1547 FLayers[layer].Source.ClipRect := rInterRender;
1548 orig.Render(FLayers[layer].Source, AffineMatrixTranslation(-rNewBounds.Left,-rNewBounds.Top)*FLayers[layer].OriginalMatrix, ADraft);
1549 FLayers[layer].Source.NoClip;
1550 end else
1551 begin
1552 if rInterRender = rNewBounds then
1553 begin
1554 FreeSource;
1555 newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height);
1556 orig.Render(newSource, AffineMatrixTranslation(-rNewBounds.Left,-rNewBounds.Top)*FLayers[layer].OriginalMatrix, ADraft);
1557 end else
1558 begin
1559 newSource := TBGRABitmap.Create(rNewBounds.Width,rNewBounds.Height);
1560 newSource.PutImage(FLayers[layer].x - rNewBounds.Left, FLayers[layer].y - rNewBounds.Top, FLayers[layer].Source, dmSet);
1561 FreeSource;
1562 OffsetRect(rInterRender, -rNewBounds.Left, -rNewBounds.Top);
1563 if not IsRectEmpty(rInterRender) then
1564 begin
1565 newSource.FillRect(rInterRender, BGRAPixelTransparent, dmSet);
1566 newSource.ClipRect := rInterRender;
1567 orig.Render(newSource, AffineMatrixTranslation(-rNewBounds.Left,-rNewBounds.Top)*FLayers[layer].OriginalMatrix, ADraft);
1568 newSource.NoClip;
1569 end;
1570 end;
1571 FLayers[layer].Source := newSource;
1572 FLayers[layer].x := rNewBounds.Left;
1573 FLayers[layer].y := rNewBounds.Top;
1574 end;
1575 end;
1576 if ADraft then
1577 FLayers[layer].OriginalRenderStatus := orsDraft
1578 else
1579 FLayers[layer].OriginalRenderStatus := orsProof;
1580 FLayers[layer].OriginalInvalidatedBounds := EmptyRectF;
1581end;
1582
1583procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1584 ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false);
1585var
1586 r: TRect;
1587begin
1588 with ARenderBoundsF do
1589 r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
1590 RenderLayerFromOriginal(layer, ADraft, r, AFullSizeLayer);
1591end;
1592
1593function TBGRALayeredBitmap.RenderOriginalsIfNecessary(ADraft: boolean): TRect;
1594 procedure UnionLayerArea(ALayer: integer);
1595 var
1596 r: TRect;
1597 begin
1598 if (FLayers[ALayer].Source = nil) or
1599 (FLayers[ALayer].Source.Width = 0) or
1600 (FLayers[ALayer].Source.Height = 0) then exit;
1601
1602 r := RectWithSize(LayerOffset[ALayer].X, LayerOffset[ALayer].Y,
1603 FLayers[ALayer].Source.Width, FLayers[ALayer].Source.Height);
1604 if IsRectEmpty(result) then result := r else
1605 UnionRect(result,result,r);
1606 end;
1607
1608var
1609 i: Integer;
1610 r: TRect;
1611
1612begin
1613 result:= EmptyRect;
1614 for i := 0 to NbLayers-1 do
1615 case LayerOriginalRenderStatus[i] of
1616 orsNone:
1617 begin
1618 UnionLayerArea(i);
1619 RenderLayerFromOriginal(i, ADraft);
1620 UnionLayerArea(i);
1621 end;
1622 orsDraft: if not ADraft then
1623 begin
1624 UnionLayerArea(i);
1625 RenderLayerFromOriginal(i, ADraft);
1626 UnionLayerArea(i);
1627 end;
1628 orsPartialDraft,orsPartialProof:
1629 if not ADraft and (LayerOriginalRenderStatus[i] = orsPartialDraft) then
1630 begin
1631 UnionLayerArea(i);
1632 RenderLayerFromOriginal(i, ADraft, rect(0,0,Width,Height), true);
1633 UnionLayerArea(i);
1634 end
1635 else
1636 begin
1637 with FLayers[i].OriginalInvalidatedBounds do
1638 r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
1639 RenderLayerFromOriginal(i, ADraft, r, true);
1640 if not IsRectEmpty(r) then
1641 begin
1642 if IsRectEmpty(result) then
1643 result := r
1644 else
1645 UnionRect(result, result, r);
1646 end;
1647 end;
1648 end;
1649end;
1650
1651procedure TBGRALayeredBitmap.RemoveUnusedOriginals;
1652var useCount: array of integer;
1653 i, idxOrig: Integer;
1654begin
1655 if OriginalCount = 0 then exit;
1656 setlength(useCount, OriginalCount);
1657 for i := 0 to NbLayers-1 do
1658 begin
1659 idxOrig := IndexOfOriginal(LayerOriginalGuid[i]);
1660 if idxOrig <> -1 then useCount[idxOrig] += 1;
1661 end;
1662 for i := high(useCount) downto 0 do
1663 if useCount[i] = 0 then DeleteOriginal(i);
1664end;
1665
1666destructor TBGRALayeredBitmap.Destroy;
1667begin
1668 FOriginalEditor.Free;
1669 inherited Destroy;
1670end;
1671
1672constructor TBGRALayeredBitmap.Create;
1673begin
1674 inherited Create;
1675 FWidth := 0;
1676 FHeight := 0;
1677 FNbLayers:= 0;
1678 FOriginals := nil;
1679end;
1680
1681constructor TBGRALayeredBitmap.Create(AWidth, AHeight: integer);
1682begin
1683 inherited Create;
1684 if AWidth < 0 then
1685 FWidth := 0
1686 else
1687 FWidth := AWidth;
1688 if AHeight < 0 then
1689 FHeight := 0
1690 else
1691 FHeight := AHeight;
1692 FNbLayers:= 0;
1693end;
1694
1695function TBGRALayeredBitmap.GetLayerBitmapCopy(layer: integer): TBGRABitmap;
1696begin
1697 result := GetLayerBitmapDirectly(layer).Duplicate as TBGRABitmap;
1698end;
1699
1700function TBGRALayeredBitmap.GetLayerIndexFromId(AIdentifier: integer): integer;
1701var i: integer;
1702begin
1703 for i := 0 to NbLayers-1 do
1704 if FLayers[i].UniqueId = AIdentifier then
1705 begin
1706 result := i;
1707 exit;
1708 end;
1709 result := -1; //not found
1710end;
1711
1712function TBGRALayeredBitmap.Duplicate(ASharedLayerIds: boolean): TBGRALayeredBitmap;
1713begin
1714 result := TBGRALayeredBitmap.Create;
1715 result.Assign(self, ASharedLayerIds);
1716end;
1717
1718function TBGRALayeredBitmap.ProduceLayerUniqueId: integer;
1719begin
1720 result := InterLockedIncrement(NextLayerUniqueId);
1721end;
1722
1723procedure TBGRALayeredBitmap.RotateCW;
1724var i: integer;
1725 newBmp: TBGRABitmap;
1726 newOfs: TPointF;
1727 m: TAffineMatrix;
1728begin
1729 SetSize(Height,Width); //unfreeze
1730 m := AffineMatrixTranslation(Width,0)*AffineMatrixRotationDeg(90);
1731 for i := 0 to NbLayers-1 do
1732 begin
1733 newOfs:= m*PointF(FLayers[i].x,FLayers[i].y+FLayers[i].Source.Height);
1734 newBmp := FLayers[i].Source.RotateCW as TBGRABitmap;
1735 if FLayers[i].Owner then FreeAndNil(FLayers[i].Source);
1736 FLayers[i].Source := newBmp;
1737 FLayers[i].Owner := true;
1738 FLayers[i].x := round(newOfs.x);
1739 FLayers[i].y := round(newOfs.y);
1740 FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix;
1741 end;
1742end;
1743
1744procedure TBGRALayeredBitmap.RotateCCW;
1745var i: integer;
1746 newBmp: TBGRABitmap;
1747 newOfs: TPointF;
1748 m: TAffineMatrix;
1749begin
1750 SetSize(Height,Width); //unfreeze
1751 m := AffineMatrixTranslation(0,Height)*AffineMatrixRotationDeg(-90);
1752 for i := 0 to NbLayers-1 do
1753 begin
1754 newOfs:= m*PointF(FLayers[i].x+FLayers[i].Source.Width,FLayers[i].y);
1755 newBmp := FLayers[i].Source.RotateCCW as TBGRABitmap;
1756 if FLayers[i].Owner then FreeAndNil(FLayers[i].Source);
1757 FLayers[i].Source := newBmp;
1758 FLayers[i].Owner := true;
1759 FLayers[i].x := round(newOfs.x);
1760 FLayers[i].y := round(newOfs.y);
1761 FLayers[i].OriginalMatrix := m*FLayers[i].OriginalMatrix;
1762 end;
1763end;
1764
1765procedure TBGRALayeredBitmap.HorizontalFlip;
1766var i: integer;
1767begin
1768 Unfreeze;
1769 for i := 0 to NbLayers-1 do
1770 HorizontalFlip(i);
1771end;
1772
1773procedure TBGRALayeredBitmap.HorizontalFlip(ALayerIndex: integer);
1774begin
1775 if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then
1776 raise ERangeError.Create('Index out of bounds');
1777 Unfreeze(ALayerIndex);
1778 if FLayers[ALayerIndex].Owner then
1779 FLayers[ALayerIndex].Source.HorizontalFlip
1780 else
1781 begin
1782 FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True) as TBGRABitmap;
1783 FLayers[ALayerIndex].Source.HorizontalFlip;
1784 FLayers[ALayerIndex].Owner := true;
1785 end;
1786 FLayers[ALayerIndex].x := Width-FLayers[ALayerIndex].x-FLayers[ALayerIndex].Source.Width;
1787 FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(+Width/2,0)*AffineMatrixScale(-1,1)*AffineMatrixTranslation(-Width/2,0)*FLayers[ALayerIndex].OriginalMatrix;
1788end;
1789
1790procedure TBGRALayeredBitmap.VerticalFlip;
1791var i: integer;
1792begin
1793 Unfreeze;
1794 for i := 0 to NbLayers-1 do
1795 VerticalFlip(i);
1796end;
1797
1798procedure TBGRALayeredBitmap.VerticalFlip(ALayerIndex: integer);
1799begin
1800 if (ALayerIndex < 0) or (ALayerIndex >= NbLayers) then
1801 raise ERangeError.Create('Index out of bounds');
1802 Unfreeze(ALayerIndex);
1803 if FLayers[ALayerIndex].Owner then
1804 FLayers[ALayerIndex].Source.VerticalFlip
1805 else
1806 begin
1807 FLayers[ALayerIndex].Source := FLayers[ALayerIndex].Source.Duplicate(True) as TBGRABitmap;
1808 FLayers[ALayerIndex].Source.VerticalFlip;
1809 FLayers[ALayerIndex].Owner := true;
1810 end;
1811 FLayers[ALayerIndex].y := Height-FLayers[ALayerIndex].y-FLayers[ALayerIndex].Source.Height;
1812 FLayers[ALayerIndex].OriginalMatrix := AffineMatrixTranslation(0,+Height/2)*AffineMatrixScale(1,-1)*AffineMatrixTranslation(0,-Height/2)*FLayers[ALayerIndex].OriginalMatrix;
1813end;
1814
1815procedure TBGRALayeredBitmap.Resample(AWidth, AHeight: integer;
1816 AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter);
1817var i, prevWidth, prevHeight: integer;
1818 resampled: TBGRABitmap;
1819 oldFilter : TResampleFilter;
1820begin
1821 if (AWidth < 0) or (AHeight < 0) then
1822 raise exception.Create('Invalid size');
1823 prevWidth := Width;
1824 if prevWidth < 1 then prevWidth := AWidth;
1825 prevHeight := Height;
1826 if prevHeight < 1 then prevHeight := AHeight;
1827 SetSize(AWidth, AHeight); //unfreeze
1828 for i := 0 to NbLayers-1 do
1829 if (FLayers[i].OriginalGuid <> GUID_NULL) and LayerOriginalKnown[i] then
1830 LayerOriginalMatrix[i] := AffineMatrixScale(AWidth/prevWidth,AHeight/prevHeight)*LayerOriginalMatrix[i]
1831 else
1832 begin
1833 oldFilter := LayerBitmap[i].ResampleFilter;
1834 LayerBitmap[i].ResampleFilter := AFineResampleFilter;
1835 resampled := LayerBitmap[i].Resample(AWidth,AHeight, AResampleMode) as TBGRABitmap;
1836 LayerBitmap[i].ResampleFilter := oldFilter;
1837 SetLayerBitmap(i, resampled, True);
1838 end;
1839 if AResampleMode = rmFineResample then RenderOriginalsIfNecessary;
1840end;
1841
1842procedure TBGRALayeredBitmap.SetLayerBitmap(layer: integer;
1843 ABitmap: TBGRABitmap; AOwned: boolean);
1844begin
1845 if (layer < 0) or (layer >= NbLayers) then
1846 raise Exception.Create('Index out of bounds')
1847 else
1848 begin
1849 if ABitmap = FLayers[layer].Source then exit;
1850 Unfreeze(layer);
1851 if FLayers[layer].Owner then FLayers[layer].Source.Free;
1852 FLayers[layer].Source := ABitmap;
1853 FLayers[layer].Owner := AOwned;
1854 FLayers[layer].OriginalGuid := GUID_NULL;
1855 FLayers[layer].OriginalMatrix := AffineMatrixIdentity;
1856 end;
1857end;
1858
1859procedure TBGRALayeredBitmap.ApplyLayerOffset(ALayerIndex: integer;
1860 APadWithTranparentPixels: boolean);
1861var
1862 r: TRect;
1863 newBmp: TBGRABitmap;
1864begin
1865 if APadWithTranparentPixels then
1866 begin
1867 if (LayerOffset[ALayerIndex].X=0) and (LayerOffset[ALayerIndex].Y=0) and
1868 (LayerBitmap[ALayerIndex].Width=Width) and (LayerBitmap[ALayerIndex].Height=Height) then exit;
1869 newBmp := TBGRABitmap.Create(Width,Height);
1870 newBmp.PutImage(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y, LayerBitmap[ALayerIndex], dmSet);
1871 if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free;
1872 FLayers[ALayerIndex].Source := newBmp;
1873 FLayers[ALayerIndex].Owner := true;
1874 FLayers[ALayerIndex].x := 0;
1875 FLayers[ALayerIndex].y := 0;
1876 end else
1877 begin
1878 if (LayerOffset[ALayerIndex].X>=0) and (LayerOffset[ALayerIndex].Y>=0) and
1879 (LayerOffset[ALayerIndex].X+LayerBitmap[ALayerIndex].Width <= Width) and
1880 (LayerOffset[ALayerIndex].Y+LayerBitmap[ALayerIndex].Height <= Height) then exit;
1881 r := RectWithSize(LayerOffset[ALayerIndex].X, LayerOffset[ALayerIndex].Y,
1882 LayerBitmap[ALayerIndex].Width, LayerBitmap[ALayerIndex].Height);
1883 IntersectRect(r, r, rect(0,0,Width,Height));
1884 newBmp := TBGRABitmap.Create(r.Width,r.Height);
1885 newBmp.PutImage(LayerOffset[ALayerIndex].X - r.Left, LayerOffset[ALayerIndex].Y - r.Top, LayerBitmap[ALayerIndex], dmSet);
1886 if FLayers[ALayerIndex].Owner then FLayers[ALayerIndex].Source.Free;
1887 FLayers[ALayerIndex].Source := newBmp;
1888 FLayers[ALayerIndex].Owner := true;
1889 FLayers[ALayerIndex].x := r.Left;
1890 FLayers[ALayerIndex].y := r.Top;
1891 end;
1892end;
1893
1894function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap;
1895 ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect;
1896begin
1897 result := DrawEditor(ADest, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
1898end;
1899
1900function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer;
1901 AMatrix: TAffineMatrix; APointSize: single): TRect;
1902var
1903 orig: TBGRALayerCustomOriginal;
1904begin
1905 orig := LayerOriginal[ALayerIndex];
1906
1907 if orig <> FOriginalEditorOriginal then
1908 begin
1909 FreeAndNil(FOriginalEditor);
1910 FOriginalEditorOriginal := orig;
1911 end;
1912
1913 if Assigned(orig) then
1914 begin
1915 if FOriginalEditor = nil then
1916 begin
1917 FOriginalEditor := orig.CreateEditor;
1918 end;
1919 FOriginalEditor.Clear;
1920 orig.ConfigureEditor(FOriginalEditor);
1921 FOriginalEditorViewMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5);
1922 FOriginalEditor.Matrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*LayerOriginalMatrix[ALayerIndex]*AffineMatrixTranslation(0.5,0.5);
1923 FOriginalEditor.PointSize := APointSize;
1924 result := FOriginalEditor.Render(ADest, rect(0,0,ADest.Width,ADest.Height));
1925 end else
1926 result := EmptyRect;
1927end;
1928
1929function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer; X,
1930 Y: Integer; APointSize: single): TRect;
1931begin
1932 result := GetEditorBounds(ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
1933end;
1934
1935function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect;
1936 ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect;
1937begin
1938 result := GetEditorBounds(ADestRect, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
1939end;
1940
1941function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer;
1942 AMatrix: TAffineMatrix; APointSize: single): TRect;
1943begin
1944 result := GetEditorBounds(rect(-maxLongint,-maxLongint,maxLongint,maxLongint), ALayerIndex, AMatrix, APointSize);
1945end;
1946
1947function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect; ALayerIndex: integer;
1948 AMatrix: TAffineMatrix; APointSize: single): TRect;
1949var
1950 orig: TBGRALayerCustomOriginal;
1951begin
1952 orig := LayerOriginal[ALayerIndex];
1953
1954 if orig <> FOriginalEditorOriginal then
1955 begin
1956 FreeAndNil(FOriginalEditor);
1957 FOriginalEditorOriginal := orig;
1958 end;
1959
1960 if Assigned(orig) then
1961 begin
1962 if FOriginalEditor = nil then
1963 begin
1964 FOriginalEditor := orig.CreateEditor;
1965 if FOriginalEditor = nil then
1966 raise exception.Create('Unexpected nil value');
1967 end;
1968 FOriginalEditor.Clear;
1969 orig.ConfigureEditor(FOriginalEditor);
1970 FOriginalEditorViewMatrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*AffineMatrixTranslation(0.5,0.5);
1971 FOriginalEditor.Matrix := AffineMatrixTranslation(-0.5,-0.5)*AMatrix*LayerOriginalMatrix[ALayerIndex]*AffineMatrixTranslation(0.5,0.5);
1972 FOriginalEditor.PointSize := APointSize;
1973 result := FOriginalEditor.GetRenderBounds(ADestRect);
1974 end else
1975 result := EmptyRect;
1976end;
1977
1978procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out
1979 ACursor: TOriginalEditorCursor);
1980var
1981 handled: boolean;
1982begin
1983 MouseMove(Shift, ImageX,ImageY, ACursor, handled);
1984end;
1985
1986procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean;
1987 Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
1988var
1989 handled: boolean;
1990begin
1991 MouseDown(RightButton, Shift, ImageX,ImageY, ACursor, handled);
1992end;
1993
1994procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState;
1995 ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
1996var
1997 handled: boolean;
1998begin
1999 MouseUp(RightButton, Shift, ImageX,ImageY, ACursor, handled);
2000end;
2001
2002procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out
2003 ACursor: TOriginalEditorCursor; out AHandled: boolean);
2004var
2005 viewPt: TPointF;
2006begin
2007 if Assigned(FOriginalEditor) then
2008 begin
2009 viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY);
2010 FOriginalEditor.MouseMove(Shift, viewPt.X, viewPt.Y, ACursor, AHandled);
2011 end
2012 else
2013 begin
2014 ACursor:= oecDefault;
2015 AHandled:= false;
2016 end;
2017end;
2018
2019procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean;
2020 Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out
2021 AHandled: boolean);
2022var
2023 viewPt: TPointF;
2024begin
2025 if Assigned(FOriginalEditor) then
2026 begin
2027 viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY);
2028 FOriginalEditor.MouseDown(RightButton, Shift, viewPt.X, viewPt.Y, ACursor, AHandled);
2029 end
2030 else
2031 begin
2032 ACursor:= oecDefault;
2033 AHandled:= false;
2034 end;
2035end;
2036
2037procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState;
2038 ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
2039var
2040 viewPt: TPointF;
2041begin
2042 if Assigned(FOriginalEditor) then
2043 begin
2044 viewPt := FOriginalEditorViewMatrix*PointF(ImageX,ImageY);
2045 FOriginalEditor.MouseUp(RightButton, Shift, viewPt.X,viewPt.Y, ACursor, AHandled);
2046 end
2047 else
2048 begin
2049 ACursor:= oecDefault;
2050 AHandled:= false;
2051 end;
2052end;
2053
2054procedure TBGRALayeredBitmap.KeyDown(Shift: TShiftState; Key: TSpecialKey; out
2055 AHandled: boolean);
2056begin
2057 if Assigned(FOriginalEditor) then
2058 FOriginalEditor.KeyDown(Shift, Key, AHandled)
2059 else
2060 AHandled := false;
2061end;
2062
2063procedure TBGRALayeredBitmap.KeyUp(Shift: TShiftState; Key: TSpecialKey; out
2064 AHandled: boolean);
2065begin
2066 if Assigned(FOriginalEditor) then
2067 FOriginalEditor.KeyUp(Shift, Key, AHandled)
2068 else
2069 AHandled := false;
2070end;
2071
2072procedure TBGRALayeredBitmap.KeyPress(UTF8Key: string; out AHandled: boolean);
2073begin
2074 if Assigned(FOriginalEditor) then
2075 FOriginalEditor.KeyPress(UTF8Key, AHandled)
2076 else
2077 AHandled := false;
2078end;
2079
2080function TBGRALayeredBitmap.IndexOfOriginal(AGuid: TGuid): integer;
2081var
2082 i: Integer;
2083begin
2084 for i := 0 to OriginalCount-1 do
2085 if FOriginals[i].Guid = AGuid then
2086 begin
2087 result := i;
2088 exit;
2089 end;
2090 result := -1
2091end;
2092
2093function TBGRALayeredBitmap.IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer;
2094begin
2095 if Assigned(FOriginals) then
2096 result := FOriginals.IndexOf(BGRALayerOriginalEntry(AOriginal))
2097 else
2098 result := -1;
2099end;
2100
2101{ TBGRACustomLayeredBitmap }
2102
2103function TBGRACustomLayeredBitmap.GetLinearBlend: boolean;
2104begin
2105 result := FLinearBlend;
2106end;
2107
2108function TBGRACustomLayeredBitmap.GetMemDirectory: TMemDirectory;
2109begin
2110 if FMemDirectory = nil then
2111 begin
2112 FMemDirectory:= TMemDirectory.Create;
2113 FMemDirectoryOwned := true;
2114 end;
2115 result := FMemDirectory;
2116end;
2117
2118function TBGRACustomLayeredBitmap.GetDefaultBlendingOperation: TBlendOperation;
2119begin
2120 result := boTransparent;
2121end;
2122
2123function TBGRACustomLayeredBitmap.GetHasMemFiles: boolean;
2124begin
2125 result := assigned(FMemDirectory) and (FMemDirectory.Count > 0);
2126end;
2127
2128function TBGRACustomLayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid;
2129begin
2130 result := GUID_NULL;
2131end;
2132
2133function TBGRACustomLayeredBitmap.GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus;
2134begin
2135 result := orsProof;
2136end;
2137
2138function TBGRACustomLayeredBitmap.GetOriginalCount: integer;
2139begin
2140 result := 0;
2141end;
2142
2143function TBGRACustomLayeredBitmap.GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal;
2144begin
2145 result := nil;
2146 raise exception.Create('Not implemented');
2147end;
2148
2149function TBGRACustomLayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean;
2150begin
2151 result := true;
2152end;
2153
2154function TBGRACustomLayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal;
2155begin
2156 result := nil;
2157end;
2158
2159function TBGRACustomLayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean;
2160begin
2161 result := true;
2162end;
2163
2164function TBGRACustomLayeredBitmap.GetLayerOriginalMatrix(layer: integer): TAffineMatrix;
2165begin
2166 result := AffineMatrixIdentity;
2167end;
2168
2169procedure TBGRACustomLayeredBitmap.SetLinearBlend(AValue: boolean);
2170begin
2171 Unfreeze;
2172 FLinearBlend := AValue;
2173end;
2174
2175procedure TBGRACustomLayeredBitmap.SetMemDirectory(AValue: TMemDirectory);
2176begin
2177 if AValue = FMemDirectory then exit;
2178 if FMemDirectoryOwned then FMemDirectory.Free;
2179 FMemDirectory := AValue;
2180 FMemDirectoryOwned := false;
2181end;
2182
2183function TBGRACustomLayeredBitmap.GetLayerName(layer: integer): string;
2184begin
2185 result := 'Layer' + inttostr(layer+1);
2186end;
2187
2188{$hints off}
2189function TBGRACustomLayeredBitmap.GetLayerOffset(layer: integer): TPoint;
2190begin
2191 //optional function
2192 result := Point(0,0);
2193end;
2194{$hints on}
2195
2196{$hints off}
2197function TBGRACustomLayeredBitmap.GetLayerBitmapDirectly(layer: integer
2198 ): TBGRABitmap;
2199begin
2200 //optional function
2201 result:= nil;
2202end;
2203
2204function TBGRACustomLayeredBitmap.GetLayerFrozenRange(layer: integer): integer;
2205var i: integer;
2206begin
2207 for i := 0 to high(FFrozenRange) do
2208 if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then
2209 begin
2210 result := i;
2211 exit;
2212 end;
2213 result := -1;
2214end;
2215
2216function TBGRACustomLayeredBitmap.GetLayerFrozen(layer: integer): boolean;
2217var i: integer;
2218begin
2219 for i := 0 to high(FFrozenRange) do
2220 if (layer >= FFrozenRange[i].firstLayer) and (layer <= FFrozenRange[i].lastLayer) then
2221 begin
2222 result := true;
2223 exit;
2224 end;
2225 result := false;
2226end;
2227
2228function TBGRACustomLayeredBitmap.GetLayerUniqueId(layer: integer): integer;
2229begin
2230 result := layer;
2231end;
2232
2233procedure TBGRACustomLayeredBitmap.SetLayerFrozen(layer: integer;
2234 AValue: boolean);
2235begin
2236 //nothing
2237end;
2238
2239function TBGRACustomLayeredBitmap.RangeIntersect(first1, last1, first2,
2240 last2: integer): boolean;
2241begin
2242 result := (first1 <= last2) and (last1 >= first2);
2243end;
2244
2245procedure TBGRACustomLayeredBitmap.RemoveFrozenRange(index: integer);
2246var j,i: integer;
2247begin
2248 for j := FFrozenRange[index].firstLayer to FFrozenRange[index].lastLayer do
2249 SetLayerFrozen(j,False);
2250 FFrozenRange[index].image.Free;
2251 for i := index to high(FFrozenRange)-1 do
2252 FFrozenRange[i] := FFrozenRange[i+1];
2253 setlength(FFrozenRange,length(FFrozenRange)-1);
2254end;
2255
2256function TBGRACustomLayeredBitmap.ContainsFrozenRange(first, last: integer): boolean;
2257var i: integer;
2258begin
2259 for i := 0 to high(FFrozenRange) do
2260 if (FFrozenRange[i].firstLayer = first) and (FFrozenRange[i].lastLayer = last) then
2261 begin
2262 result := true;
2263 exit;
2264 end;
2265 result := false;
2266end;
2267
2268function TBGRACustomLayeredBitmap.GetEmpty: boolean;
2269begin
2270 result := (NbLayers = 0) and (Width = 0) and (Height = 0);
2271end;
2272
2273function TBGRACustomLayeredBitmap.IndexOfOriginal(AGuid: TGuid): integer;
2274begin
2275 result := -1;
2276end;
2277
2278function TBGRACustomLayeredBitmap.IndexOfOriginal(
2279 AOriginal: TBGRALayerCustomOriginal): integer;
2280begin
2281 result := -1;
2282end;
2283
2284procedure TBGRACustomLayeredBitmap.SetWidth(Value: Integer);
2285begin
2286 //nothing
2287end;
2288
2289procedure TBGRACustomLayeredBitmap.SetHeight(Value: Integer);
2290begin
2291 //nothing
2292end;
2293
2294function TBGRACustomLayeredBitmap.GetTransparent: Boolean;
2295begin
2296 result := true;
2297end;
2298
2299procedure TBGRACustomLayeredBitmap.SetTransparent(Value: Boolean);
2300begin
2301 //nothing
2302end;
2303
2304procedure TBGRACustomLayeredBitmap.SaveToFile(const filenameUTF8: string);
2305var bmp: TBGRABitmap;
2306 ext: string;
2307 temp: TBGRALayeredBitmap;
2308 i: integer;
2309 stream: TFileStreamUTF8;
2310begin
2311 ext := UTF8LowerCase(ExtractFileExt(filenameUTF8));
2312 for i := 0 to high(LayeredBitmapWriters) do
2313 if '.'+LayeredBitmapWriters[i].extension = ext then
2314 begin
2315 temp := LayeredBitmapWriters[i].theClass.Create;
2316 try
2317 temp.Assign(self);
2318 temp.SaveToFile(filenameUTF8);
2319 finally
2320 temp.Free;
2321 end;
2322 exit;
2323 end;
2324
2325 //when using "data" extension, simply serialize
2326 if (ext='.dat') or (ext='.data') then
2327 begin
2328 if Assigned(LayeredBitmapLoadFromStreamProc) then
2329 begin
2330 stream := TFileStreamUTF8.Create(filenameUTF8, fmCreate);
2331 try
2332 LayeredBitmapSaveToStreamProc(stream, self);
2333 finally
2334 stream.Free;
2335 end;
2336 end else
2337 raise exception.Create('Enable layer serialization by calling BGRAStreamLayers.RegisterStreamLayers');
2338 end else
2339 begin
2340 bmp := ComputeFlatImage;
2341 try
2342 bmp.SaveToFileUTF8(filenameUTF8);
2343 finally
2344 bmp.Free;
2345 end;
2346 end;
2347end;
2348
2349procedure TBGRACustomLayeredBitmap.SaveToStream(Stream: TStream);
2350begin
2351 if Assigned(LayeredBitmapSaveToStreamProc) then
2352 LayeredBitmapSaveToStreamProc(Stream, self)
2353 else
2354 raise exception.Create('Call BGRAStreamLayers.RegisterStreamLayers first');
2355end;
2356
2357procedure TBGRACustomLayeredBitmap.SaveToStreamAs(Stream: TStream;
2358 AExtension: string);
2359var bmp: TBGRABitmap;
2360 ext: string;
2361 format: TBGRAImageFormat;
2362 temp: TBGRALayeredBitmap;
2363 i: integer;
2364begin
2365 ext := UTF8LowerCase(AExtension);
2366 if ext[1] <> '.' then ext := '.'+ext;
2367
2368 for i := 0 to high(LayeredBitmapWriters) do
2369 if '.'+LayeredBitmapWriters[i].extension = ext then
2370 begin
2371 temp := LayeredBitmapWriters[i].theClass.Create;
2372 try
2373 temp.Assign(self);
2374 temp.SaveToStream(Stream);
2375 finally
2376 temp.Free;
2377 end;
2378 exit;
2379 end;
2380
2381 format := SuggestImageFormat(ext);
2382 bmp := ComputeFlatImage;
2383 try
2384 bmp.SaveToStreamAs(Stream, format);
2385 finally
2386 bmp.Free;
2387 end;
2388end;
2389
2390constructor TBGRACustomLayeredBitmap.Create;
2391begin
2392 FFrozenRange := nil;
2393 FLinearBlend:= True;
2394 FMemDirectory := nil;
2395 FMemDirectoryOwned:= false;
2396end;
2397
2398{$hints on}
2399
2400function TBGRACustomLayeredBitmap.ToString: ansistring;
2401var
2402 i: integer;
2403begin
2404 Result := 'LayeredBitmap' + LineEnding + LineEnding;
2405 for i := 0 to NbLayers - 1 do
2406 begin
2407 Result += LineEnding + 'Layer ' + IntToStr(i) + ' : ' + LayerName[i] + LineEnding;
2408 end;
2409end;
2410
2411function TBGRACustomLayeredBitmap.ComputeFlatImage(ASeparateXorMask: boolean): TBGRABitmap;
2412begin
2413 result := ComputeFlatImage(rect(0,0,Width,Height), 0, NbLayers - 1, ASeparateXorMask);
2414end;
2415
2416function TBGRACustomLayeredBitmap.ComputeFlatImage(firstLayer,
2417 lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap;
2418begin
2419 result := ComputeFlatImage(rect(0,0,Width,Height), firstLayer,LastLayer,ASeparateXorMask);
2420end;
2421
2422function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect;
2423 ASeparateXorMask: boolean): TBGRABitmap;
2424begin
2425 result := ComputeFlatImage(ARect,0, NbLayers - 1, ASeparateXorMask);
2426end;
2427
2428destructor TBGRACustomLayeredBitmap.Destroy;
2429begin
2430 Clear;
2431end;
2432
2433function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap;
2434var
2435 tempLayer: TBGRABitmap;
2436 i,j: integer;
2437 mustFreeCopy: boolean;
2438 op: TBlendOperation;
2439begin
2440 if (firstLayer < 0) or (lastLayer > NbLayers-1) then
2441 raise ERangeError.Create('Layer index out of bounds');
2442 If (ARect.Right <= ARect.Left) or (ARect.Bottom <= ARect.Top) then
2443 begin
2444 result := TBGRABitmap.Create(0,0);
2445 exit;
2446 end;
2447 Result := TBGRABitmap.Create(ARect.Right-ARect.Left, ARect.Bottom-ARect.Top);
2448 i := firstLayer;
2449 while i <= lastLayer do
2450 begin
2451 if LayerFrozen[i] then
2452 begin
2453 j := GetLayerFrozenRange(i);
2454 if j <> -1 then
2455 begin
2456 if i = 0 then
2457 Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmSet) else
2458 if not FFrozenRange[j].linearBlend then
2459 Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmDrawWithTransparency)
2460 else
2461 Result.PutImage(-ARect.Left,-ARect.Top,FFrozenRange[j].image,dmLinearBlend);
2462 i := FFrozenRange[j].lastLayer+1;
2463 continue;
2464 end;
2465 end;
2466 if LayerVisible[i] and (LayerOpacity[i]<>0) then
2467 begin
2468 tempLayer := GetLayerBitmapDirectly(i);
2469 if tempLayer <> nil then
2470 mustFreeCopy := false
2471 else
2472 begin
2473 mustFreeCopy := true;
2474 tempLayer := GetLayerBitmapCopy(i);
2475 end;
2476 if tempLayer <> nil then
2477 with LayerOffset[i] do
2478 begin
2479 op := BlendOperation[i];
2480 //XOR mask
2481 if (op = boXor) and ASeparateXorMask then
2482 begin
2483 result.NeedXorMask;
2484 result.XorMask.BlendImageOver(x-ARect.Left,y-ARect.Top, tempLayer, op, LayerOpacity[i], LinearBlend);
2485 end else
2486 //first layer is simply the background
2487 if i = firstLayer then
2488 Result.PutImage(x-ARect.Left, y-ARect.Top, tempLayer, dmSet, LayerOpacity[i])
2489 else
2490 //simple blend operations
2491 if (op = boLinearBlend) or ((op = boTransparent) and LinearBlend) then
2492 Result.PutImage(x-ARect.Left,y-ARect.Top,tempLayer,dmLinearBlend, LayerOpacity[i]) else
2493 if op = boTransparent then
2494 Result.PutImage(x-ARect.Left,y-ARect.Top,tempLayer,dmDrawWithTransparency, LayerOpacity[i])
2495 else
2496 //complex blend operations are done in a third bitmap
2497 result.BlendImageOver(x-ARect.Left,y-ARect.Top, tempLayer, op, LayerOpacity[i], LinearBlend);
2498 if mustFreeCopy then tempLayer.Free;
2499 end;
2500 end;
2501 inc(i);
2502 end;
2503 if result.XorMask <> nil then
2504 AlphaFillInline(result.XorMask.Data, 0, result.XorMask.NbPixels);
2505end;
2506
2507procedure TBGRACustomLayeredBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
2508var temp: TBGRABitmap;
2509begin
2510 if (Rect.Right <= Rect.Left) or (Rect.Bottom <= Rect.Top) then exit;
2511 if (Rect.Right-Rect.Left = Width) and (Rect.Bottom-Rect.Top = Height) then
2512 Draw(ACanvas, Rect.Left,Rect.Top) else
2513 begin
2514 temp := ComputeFlatImage;
2515 BGRAReplace(temp,temp.Resample(Rect.Right-Rect.Left,Rect.Bottom-Rect.Top));
2516 temp.Draw(ACanvas, Rect.Left,Rect.Top, False);
2517 temp.Free;
2518 end;
2519end;
2520
2521procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer);
2522begin
2523 Draw(Canvas,x,y,0,NbLayers-1);
2524end;
2525
2526procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer; firstLayer, lastLayer: integer);
2527var temp: TBGRABitmap;
2528begin
2529 temp := ComputeFlatImage(firstLayer,lastLayer);
2530 temp.Draw(Canvas,x,y,False);
2531 temp.Free;
2532end;
2533
2534procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer);
2535begin
2536 Draw(Dest,x,y,0,NbLayers-1);
2537end;
2538
2539procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer;
2540 ASeparateXorMask: boolean);
2541begin
2542 Draw(Dest,x,y,0,NbLayers-1,ASeparateXorMask);
2543end;
2544
2545procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; AX, AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean);
2546var
2547 temp: TBGRABitmap;
2548 i,j: integer;
2549 tempLayer: TBGRABitmap;
2550 mustFreeCopy: boolean;
2551 OldClipRect: TRect;
2552 NewClipRect: TRect;
2553begin
2554 OldClipRect := Dest.ClipRect;
2555 NewClipRect := rect(0,0,0,0);
2556 if not IntersectRect(NewClipRect,rect(AX,AY,AX+Width,AY+Height),Dest.ClipRect) then exit; //nothing to be drawn
2557
2558 for i := firstLayer to lastLayer do
2559 if LayerVisible[i] and not (BlendOperation[i] in[boTransparent,boLinearBlend]) then
2560 begin
2561 temp := ComputeFlatImage(rect(NewClipRect.Left-AX,NewClipRect.Top-AY,NewClipRect.Right-AX,NewClipRect.Bottom-AY), ASeparateXorMask);
2562 if self.LinearBlend then
2563 Dest.PutImage(NewClipRect.Left,NewClipRect.Top,temp,dmLinearBlend)
2564 else
2565 Dest.PutImage(NewClipRect.Left,NewClipRect.Top,temp,dmDrawWithTransparency);
2566 temp.Free;
2567 exit;
2568 end;
2569
2570 Dest.ClipRect := NewClipRect;
2571 i := firstLayer;
2572 while i <= lastLayer do
2573 begin
2574 if LayerFrozen[i] then
2575 begin
2576 j := GetLayerFrozenRange(i);
2577 if j <> -1 then
2578 begin
2579 if not FFrozenRange[j].linearBlend then
2580 Dest.PutImage(AX,AY,FFrozenRange[j].image,dmDrawWithTransparency)
2581 else
2582 Dest.PutImage(AX,AY,FFrozenRange[j].image,dmLinearBlend);
2583 i := FFrozenRange[j].lastLayer+1;
2584 continue;
2585 end;
2586 end;
2587 if LayerVisible[i] then
2588 begin
2589 tempLayer := GetLayerBitmapDirectly(i);
2590 if tempLayer <> nil then
2591 mustFreeCopy := false
2592 else
2593 begin
2594 mustFreeCopy := true;
2595 tempLayer := GetLayerBitmapCopy(i);
2596 end;
2597 if tempLayer <> nil then
2598 with LayerOffset[i] do
2599 begin
2600 if (BlendOperation[i] = boTransparent) and not self.LinearBlend then //here it is specified not to use linear blending
2601 Dest.PutImage(AX+x,AY+y,tempLayer,dmDrawWithTransparency, LayerOpacity[i])
2602 else
2603 Dest.PutImage(AX+x,AY+y,tempLayer,dmLinearBlend, LayerOpacity[i]);
2604 if mustFreeCopy then tempLayer.Free;
2605 end;
2606 end;
2607 inc(i);
2608 end;
2609 Dest.ClipRect := OldClipRect;
2610end;
2611
2612procedure TBGRACustomLayeredBitmap.FreezeExceptOneLayer(layer: integer);
2613begin
2614 if (layer < 0) or (layer >= NbLayers) then
2615 begin
2616 Freeze;
2617 exit;
2618 end;
2619 Unfreeze(layer,layer);
2620 if layer > 1 then
2621 Freeze(0,layer-1);
2622 if layer < NbLayers-2 then
2623 Freeze(layer+1,NbLayers-1);
2624end;
2625
2626procedure TBGRACustomLayeredBitmap.Freeze(firstLayer, lastLayer: integer);
2627
2628 procedure DoFreeze(first,last: integer; linear: boolean);
2629 var i,nbVisible: integer;
2630 computedImage: TBGRABitmap;
2631 begin
2632 if last <= first then exit; //at least 2 frozen layers
2633 nbVisible := 0;
2634 for i := first to last do
2635 if LayerVisible[i] and (LayerOpacity[i] > 0) then nbVisible += 1;
2636 if nbvisible < 2 then exit; //at least 2 frozen layers
2637
2638 if ContainsFrozenRange(first,last) then exit; //already frozen
2639 Unfreeze(first,last);
2640
2641 computedImage := ComputeFlatImage(first,last); //must compute before layers are considered as frozen
2642 setlength(FFrozenRange, length(FFrozenRange)+1);
2643 with FFrozenRange[high(FFrozenRange)] do
2644 begin
2645 firstLayer := first;
2646 lastLayer:= last;
2647 image := computedImage;
2648 linearBlend := linear;
2649 end;
2650 for i := first to last do
2651 SetLayerFrozen(i,True);
2652 end;
2653
2654var j: integer;
2655 start: integer;
2656 linear,nextLinear: boolean;
2657begin
2658 start := -1;
2659 linear := false; //to avoid hint
2660 for j := firstlayer to lastLayer do
2661 if (BlendOperation[j] in [boTransparent,boLinearBlend]) or (start = 0) or ((firstlayer= 0) and (j=0)) then
2662 begin
2663 nextLinear := (BlendOperation[j] = boLinearBlend) or self.LinearBlend;
2664 if start = -1 then
2665 begin
2666 start := j;
2667 linear := nextLinear;
2668 end else
2669 begin
2670 if linear <> nextLinear then
2671 begin
2672 DoFreeze(start,j-1,linear);
2673 start := j;
2674 linear := nextLinear;
2675 end;
2676 end;
2677 end else
2678 begin
2679 if start <> -1 then
2680 begin
2681 DoFreeze(start,j-1,linear);
2682 start := -1;
2683 end;
2684 end;
2685 if start <> -1 then
2686 DoFreeze(start,lastLayer,linear);
2687end;
2688
2689procedure TBGRACustomLayeredBitmap.Freeze;
2690begin
2691 Freeze(0,NbLayers-1);
2692end;
2693
2694procedure TBGRACustomLayeredBitmap.Unfreeze;
2695begin
2696 Unfreeze(0,NbLayers-1);
2697end;
2698
2699procedure TBGRACustomLayeredBitmap.Unfreeze(layer: integer);
2700begin
2701 Unfreeze(layer,layer);
2702end;
2703
2704procedure TBGRACustomLayeredBitmap.Unfreeze(firstLayer, lastLayer: integer);
2705var i: integer;
2706begin
2707 for i := high(FFrozenRange) downto 0 do
2708 if RangeIntersect(firstLayer,lastLayer,FFrozenRange[i].firstLayer,FFrozenRange[i].lastLayer) then
2709 RemoveFrozenRange(i);
2710end;
2711
2712procedure TBGRACustomLayeredBitmap.NotifyLoaded;
2713begin
2714 //nothing
2715end;
2716
2717procedure TBGRACustomLayeredBitmap.NotifySaving;
2718begin
2719 //nothing
2720end;
2721
2722procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
2723begin
2724 setlength(LayeredBitmapReaders,length(LayeredBitmapReaders)+1);
2725 with LayeredBitmapReaders[high(LayeredBitmapReaders)] do
2726 begin
2727 extension:= UTF8LowerCase(AExtensionUTF8);
2728 theClass := AReader;
2729 end;
2730end;
2731
2732function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap;
2733var
2734 i: Integer;
2735begin
2736 AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8);
2737 if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then
2738 AExtensionUTF8:= '.'+AExtensionUTF8;
2739 for i := 0 to high(LayeredBitmapWriters) do
2740 if '.'+LayeredBitmapWriters[i].extension = AExtensionUTF8 then
2741 begin
2742 result := LayeredBitmapWriters[i].theClass.Create;
2743 exit;
2744 end;
2745 result := nil;
2746end;
2747
2748function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap;
2749var
2750 i: Integer;
2751begin
2752 AExtensionUTF8:= UTF8LowerCase(AExtensionUTF8);
2753 if (AExtensionUTF8 = '') or (AExtensionUTF8[1] <> '.') then
2754 AExtensionUTF8:= '.'+AExtensionUTF8;
2755 for i := 0 to high(LayeredBitmapReaders) do
2756 if '.'+LayeredBitmapReaders[i].extension = AExtensionUTF8 then
2757 begin
2758 result := LayeredBitmapReaders[i].theClass.Create;
2759 exit;
2760 end;
2761 result := nil;
2762end;
2763
2764procedure OnLayeredBitmapLoadFromStreamStart;
2765begin
2766 OnLayeredBitmapLoadStart('<Stream>');
2767end;
2768
2769procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
2770begin
2771 if Assigned(OnLayeredBitmapLoadStartProc) then
2772 OnLayeredBitmapLoadStartProc(AFilenameUTF8);
2773end;
2774
2775procedure OnLayeredBitmapLoadProgress(APercentage: integer);
2776begin
2777 if Assigned(OnLayeredBitmapLoadProgressProc) then
2778 OnLayeredBitmapLoadProgressProc(APercentage);
2779end;
2780
2781procedure OnLayeredBitmapLoaded;
2782begin
2783 if Assigned(OnLayeredBitmapLoadedProc) then
2784 OnLayeredBitmapLoadedProc();
2785end;
2786
2787procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
2788 AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc
2789 );
2790begin
2791 OnLayeredBitmapLoadProgressProc:= AProgress;
2792 OnLayeredBitmapLoadStartProc := AStart;
2793 OnLayeredBitmapLoadedProc:= ADone;
2794end;
2795
2796procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
2797 AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc);
2798begin
2799 if OnLayeredBitmapLoadProgressProc = AProgress then OnLayeredBitmapLoadProgressProc := nil;
2800 if OnLayeredBitmapLoadStartProc = AStart then OnLayeredBitmapLoadStartProc := nil;
2801 if OnLayeredBitmapLoadedProc = ADone then OnLayeredBitmapLoadedProc := nil;
2802end;
2803
2804procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
2805begin
2806 while (length(AExtensionUTF8)>0) and (AExtensionUTF8[1]='.') do delete(AExtensionUTF8,1,1);
2807 setlength(LayeredBitmapWriters,length(LayeredBitmapWriters)+1);
2808 with LayeredBitmapWriters[high(LayeredBitmapWriters)] do
2809 begin
2810 extension:= UTF8LowerCase(AExtensionUTF8);
2811 theClass := AWriter;
2812 end;
2813end;
2814
2815initialization
2816
2817 NextLayerUniqueId := 1;
2818
2819end.
2820
Note: See TracBrowser for help on using the repository browser.