Context Navigation

bgralayers.pas

Last change on this file was 2, checked in by chronos, 6 years ago
Source code taken from https://svn.zdechov.net/PascalClassLibrary/GraphicTest/ rev 543.
File size: 92.3 KB

Line
1	unit BGRALayers;
2
3	{$mode objfpc}{$H+}
4	{$MODESWITCH ADVANCEDRECORDS}
5
6	interface
7
8	uses
9	BGRAGraphics, Classes, SysUtils, Types, BGRABitmapTypes, BGRABitmap,
10	BGRAMemDirectory, BGRATransform, fgl, BGRALayerOriginal;
11
12	type
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
24	function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry;
25	function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry;
26
27	type
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
332	procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
333	procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
334	function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap;
335	function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap;
336
337	var
338	LayeredBitmapSaveToStreamProc : TBGRALayeredBitmapSaveToStreamProc;
339	LayeredBitmapLoadFromStreamProc : TBGRALayeredBitmapLoadFromStreamProc;
340	LayeredBitmapCheckStreamProc: TBGRALayeredBitmapCheckStreamProc;
341
342	type
343	TOnLayeredBitmapLoadStartProc = procedure(AFilenameUTF8: string) of object;
344	TOnLayeredBitmapLoadProgressProc = procedure(APercentage: integer) of object;
345	TOnLayeredBitmapLoadedProc = procedure() of object;
346
347	procedure OnLayeredBitmapLoadFromStreamStart;
348	procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
349	procedure OnLayeredBitmapLoadProgress(APercentage: integer);
350	procedure OnLayeredBitmapLoaded();
351	procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
352	ADone: TOnLayeredBitmapLoadedProc);
353	procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc; AProgress: TOnLayeredBitmapLoadProgressProc;
354	ADone: TOnLayeredBitmapLoadedProc);
355
356	implementation
357
358	uses BGRAUTF8, BGRABlend, BGRAMultiFileType, math;
359
360	const
361	OriginalsDirectory = 'originals';
362
363	var
364	OnLayeredBitmapLoadStartProc: TOnLayeredBitmapLoadStartProc;
365	OnLayeredBitmapLoadProgressProc: TOnLayeredBitmapLoadProgressProc;
366	OnLayeredBitmapLoadedProc: TOnLayeredBitmapLoadedProc;
367
368	var
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
381	class operator TBGRALayerOriginalEntry.=(const AEntry1,
382	AEntry2: TBGRALayerOriginalEntry): boolean;
383	begin
384	result := AEntry1.Guid = AEntry2.Guid;
385	end;
386
387	function BGRALayerOriginalEntry(AGuid: TGuid): TBGRALayerOriginalEntry;
388	begin
389	result.Guid := AGuid;
390	result.Instance := nil;
391	end;
392
393	function BGRALayerOriginalEntry(AInstance: TBGRALayerCustomOriginal): TBGRALayerOriginalEntry;
394	begin
395	result.Guid := AInstance.Guid;
396	result.Instance := AInstance;
397	end;
398
399	{ TBGRALayeredBitmap }
400
401	function TBGRALayeredBitmap.GetLayerUniqueId(layer: integer): integer;
402	begin
403	if (layer < 0) or (layer >= NbLayers) then
404	raise Exception.Create('Index out of bounds')
405	else
406	Result:= FLayers[layer].UniqueId;
407	end;
408
409	function TBGRALayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal;
410	var
411	idxOrig: Integer;
412	begin
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;
422	end;
423
424	function TBGRALayeredBitmap.GetLayerOriginalMatrix(layer: integer
425	): TAffineMatrix;
426	begin
427	if (layer < 0) or (layer >= NbLayers) then
428	raise Exception.Create('Index out of bounds')
429	else
430	result := FLayers[layer].OriginalMatrix;
431	end;
432
433	function TBGRALayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid;
434	begin
435	if (layer < 0) or (layer >= NbLayers) then
436	raise Exception.Create('Index out of bounds')
437	else
438	result := FLayers[layer].OriginalGuid;
439	end;
440
441	function TBGRALayeredBitmap.GetLayerOriginalRenderStatus(layer: integer
442	): TOriginalRenderStatus;
443	begin
444	if (layer < 0) or (layer >= NbLayers) then
445	raise Exception.Create('Index out of bounds')
446	else
447	result := FLayers[layer].OriginalRenderStatus;
448	end;
449
450	procedure TBGRALayeredBitmap.SetLayerUniqueId(layer: integer; AValue: integer);
451	var i: integer;
452	begin
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;
462	end;
463
464	procedure TBGRALayeredBitmap.SetLayerOriginalMatrix(layer: integer;
465	AValue: TAffineMatrix);
466	begin
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;
479	end;
480
481	procedure TBGRALayeredBitmap.SetLayerOriginalGuid(layer: integer;
482	const AValue: TGuid);
483	begin
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;
497	end;
498
499	procedure TBGRALayeredBitmap.SetLayerOriginalRenderStatus(layer: integer;
500	AValue: TOriginalRenderStatus);
501	begin
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;
510	end;
511
512	procedure TBGRALayeredBitmap.FindOriginal(AGuid: TGuid; out
513	ADir: TMemDirectory; out AClass: TBGRALayerOriginalAny);
514	var
515	c: String;
516	begin
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;
529	end;
530
531	procedure TBGRALayeredBitmap.StoreOriginal(AOriginal: TBGRALayerCustomOriginal);
532	var
533	dir, subdir: TMemDirectory;
534	storage: TBGRAMemOriginalStorage;
535	begin
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;
546	end;
547
548	procedure TBGRALayeredBitmap.OriginalChange(ASender: TObject; ABounds: PRectF);
549	var
550	i: Integer;
551	orig: TBGRALayerCustomOriginal;
552	transfBounds: TRectF;
553	begin
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);
584	end;
585
586	procedure TBGRALayeredBitmap.OriginalEditingChange(ASender: TObject);
587	var
588	orig: TBGRALayerCustomOriginal;
589	begin
590	orig := TBGRALayerCustomOriginal(ASender);
591	if Assigned(FOriginalEditingChange) then
592	FOriginalEditingChange(self, orig);
593	end;
594
595	function TBGRALayeredBitmap.GetOriginalCount: integer;
596	begin
597	if Assigned(FOriginals) then
598	result := FOriginals.Count
599	else
600	result := 0;
601	end;
602
603	function TBGRALayeredBitmap.GetOriginalByIndex(AIndex: integer
604	): TBGRALayerCustomOriginal;
605	var
606	dir: TMemDirectory;
607	c: TBGRALayerOriginalAny;
608	guid: TGuid;
609	storage: TBGRAMemOriginalStorage;
610	begin
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;
638	end;
639
640	function TBGRALayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean;
641	var
642	idxOrig: Integer;
643	begin
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;
653	end;
654
655	function TBGRALayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean;
656	var
657	dir: TMemDirectory;
658	c: TBGRALayerOriginalAny;
659	guid: TGuid;
660	begin
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);
670	end;
671
672	function TBGRALayeredBitmap.GetOriginalGuid(AIndex: integer): TGUID;
673	begin
674	if (AIndex < 0) or (AIndex >= OriginalCount) then
675	raise ERangeError.Create('Index out of bounds');
676
677	result := FOriginals[AIndex].Guid;
678	end;
679
680	function TBGRALayeredBitmap.GetWidth: integer;
681	begin
682	Result:= FWidth;
683	end;
684
685	function TBGRALayeredBitmap.GetHeight: integer;
686	begin
687	Result:= FHeight;
688	end;
689
690	function TBGRALayeredBitmap.GetNbLayers: integer;
691	begin
692	Result:= FNbLayers;
693	end;
694
695	function TBGRALayeredBitmap.GetBlendOperation(Layer: integer): TBlendOperation;
696	begin
697	if (layer < 0) or (layer >= NbLayers) then
698	raise Exception.Create('Index out of bounds')
699	else
700	Result:= FLayers[layer].blendOp;
701	end;
702
703	function TBGRALayeredBitmap.GetLayerVisible(layer: integer): boolean;
704	begin
705	if (layer < 0) or (layer >= NbLayers) then
706	raise Exception.Create('Index out of bounds')
707	else
708	Result:= FLayers[layer].Visible;
709	end;
710
711	function TBGRALayeredBitmap.GetLayerOpacity(layer: integer): byte;
712	begin
713	if (layer < 0) or (layer >= NbLayers) then
714	raise Exception.Create('Index out of bounds')
715	else
716	Result:= FLayers[layer].Opacity;
717	end;
718
719	function TBGRALayeredBitmap.GetLayerOffset(layer: integer): TPoint;
720	begin
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);
726	end;
727
728	function TBGRALayeredBitmap.GetLayerName(layer: integer): string;
729	begin
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;
741	end;
742
743	function TBGRALayeredBitmap.GetLayerFrozen(layer: integer): boolean;
744	begin
745	if (layer < 0) or (layer >= NbLayers) then
746	raise Exception.Create('Index out of bounds')
747	else
748	Result:= FLayers[layer].Frozen;
749	end;
750
751	procedure TBGRALayeredBitmap.SetBlendOperation(Layer: integer;
752	op: TBlendOperation);
753	begin
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;
764	end;
765
766	procedure TBGRALayeredBitmap.SetLayerVisible(layer: integer; AValue: boolean);
767	begin
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;
778	end;
779
780	procedure TBGRALayeredBitmap.SetLayerOpacity(layer: integer; AValue: byte);
781	begin
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;
792	end;
793
794	procedure TBGRALayeredBitmap.SetLayerOffset(layer: integer; AValue: TPoint);
795	begin
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;
811	end;
812
813	procedure TBGRALayeredBitmap.SetLayerName(layer: integer; AValue: string);
814	begin
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;
824	end;
825
826	procedure TBGRALayeredBitmap.SetLayerFrozen(layer: integer; AValue: boolean);
827	begin
828	if (layer < 0) or (layer >= NbLayers) then
829	raise Exception.Create('Index out of bounds')
830	else
831	FLayers[layer].Frozen := AValue;
832	end;
833
834	function TBGRALayeredBitmap.GetLayerBitmapDirectly(layer: integer): TBGRABitmap;
835	begin
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;
846	end;
847
848	procedure TBGRALayeredBitmap.LoadFromFile(const filenameUTF8: string);
849	var bmp: TBGRABitmap;
850	ext: string;
851	temp: TBGRACustomLayeredBitmap;
852	i: integer;
853	stream: TFileStreamUTF8;
854	begin
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;
889	end;
890
891	procedure TBGRALayeredBitmap.LoadFromStream(stream: TStream);
892	var bmp: TBGRABitmap;
893	begin
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);
908	end;
909
910	procedure TBGRALayeredBitmap.LoadFromResource(AFilename: string);
911	var
912	stream: TStream;
913	begin
914	stream := BGRAResource.GetResourceStream(AFilename);
915	try
916	LoadFromStream(stream);
917	finally
918	stream.Free;
919	end;
920	end;
921
922	procedure TBGRALayeredBitmap.SetSize(AWidth, AHeight: integer);
923	begin
924	Unfreeze;
925	FWidth := AWidth;
926	FHeight := AHeight;
927	end;
928
929	procedure TBGRALayeredBitmap.Clear;
930	var i: integer;
931	begin
932	Unfreeze;
933	for i := NbLayers-1 downto 0 do
934	RemoveLayer(i);
935	MemDirectory := nil;
936	ClearOriginals;
937	end;
938
939	procedure TBGRALayeredBitmap.ClearOriginals;
940	var
941	i: Integer;
942	begin
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;
949	end;
950
951	procedure TBGRALayeredBitmap.RemoveLayer(index: integer);
952	var i: integer;
953	begin
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);
960	end;
961
962	procedure TBGRALayeredBitmap.InsertLayer(index: integer; fromIndex: integer);
963	var info: TBGRALayerInfo;
964	i: integer;
965	begin
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;
975	end;
976
977	procedure TBGRALayeredBitmap.Assign(ASource: TBGRACustomLayeredBitmap; ASharedLayerIds: boolean);
978	var 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
986	begin
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;
1039	end;
1040
1041	function TBGRALayeredBitmap.MoveLayerUp(index: integer): integer;
1042	begin
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;
1049	end;
1050
1051	function TBGRALayeredBitmap.MoveLayerDown(index: integer): integer;
1052	begin
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;
1059	end;
1060
1061	function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Opacity: byte
1062	): integer;
1063	begin
1064	result := AddLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity, False);
1065	end;
1066
1067	function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint;
1068	BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer;
1069	begin
1070	result := AddLayer(Source.Caption,Source,Position,BlendOp,Opacity,Shared);
1071	end;
1072
1073	function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap; Position: TPoint;
1074	Opacity: byte): integer;
1075	begin
1076	result := AddLayer(Source,Position,DefaultBlendingOperation,Opacity);
1077	end;
1078
1079	function TBGRALayeredBitmap.AddLayer(Source: TBGRABitmap;
1080	BlendOp: TBlendOperation; Opacity: byte): integer;
1081	begin
1082	result := AddLayer(Source,Point(0,0),BlendOp,Opacity);
1083	end;
1084
1085	function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1086	Opacity: byte): integer;
1087	begin
1088	result := AddLayer(AName,Source,Point(0,0),Opacity);
1089	end;
1090
1091	function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1092	Position: TPoint; BlendOp: TBlendOperation; Opacity: byte; Shared: boolean): integer;
1093	begin
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);
1120	end;
1121
1122	function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1123	Position: TPoint; Opacity: byte): integer;
1124	begin
1125	result := AddLayer(AName, Source, Position, DefaultBlendingOperation, Opacity);
1126	end;
1127
1128	function TBGRALayeredBitmap.AddLayer(AName: string; Source: TBGRABitmap;
1129	BlendOp: TBlendOperation; Opacity: byte): integer;
1130	begin
1131	result := AddLayer(AName, Source, Point(0,0), blendOp, Opacity);
1132	end;
1133
1134	function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap; Opacity: byte
1135	): integer;
1136	begin
1137	result := AddSharedLayer(Source, Point(0,0), DefaultBlendingOperation, Opacity);
1138	end;
1139
1140	function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1141	Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1142	begin
1143	result := AddLayer(Source, Position, BlendOp, Opacity, True);
1144	end;
1145
1146	function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1147	Position: TPoint; Opacity: byte): integer;
1148	begin
1149	result := AddSharedLayer(Source, Position, DefaultBlendingOperation, Opacity);
1150	end;
1151
1152	function TBGRALayeredBitmap.AddSharedLayer(Source: TBGRABitmap;
1153	BlendOp: TBlendOperation; Opacity: byte): integer;
1154	begin
1155	result := AddSharedLayer(Source, Point(0,0), blendOp, Opacity);
1156	end;
1157
1158	function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string; Opacity: byte
1159	): integer;
1160	begin
1161	result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Opacity);
1162	FLayers[result].Name := ExtractFileName(AFilename);
1163	end;
1164
1165	function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1166	Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1167	begin
1168	result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,BlendOp,Opacity);
1169	FLayers[result].Name := ExtractFileName(AFilename);
1170	end;
1171
1172	function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1173	Position: TPoint; Opacity: byte): integer;
1174	begin
1175	result := AddOwnedLayer(TBGRABitmap.Create(AFilename),Position,Opacity);
1176	FLayers[result].Name := ExtractFileName(AFilename);
1177	end;
1178
1179	function TBGRALayeredBitmap.AddLayerFromFile(AFileName: string;
1180	BlendOp: TBlendOperation; Opacity: byte): integer;
1181	begin
1182	result := AddOwnedLayer(TBGRABitmap.Create(AFilename),BlendOp,Opacity);
1183	FLayers[result].Name := ExtractFileName(AFilename);
1184	end;
1185
1186	function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap; Opacity: byte
1187	): integer;
1188	begin
1189	result := AddSharedLayer(ABitmap,Opacity);
1190	FLayers[result].Owner := True;
1191	end;
1192
1193	function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1194	Position: TPoint; BlendOp: TBlendOperation; Opacity: byte): integer;
1195	begin
1196	result := AddSharedLayer(ABitmap,Position,BlendOp,Opacity);
1197	FLayers[result].Owner := True;
1198	end;
1199
1200	function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1201	Position: TPoint; Opacity: byte): integer;
1202	begin
1203	result := AddSharedLayer(ABitmap,Position,Opacity);
1204	FLayers[result].Owner := True;
1205	end;
1206
1207	function TBGRALayeredBitmap.AddOwnedLayer(ABitmap: TBGRABitmap;
1208	BlendOp: TBlendOperation; Opacity: byte): integer;
1209	begin
1210	result := AddSharedLayer(ABitmap,BlendOp,Opacity);
1211	FLayers[result].Owner := True;
1212	end;
1213
1214	function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1215	Opacity: byte): integer;
1216	begin
1217	result := AddLayerFromOriginal(AGuid, DefaultBlendingOperation, Opacity);
1218	end;
1219
1220	function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1221	BlendOp: TBlendOperation; Opacity: byte): integer;
1222	begin
1223	result := AddLayerFromOriginal(AGuid, AffineMatrixIdentity, BlendOp, Opacity);
1224	end;
1225
1226	function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1227	Matrix: TAffineMatrix; Opacity: byte): integer;
1228	begin
1229	result := AddLayerFromOriginal(AGuid, Matrix, DefaultBlendingOperation, Opacity);
1230	end;
1231
1232	function TBGRALayeredBitmap.AddLayerFromOriginal(AGuid: TGuid;
1233	Matrix: TAffineMatrix; BlendOp: TBlendOperation; Opacity: byte): integer;
1234	begin
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');
1240	end;
1241
1242	function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1243	AOriginal: TBGRALayerCustomOriginal; Opacity: byte): integer;
1244	begin
1245	if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1246	result := AddLayerFromOriginal(AOriginal.Guid, Opacity);
1247	end;
1248
1249	function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1250	AOriginal: TBGRALayerCustomOriginal; BlendOp: TBlendOperation; Opacity: byte): integer;
1251	begin
1252	if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1253	result := AddLayerFromOriginal(AOriginal.Guid, BlendOp, Opacity);
1254	end;
1255
1256	function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1257	AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix; Opacity: byte): integer;
1258	begin
1259	if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1260	result := AddLayerFromOriginal(AOriginal.Guid, Matrix, Opacity);
1261	end;
1262
1263	function TBGRALayeredBitmap.AddLayerFromOwnedOriginal(
1264	AOriginal: TBGRALayerCustomOriginal; Matrix: TAffineMatrix;
1265	BlendOp: TBlendOperation; Opacity: byte): integer;
1266	begin
1267	if IndexOfOriginal(AOriginal) = -1 then AddOriginal(AOriginal);
1268	result := AddLayerFromOriginal(AOriginal.Guid, Matrix, BlendOp, Opacity);
1269	end;
1270
1271	function TBGRALayeredBitmap.AddOriginal(AOriginal: TBGRALayerCustomOriginal; AOwned: boolean): integer;
1272	var
1273	newGuid: TGuid;
1274	begin
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));
1308	end;
1309
1310	function TBGRALayeredBitmap.AddOriginalFromStream(AStream: TStream;
1311	ALateLoad: boolean): integer;
1312	var
1313	storage: TBGRAMemOriginalStorage;
1314	begin
1315	storage:= TBGRAMemOriginalStorage.Create;
1316	storage.LoadFromStream(AStream);
1317	try
1318	result := AddOriginalFromStorage(storage, ALateLoad);
1319	finally
1320	storage.Free;
1321	end;
1322	end;
1323
1324	function TBGRALayeredBitmap.AddOriginalFromStorage(AStorage: TBGRAMemOriginalStorage; ALateLoad: boolean): integer;
1325	var
1326	origClassName: String;
1327	origClass: TBGRALayerOriginalAny;
1328	orig: TBGRALayerCustomOriginal;
1329	newGuid: TGuid;
1330	dir, subdir: TMemDirectory;
1331	begin
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;
1363	end;
1364
1365	procedure TBGRALayeredBitmap.SaveOriginalToStream(AIndex: integer;
1366	AStream: TStream);
1367	var
1368	dir: TMemDirectory;
1369	c: TBGRALayerOriginalAny;
1370	begin
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;
1383	end;
1384
1385	procedure TBGRALayeredBitmap.SaveOriginalToStream(AGuid: TGUID; AStream: TStream);
1386	var
1387	idxOrig: Integer;
1388	begin
1389	idxOrig := IndexOfOriginal(AGuid);
1390	if idxOrig = -1 then raise exception.Create('Original not found');
1391	SaveOriginalToStream(idxOrig, AStream);
1392	end;
1393
1394	function TBGRALayeredBitmap.RemoveOriginal(AOriginal: TBGRALayerCustomOriginal): boolean;
1395	var
1396	idx: Integer;
1397	begin
1398	idx := IndexOfOriginal(AOriginal);
1399	if idx = -1 then exit(false);
1400	DeleteOriginal(idx);
1401	result := true;
1402	end;
1403
1404	procedure TBGRALayeredBitmap.DeleteOriginal(AIndex: integer);
1405	var
1406	dir: TMemDirectory;
1407	i: Integer;
1408	guid: TGuid;
1409	begin
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
1426	end;
1427
1428	procedure TBGRALayeredBitmap.NotifyLoaded;
1429	var
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
1448	var
1449	i: Integer;
1450	dir: TMemDirectory;
1451	newGuid: TGUID;
1452
1453	begin
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;
1488	end;
1489
1490	procedure TBGRALayeredBitmap.NotifySaving;
1491	var
1492	i: Integer;
1493	begin
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);
1501	end;
1502
1503	procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1504	ADraft: boolean; AFullSizeLayer: boolean = false);
1505	begin
1506	RenderLayerFromOriginal(layer, ADraft, rectF(0,0,Width,Height), AFullSizeLayer);
1507	end;
1508
1509	procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1510	ADraft: boolean; ARenderBounds: TRect; AFullSizeLayer: boolean = false);
1511	var
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
1524	begin
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;
1581	end;
1582
1583	procedure TBGRALayeredBitmap.RenderLayerFromOriginal(layer: integer;
1584	ADraft: boolean; ARenderBoundsF: TRectF; AFullSizeLayer: boolean = false);
1585	var
1586	r: TRect;
1587	begin
1588	with ARenderBoundsF do
1589	r := Rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
1590	RenderLayerFromOriginal(layer, ADraft, r, AFullSizeLayer);
1591	end;
1592
1593	function 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
1608	var
1609	i: Integer;
1610	r: TRect;
1611
1612	begin
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;
1649	end;
1650
1651	procedure TBGRALayeredBitmap.RemoveUnusedOriginals;
1652	var useCount: array of integer;
1653	i, idxOrig: Integer;
1654	begin
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);
1664	end;
1665
1666	destructor TBGRALayeredBitmap.Destroy;
1667	begin
1668	FOriginalEditor.Free;
1669	inherited Destroy;
1670	end;
1671
1672	constructor TBGRALayeredBitmap.Create;
1673	begin
1674	inherited Create;
1675	FWidth := 0;
1676	FHeight := 0;
1677	FNbLayers:= 0;
1678	FOriginals := nil;
1679	end;
1680
1681	constructor TBGRALayeredBitmap.Create(AWidth, AHeight: integer);
1682	begin
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;
1693	end;
1694
1695	function TBGRALayeredBitmap.GetLayerBitmapCopy(layer: integer): TBGRABitmap;
1696	begin
1697	result := GetLayerBitmapDirectly(layer).Duplicate as TBGRABitmap;
1698	end;
1699
1700	function TBGRALayeredBitmap.GetLayerIndexFromId(AIdentifier: integer): integer;
1701	var i: integer;
1702	begin
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
1710	end;
1711
1712	function TBGRALayeredBitmap.Duplicate(ASharedLayerIds: boolean): TBGRALayeredBitmap;
1713	begin
1714	result := TBGRALayeredBitmap.Create;
1715	result.Assign(self, ASharedLayerIds);
1716	end;
1717
1718	function TBGRALayeredBitmap.ProduceLayerUniqueId: integer;
1719	begin
1720	result := InterLockedIncrement(NextLayerUniqueId);
1721	end;
1722
1723	procedure TBGRALayeredBitmap.RotateCW;
1724	var i: integer;
1725	newBmp: TBGRABitmap;
1726	newOfs: TPointF;
1727	m: TAffineMatrix;
1728	begin
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;
1742	end;
1743
1744	procedure TBGRALayeredBitmap.RotateCCW;
1745	var i: integer;
1746	newBmp: TBGRABitmap;
1747	newOfs: TPointF;
1748	m: TAffineMatrix;
1749	begin
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;
1763	end;
1764
1765	procedure TBGRALayeredBitmap.HorizontalFlip;
1766	var i: integer;
1767	begin
1768	Unfreeze;
1769	for i := 0 to NbLayers-1 do
1770	HorizontalFlip(i);
1771	end;
1772
1773	procedure TBGRALayeredBitmap.HorizontalFlip(ALayerIndex: integer);
1774	begin
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;
1788	end;
1789
1790	procedure TBGRALayeredBitmap.VerticalFlip;
1791	var i: integer;
1792	begin
1793	Unfreeze;
1794	for i := 0 to NbLayers-1 do
1795	VerticalFlip(i);
1796	end;
1797
1798	procedure TBGRALayeredBitmap.VerticalFlip(ALayerIndex: integer);
1799	begin
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;
1813	end;
1814
1815	procedure TBGRALayeredBitmap.Resample(AWidth, AHeight: integer;
1816	AResampleMode: TResampleMode; AFineResampleFilter: TResampleFilter);
1817	var i, prevWidth, prevHeight: integer;
1818	resampled: TBGRABitmap;
1819	oldFilter : TResampleFilter;
1820	begin
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;
1840	end;
1841
1842	procedure TBGRALayeredBitmap.SetLayerBitmap(layer: integer;
1843	ABitmap: TBGRABitmap; AOwned: boolean);
1844	begin
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;
1857	end;
1858
1859	procedure TBGRALayeredBitmap.ApplyLayerOffset(ALayerIndex: integer;
1860	APadWithTranparentPixels: boolean);
1861	var
1862	r: TRect;
1863	newBmp: TBGRABitmap;
1864	begin
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;
1892	end;
1893
1894	function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap;
1895	ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect;
1896	begin
1897	result := DrawEditor(ADest, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
1898	end;
1899
1900	function TBGRALayeredBitmap.DrawEditor(ADest: TBGRABitmap; ALayerIndex: integer;
1901	AMatrix: TAffineMatrix; APointSize: single): TRect;
1902	var
1903	orig: TBGRALayerCustomOriginal;
1904	begin
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)AMatrixAffineMatrixTranslation(0.5,0.5);
1922	FOriginalEditor.Matrix := AffineMatrixTranslation(-0.5,-0.5)AMatrixLayerOriginalMatrix[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;
1927	end;
1928
1929	function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer; X,
1930	Y: Integer; APointSize: single): TRect;
1931	begin
1932	result := GetEditorBounds(ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
1933	end;
1934
1935	function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect;
1936	ALayerIndex: integer; X, Y: Integer; APointSize: single): TRect;
1937	begin
1938	result := GetEditorBounds(ADestRect, ALayerIndex, AffineMatrixTranslation(X,Y), APointSize);
1939	end;
1940
1941	function TBGRALayeredBitmap.GetEditorBounds(ALayerIndex: integer;
1942	AMatrix: TAffineMatrix; APointSize: single): TRect;
1943	begin
1944	result := GetEditorBounds(rect(-maxLongint,-maxLongint,maxLongint,maxLongint), ALayerIndex, AMatrix, APointSize);
1945	end;
1946
1947	function TBGRALayeredBitmap.GetEditorBounds(ADestRect: TRect; ALayerIndex: integer;
1948	AMatrix: TAffineMatrix; APointSize: single): TRect;
1949	var
1950	orig: TBGRALayerCustomOriginal;
1951	begin
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)AMatrixAffineMatrixTranslation(0.5,0.5);
1971	FOriginalEditor.Matrix := AffineMatrixTranslation(-0.5,-0.5)AMatrixLayerOriginalMatrix[ALayerIndex]*AffineMatrixTranslation(0.5,0.5);
1972	FOriginalEditor.PointSize := APointSize;
1973	result := FOriginalEditor.GetRenderBounds(ADestRect);
1974	end else
1975	result := EmptyRect;
1976	end;
1977
1978	procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out
1979	ACursor: TOriginalEditorCursor);
1980	var
1981	handled: boolean;
1982	begin
1983	MouseMove(Shift, ImageX,ImageY, ACursor, handled);
1984	end;
1985
1986	procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean;
1987	Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
1988	var
1989	handled: boolean;
1990	begin
1991	MouseDown(RightButton, Shift, ImageX,ImageY, ACursor, handled);
1992	end;
1993
1994	procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState;
1995	ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor);
1996	var
1997	handled: boolean;
1998	begin
1999	MouseUp(RightButton, Shift, ImageX,ImageY, ACursor, handled);
2000	end;
2001
2002	procedure TBGRALayeredBitmap.MouseMove(Shift: TShiftState; ImageX, ImageY: Single; out
2003	ACursor: TOriginalEditorCursor; out AHandled: boolean);
2004	var
2005	viewPt: TPointF;
2006	begin
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;
2017	end;
2018
2019	procedure TBGRALayeredBitmap.MouseDown(RightButton: boolean;
2020	Shift: TShiftState; ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out
2021	AHandled: boolean);
2022	var
2023	viewPt: TPointF;
2024	begin
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;
2035	end;
2036
2037	procedure TBGRALayeredBitmap.MouseUp(RightButton: boolean; Shift: TShiftState;
2038	ImageX, ImageY: Single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
2039	var
2040	viewPt: TPointF;
2041	begin
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;
2052	end;
2053
2054	procedure TBGRALayeredBitmap.KeyDown(Shift: TShiftState; Key: TSpecialKey; out
2055	AHandled: boolean);
2056	begin
2057	if Assigned(FOriginalEditor) then
2058	FOriginalEditor.KeyDown(Shift, Key, AHandled)
2059	else
2060	AHandled := false;
2061	end;
2062
2063	procedure TBGRALayeredBitmap.KeyUp(Shift: TShiftState; Key: TSpecialKey; out
2064	AHandled: boolean);
2065	begin
2066	if Assigned(FOriginalEditor) then
2067	FOriginalEditor.KeyUp(Shift, Key, AHandled)
2068	else
2069	AHandled := false;
2070	end;
2071
2072	procedure TBGRALayeredBitmap.KeyPress(UTF8Key: string; out AHandled: boolean);
2073	begin
2074	if Assigned(FOriginalEditor) then
2075	FOriginalEditor.KeyPress(UTF8Key, AHandled)
2076	else
2077	AHandled := false;
2078	end;
2079
2080	function TBGRALayeredBitmap.IndexOfOriginal(AGuid: TGuid): integer;
2081	var
2082	i: Integer;
2083	begin
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
2091	end;
2092
2093	function TBGRALayeredBitmap.IndexOfOriginal(AOriginal: TBGRALayerCustomOriginal): integer;
2094	begin
2095	if Assigned(FOriginals) then
2096	result := FOriginals.IndexOf(BGRALayerOriginalEntry(AOriginal))
2097	else
2098	result := -1;
2099	end;
2100
2101	{ TBGRACustomLayeredBitmap }
2102
2103	function TBGRACustomLayeredBitmap.GetLinearBlend: boolean;
2104	begin
2105	result := FLinearBlend;
2106	end;
2107
2108	function TBGRACustomLayeredBitmap.GetMemDirectory: TMemDirectory;
2109	begin
2110	if FMemDirectory = nil then
2111	begin
2112	FMemDirectory:= TMemDirectory.Create;
2113	FMemDirectoryOwned := true;
2114	end;
2115	result := FMemDirectory;
2116	end;
2117
2118	function TBGRACustomLayeredBitmap.GetDefaultBlendingOperation: TBlendOperation;
2119	begin
2120	result := boTransparent;
2121	end;
2122
2123	function TBGRACustomLayeredBitmap.GetHasMemFiles: boolean;
2124	begin
2125	result := assigned(FMemDirectory) and (FMemDirectory.Count > 0);
2126	end;
2127
2128	function TBGRACustomLayeredBitmap.GetLayerOriginalGuid(layer: integer): TGuid;
2129	begin
2130	result := GUID_NULL;
2131	end;
2132
2133	function TBGRACustomLayeredBitmap.GetLayerOriginalRenderStatus(layer: integer): TOriginalRenderStatus;
2134	begin
2135	result := orsProof;
2136	end;
2137
2138	function TBGRACustomLayeredBitmap.GetOriginalCount: integer;
2139	begin
2140	result := 0;
2141	end;
2142
2143	function TBGRACustomLayeredBitmap.GetOriginalByIndex(AIndex: integer): TBGRALayerCustomOriginal;
2144	begin
2145	result := nil;
2146	raise exception.Create('Not implemented');
2147	end;
2148
2149	function TBGRACustomLayeredBitmap.GetOriginalByIndexKnown(AIndex: integer): boolean;
2150	begin
2151	result := true;
2152	end;
2153
2154	function TBGRACustomLayeredBitmap.GetLayerOriginal(layer: integer): TBGRALayerCustomOriginal;
2155	begin
2156	result := nil;
2157	end;
2158
2159	function TBGRACustomLayeredBitmap.GetLayerOriginalKnown(layer: integer): boolean;
2160	begin
2161	result := true;
2162	end;
2163
2164	function TBGRACustomLayeredBitmap.GetLayerOriginalMatrix(layer: integer): TAffineMatrix;
2165	begin
2166	result := AffineMatrixIdentity;
2167	end;
2168
2169	procedure TBGRACustomLayeredBitmap.SetLinearBlend(AValue: boolean);
2170	begin
2171	Unfreeze;
2172	FLinearBlend := AValue;
2173	end;
2174
2175	procedure TBGRACustomLayeredBitmap.SetMemDirectory(AValue: TMemDirectory);
2176	begin
2177	if AValue = FMemDirectory then exit;
2178	if FMemDirectoryOwned then FMemDirectory.Free;
2179	FMemDirectory := AValue;
2180	FMemDirectoryOwned := false;
2181	end;
2182
2183	function TBGRACustomLayeredBitmap.GetLayerName(layer: integer): string;
2184	begin
2185	result := 'Layer' + inttostr(layer+1);
2186	end;
2187
2188	{$hints off}
2189	function TBGRACustomLayeredBitmap.GetLayerOffset(layer: integer): TPoint;
2190	begin
2191	//optional function
2192	result := Point(0,0);
2193	end;
2194	{$hints on}
2195
2196	{$hints off}
2197	function TBGRACustomLayeredBitmap.GetLayerBitmapDirectly(layer: integer
2198	): TBGRABitmap;
2199	begin
2200	//optional function
2201	result:= nil;
2202	end;
2203
2204	function TBGRACustomLayeredBitmap.GetLayerFrozenRange(layer: integer): integer;
2205	var i: integer;
2206	begin
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;
2214	end;
2215
2216	function TBGRACustomLayeredBitmap.GetLayerFrozen(layer: integer): boolean;
2217	var i: integer;
2218	begin
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;
2226	end;
2227
2228	function TBGRACustomLayeredBitmap.GetLayerUniqueId(layer: integer): integer;
2229	begin
2230	result := layer;
2231	end;
2232
2233	procedure TBGRACustomLayeredBitmap.SetLayerFrozen(layer: integer;
2234	AValue: boolean);
2235	begin
2236	//nothing
2237	end;
2238
2239	function TBGRACustomLayeredBitmap.RangeIntersect(first1, last1, first2,
2240	last2: integer): boolean;
2241	begin
2242	result := (first1 <= last2) and (last1 >= first2);
2243	end;
2244
2245	procedure TBGRACustomLayeredBitmap.RemoveFrozenRange(index: integer);
2246	var j,i: integer;
2247	begin
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);
2254	end;
2255
2256	function TBGRACustomLayeredBitmap.ContainsFrozenRange(first, last: integer): boolean;
2257	var i: integer;
2258	begin
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;
2266	end;
2267
2268	function TBGRACustomLayeredBitmap.GetEmpty: boolean;
2269	begin
2270	result := (NbLayers = 0) and (Width = 0) and (Height = 0);
2271	end;
2272
2273	function TBGRACustomLayeredBitmap.IndexOfOriginal(AGuid: TGuid): integer;
2274	begin
2275	result := -1;
2276	end;
2277
2278	function TBGRACustomLayeredBitmap.IndexOfOriginal(
2279	AOriginal: TBGRALayerCustomOriginal): integer;
2280	begin
2281	result := -1;
2282	end;
2283
2284	procedure TBGRACustomLayeredBitmap.SetWidth(Value: Integer);
2285	begin
2286	//nothing
2287	end;
2288
2289	procedure TBGRACustomLayeredBitmap.SetHeight(Value: Integer);
2290	begin
2291	//nothing
2292	end;
2293
2294	function TBGRACustomLayeredBitmap.GetTransparent: Boolean;
2295	begin
2296	result := true;
2297	end;
2298
2299	procedure TBGRACustomLayeredBitmap.SetTransparent(Value: Boolean);
2300	begin
2301	//nothing
2302	end;
2303
2304	procedure TBGRACustomLayeredBitmap.SaveToFile(const filenameUTF8: string);
2305	var bmp: TBGRABitmap;
2306	ext: string;
2307	temp: TBGRALayeredBitmap;
2308	i: integer;
2309	stream: TFileStreamUTF8;
2310	begin
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;
2347	end;
2348
2349	procedure TBGRACustomLayeredBitmap.SaveToStream(Stream: TStream);
2350	begin
2351	if Assigned(LayeredBitmapSaveToStreamProc) then
2352	LayeredBitmapSaveToStreamProc(Stream, self)
2353	else
2354	raise exception.Create('Call BGRAStreamLayers.RegisterStreamLayers first');
2355	end;
2356
2357	procedure TBGRACustomLayeredBitmap.SaveToStreamAs(Stream: TStream;
2358	AExtension: string);
2359	var bmp: TBGRABitmap;
2360	ext: string;
2361	format: TBGRAImageFormat;
2362	temp: TBGRALayeredBitmap;
2363	i: integer;
2364	begin
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;
2388	end;
2389
2390	constructor TBGRACustomLayeredBitmap.Create;
2391	begin
2392	FFrozenRange := nil;
2393	FLinearBlend:= True;
2394	FMemDirectory := nil;
2395	FMemDirectoryOwned:= false;
2396	end;
2397
2398	{$hints on}
2399
2400	function TBGRACustomLayeredBitmap.ToString: ansistring;
2401	var
2402	i: integer;
2403	begin
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;
2409	end;
2410
2411	function TBGRACustomLayeredBitmap.ComputeFlatImage(ASeparateXorMask: boolean): TBGRABitmap;
2412	begin
2413	result := ComputeFlatImage(rect(0,0,Width,Height), 0, NbLayers - 1, ASeparateXorMask);
2414	end;
2415
2416	function TBGRACustomLayeredBitmap.ComputeFlatImage(firstLayer,
2417	lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap;
2418	begin
2419	result := ComputeFlatImage(rect(0,0,Width,Height), firstLayer,LastLayer,ASeparateXorMask);
2420	end;
2421
2422	function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect;
2423	ASeparateXorMask: boolean): TBGRABitmap;
2424	begin
2425	result := ComputeFlatImage(ARect,0, NbLayers - 1, ASeparateXorMask);
2426	end;
2427
2428	destructor TBGRACustomLayeredBitmap.Destroy;
2429	begin
2430	Clear;
2431	end;
2432
2433	function TBGRACustomLayeredBitmap.ComputeFlatImage(ARect: TRect; firstLayer, lastLayer: integer; ASeparateXorMask: boolean): TBGRABitmap;
2434	var
2435	tempLayer: TBGRABitmap;
2436	i,j: integer;
2437	mustFreeCopy: boolean;
2438	op: TBlendOperation;
2439	begin
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);
2505	end;
2506
2507	procedure TBGRACustomLayeredBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
2508	var temp: TBGRABitmap;
2509	begin
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;
2519	end;
2520
2521	procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer);
2522	begin
2523	Draw(Canvas,x,y,0,NbLayers-1);
2524	end;
2525
2526	procedure TBGRACustomLayeredBitmap.Draw(Canvas: TCanvas; x, y: integer; firstLayer, lastLayer: integer);
2527	var temp: TBGRABitmap;
2528	begin
2529	temp := ComputeFlatImage(firstLayer,lastLayer);
2530	temp.Draw(Canvas,x,y,False);
2531	temp.Free;
2532	end;
2533
2534	procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer);
2535	begin
2536	Draw(Dest,x,y,0,NbLayers-1);
2537	end;
2538
2539	procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; x, y: integer;
2540	ASeparateXorMask: boolean);
2541	begin
2542	Draw(Dest,x,y,0,NbLayers-1,ASeparateXorMask);
2543	end;
2544
2545	procedure TBGRACustomLayeredBitmap.Draw(Dest: TBGRABitmap; AX, AY: integer; firstLayer, lastLayer: integer; ASeparateXorMask: boolean);
2546	var
2547	temp: TBGRABitmap;
2548	i,j: integer;
2549	tempLayer: TBGRABitmap;
2550	mustFreeCopy: boolean;
2551	OldClipRect: TRect;
2552	NewClipRect: TRect;
2553	begin
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;
2610	end;
2611
2612	procedure TBGRACustomLayeredBitmap.FreezeExceptOneLayer(layer: integer);
2613	begin
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);
2624	end;
2625
2626	procedure 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
2654	var j: integer;
2655	start: integer;
2656	linear,nextLinear: boolean;
2657	begin
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);
2687	end;
2688
2689	procedure TBGRACustomLayeredBitmap.Freeze;
2690	begin
2691	Freeze(0,NbLayers-1);
2692	end;
2693
2694	procedure TBGRACustomLayeredBitmap.Unfreeze;
2695	begin
2696	Unfreeze(0,NbLayers-1);
2697	end;
2698
2699	procedure TBGRACustomLayeredBitmap.Unfreeze(layer: integer);
2700	begin
2701	Unfreeze(layer,layer);
2702	end;
2703
2704	procedure TBGRACustomLayeredBitmap.Unfreeze(firstLayer, lastLayer: integer);
2705	var i: integer;
2706	begin
2707	for i := high(FFrozenRange) downto 0 do
2708	if RangeIntersect(firstLayer,lastLayer,FFrozenRange[i].firstLayer,FFrozenRange[i].lastLayer) then
2709	RemoveFrozenRange(i);
2710	end;
2711
2712	procedure TBGRACustomLayeredBitmap.NotifyLoaded;
2713	begin
2714	//nothing
2715	end;
2716
2717	procedure TBGRACustomLayeredBitmap.NotifySaving;
2718	begin
2719	//nothing
2720	end;
2721
2722	procedure RegisterLayeredBitmapReader(AExtensionUTF8: string; AReader: TBGRACustomLayeredBitmapClass);
2723	begin
2724	setlength(LayeredBitmapReaders,length(LayeredBitmapReaders)+1);
2725	with LayeredBitmapReaders[high(LayeredBitmapReaders)] do
2726	begin
2727	extension:= UTF8LowerCase(AExtensionUTF8);
2728	theClass := AReader;
2729	end;
2730	end;
2731
2732	function TryCreateLayeredBitmapWriter(AExtensionUTF8: string): TBGRALayeredBitmap;
2733	var
2734	i: Integer;
2735	begin
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;
2746	end;
2747
2748	function TryCreateLayeredBitmapReader(AExtensionUTF8: string): TBGRACustomLayeredBitmap;
2749	var
2750	i: Integer;
2751	begin
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;
2762	end;
2763
2764	procedure OnLayeredBitmapLoadFromStreamStart;
2765	begin
2766	OnLayeredBitmapLoadStart('<Stream>');
2767	end;
2768
2769	procedure OnLayeredBitmapLoadStart(AFilenameUTF8: string);
2770	begin
2771	if Assigned(OnLayeredBitmapLoadStartProc) then
2772	OnLayeredBitmapLoadStartProc(AFilenameUTF8);
2773	end;
2774
2775	procedure OnLayeredBitmapLoadProgress(APercentage: integer);
2776	begin
2777	if Assigned(OnLayeredBitmapLoadProgressProc) then
2778	OnLayeredBitmapLoadProgressProc(APercentage);
2779	end;
2780
2781	procedure OnLayeredBitmapLoaded;
2782	begin
2783	if Assigned(OnLayeredBitmapLoadedProc) then
2784	OnLayeredBitmapLoadedProc();
2785	end;
2786
2787	procedure RegisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
2788	AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc
2789	);
2790	begin
2791	OnLayeredBitmapLoadProgressProc:= AProgress;
2792	OnLayeredBitmapLoadStartProc := AStart;
2793	OnLayeredBitmapLoadedProc:= ADone;
2794	end;
2795
2796	procedure UnregisterLoadingHandler(AStart: TOnLayeredBitmapLoadStartProc;
2797	AProgress: TOnLayeredBitmapLoadProgressProc; ADone: TOnLayeredBitmapLoadedProc);
2798	begin
2799	if OnLayeredBitmapLoadProgressProc = AProgress then OnLayeredBitmapLoadProgressProc := nil;
2800	if OnLayeredBitmapLoadStartProc = AStart then OnLayeredBitmapLoadStartProc := nil;
2801	if OnLayeredBitmapLoadedProc = ADone then OnLayeredBitmapLoadedProc := nil;
2802	end;
2803
2804	procedure RegisterLayeredBitmapWriter(AExtensionUTF8: string; AWriter: TBGRALayeredBitmapClass);
2805	begin
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;
2813	end;
2814
2815	initialization
2816
2817	NextLayerUniqueId := 1;
2818
2819	end.
2820

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/Packages/bgrabitmap/bgralayers.pas

Download in other formats: