1 // SPDX-License-Identifier: LGPL-3.0-linking-exception
2 unit BGRALayerOriginal;
3 
4 {$mode objfpc}{$H+}
5 {$i bgrabitmap.inc}
6 
7 interface
8 
9 uses
10   BGRAClasses, SysUtils, BGRABitmap, BGRABitmapTypes, BGRATransform, BGRAMemDirectory, fgl
11   {$IFDEF BGRABITMAP_USE_LCL},LCLType{$ENDIF};
12 
13 type
14   PRectF = BGRABitmapTypes.PRectF;
15   TAffineMatrix = BGRATransform.TAffineMatrix;
16   TBGRALayerCustomOriginal = class;
17   TBGRAOriginalDiff = class;
18   TBGRALayerOriginalAny = class of TBGRALayerCustomOriginal;
19   TOriginalMovePointEvent = procedure(ASender: TObject; APrevCoord, ANewCoord: TPointF; AShift: TShiftState) of object;
20   TOriginalStartMovePointEvent = procedure(ASender: TObject; AIndex: integer; AShift: TShiftState) of object;
21   TOriginalClickPointEvent = procedure(ASender: TObject; AIndex: integer; AShift: TShiftState) of object;
22   TOriginalHoverPointEvent = procedure(ASender: TObject; AIndex: integer) of object;
23   TOriginalChangeEvent = procedure(ASender: TObject; ABounds: PRectF; var ADiff: TBGRAOriginalDiff) of object;
24   TOriginalEditingChangeEvent = procedure(ASender: TObject) of object;
25   TOriginalEditorCursor = (oecDefault, oecMove, oecMoveW, oecMoveE, oecMoveN, oecMoveS,
26                            oecMoveNE, oecMoveSW, oecMoveNW, oecMoveSE, oecHandPoint, oecText);
27   TSpecialKey = (skUnknown, skBackspace, skTab, skReturn, skEscape,
28                  skPageUp, skPageDown, skHome, skEnd,
29                  skLeft, skUp, skRight, skDown,
30                  skInsert, skDelete,
31                  skNum0, skNum1, skNum2, skNum3, skNum4, skNum5, skNum6, skNum7, skNum8, skNum9,
32                  skF1, skF2, skF3, skF4, skF5, skF6, skF7, skF8, skF9, skF10, skF11, skF12,
33                  skA, skB, skC, skD, skE, skF, skG, skH, skI, skJ, skK, skL, skM, skN, skO, skP, skQ, skR, skS, skT, skU, skV, skW, skX, skY, skZ,
34                  sk0, sk1, sk2, sk3, sk4, sk5, sk6, sk7, sk8, sk9,
35                  skShift, skCtrl, skAlt);
36 
37 const
38   SpecialKeyStr: array[TSpecialKey] of string =
39     ('Unknown', 'Backspace', 'Tab', 'Return', 'Escape',
40      'PageUp', 'PageDown', 'Home', 'End',
41      'Left', 'Up', 'Right', 'Down',
42      'Insert', 'Delete',
43      'Num0', 'Num1', 'Num2', 'Num3', 'Num4', 'Num5', 'Num6', 'Num7', 'Num8', 'Num9',
44      'F1', 'F2', 'F3', 'F4', 'F5', 'F6', 'F7', 'F8', 'F9', 'F10', 'F11', 'F12',
45      'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z',
46      '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
47      'Shift', 'Ctrl', 'Alt');
48 
49 {$IFDEF BGRABITMAP_USE_LCL}
50 const
51   SpecialKeyToLCL: array[TSpecialKey] of Word =
52     (VK_UNKNOWN, VK_BACK,VK_TAB,VK_RETURN,VK_ESCAPE,
53      VK_PRIOR,VK_NEXT,VK_HOME,VK_END,
54      VK_LEFT,VK_UP,VK_RIGHT,VK_DOWN,
55      VK_INSERT,VK_DELETE,
56      VK_NUMPAD0,VK_NUMPAD1,VK_NUMPAD2,VK_NUMPAD3,VK_NUMPAD4,VK_NUMPAD5,VK_NUMPAD6,VK_NUMPAD7,VK_NUMPAD8,VK_NUMPAD9,
57      VK_F1,VK_F2,VK_F3,VK_F4,VK_F5,VK_F6,VK_F7,VK_F8,VK_F9,VK_F10,VK_F11,VK_F12,
58      VK_A, VK_B, VK_C, VK_D, VK_E, VK_F, VK_G, VK_H, VK_I, VK_J, VK_K, VK_L, VK_M, VK_N, VK_O, VK_P, VK_Q, VK_R, VK_S, VK_T, VK_U, VK_V, VK_W, VK_X, VK_Y, VK_Z,
59      VK_0, VK_1, VK_2, VK_3, VK_4, VK_5, VK_6, VK_7, VK_8, VK_9,
60      VK_SHIFT, VK_CONTROL, VK_MENU);
61 
LCLKeyToSpecialKeynull62   function LCLKeyToSpecialKey(AKey: Word; AShift: TShiftState): TSpecialKey;
63 {$ENDIF}
64 
65 type
66   TStartMoveHandlers = specialize TFPGList<TOriginalStartMovePointEvent>;
67   TClickPointHandlers = specialize TFPGList<TOriginalClickPointEvent>;
68   THoverPointHandlers = specialize TFPGList<TOriginalHoverPointEvent>;
69   TBGRAOriginalPolylineStyle = (opsNone, opsSolid, opsDash, opsDashWithShadow);
70 
71   { TBGRAOriginalEditor }
72 
73   TBGRAOriginalEditor = class
74   private
75     FFocused: boolean;
76     FOnFocusChanged: TNotifyEvent;
GetIsMovingPointnull77     function GetIsMovingPoint: boolean;
GetPointCoordnull78     function GetPointCoord(AIndex: integer): TPointF;
GetPointCountnull79     function GetPointCount: integer;
GetPointHighlightednull80     function GetPointHighlighted(AIndex: integer): boolean;
81     procedure SetFocused(AValue: boolean);
82     procedure SetPointHighlighted(AIndex: integer; AValue: boolean);
83   protected
84     FMatrix,FMatrixInverse: TAffineMatrix;          //view matrix from original coord
85     FGridMatrix,FGridMatrixInverse: TAffineMatrix;  //grid matrix in original coord
86     FGridActive: boolean;
87     FPoints: array of record
88       Origin, Coord: TPointF;
89       OnMove, OnAlternateMove: TOriginalMovePointEvent;
90       RightButton, Highlighted: boolean;
91       SnapToPoint: integer;
92       HitBox: TAffineBox;
93     end;
94     FPolylines: array of record
95       Coords: array of TPointF;
96       Closed: boolean;
97       Style: TBGRAOriginalPolylineStyle;
98       BackColor: TBGRAPixel;
99     end;
100     FPointSize: single;
101     FPointMoving: integer;
102     FPointWasMoved: boolean;
103     FPointCoordDelta: TPointF;
104     FMovingRightButton: boolean;
105     FPrevMousePos: TPointF;
106     FStartMoveHandlers: TStartMoveHandlers;
107     FCurHoverPoint: integer;
108     FHoverPointHandlers: THoverPointHandlers;
109     FClickPointHandlers: TClickPointHandlers;
RenderPointnull110     function RenderPoint(ADest: TBGRABitmap; ACoord: TPointF; AAlternateColor: boolean; AHighlighted: boolean): TRect; virtual;
GetRenderPointBoundsnull111     function GetRenderPointBounds(ACoord: TPointF; AHighlighted: boolean): TRect; virtual;
RenderArrownull112     function RenderArrow(ADest: TBGRABitmap; AOrigin, AEndCoord: TPointF): TRect; virtual;
GetRenderArrowBoundsnull113     function GetRenderArrowBounds(AOrigin, AEndCoord: TPointF): TRect; virtual;
RenderPolygonnull114     function RenderPolygon(ADest: TBGRABitmap; ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): TRect; virtual;
GetRenderPolygonBoundsnull115     function GetRenderPolygonBounds(ACoords: array of TPointF): TRect;
116     procedure SetMatrix(AValue: TAffineMatrix);
117     procedure SetGridMatrix(AValue: TAffineMatrix);
118     procedure SetGridActive(AValue: boolean);
GetMoveCursornull119     function GetMoveCursor(APointIndex: integer): TOriginalEditorCursor; virtual;
GetFixedShiftForButtonnull120     function GetFixedShiftForButton(AShift: TShiftState; ARightDown: boolean): TShiftState;
121   public
122     constructor Create;
123     destructor Destroy; override;
124     procedure Clear; virtual;
125     procedure AddStartMoveHandler(AOnStartMove: TOriginalStartMovePointEvent);
126     procedure AddClickPointHandler(AOnClickPoint: TOriginalClickPointEvent);
127     procedure AddHoverPointHandler(AOnHoverPoint: TOriginalHoverPointEvent);
AddPointnull128     function AddPoint(const ACoord: TPointF; AOnMove: TOriginalMovePointEvent; ARightButton: boolean = false; ASnapToPoint: integer = -1): integer;
129     procedure AddPointAlternateMove(AIndex: integer; AOnAlternateMove: TOriginalMovePointEvent);
AddFixedPointnull130     function AddFixedPoint(const ACoord: TPointF; ARightButton: boolean = false): integer;
AddArrownull131     function AddArrow(const AOrigin, AEndCoord: TPointF; AOnMoveEnd: TOriginalMovePointEvent; ARightButton: boolean = false): integer;
AddPolylinenull132     function AddPolyline(const ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle): integer; overload;
AddPolylinenull133     function AddPolyline(const ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): integer; overload;
134     procedure SetHitBox(AIndex: integer; AHitBox: TAffineBox);
135     procedure MouseMove(Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual;
136     procedure MouseDown(RightButton: boolean; Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual;
137     procedure MouseUp(RightButton: boolean; {%H-}Shift: TShiftState; {%H-}ViewX, {%H-}ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean); virtual;
138     procedure KeyDown({%H-}Shift: TShiftState; {%H-}Key: TSpecialKey; out AHandled: boolean); virtual;
139     procedure KeyUp({%H-}Shift: TShiftState; {%H-}Key: TSpecialKey; out AHandled: boolean); virtual;
140     procedure KeyPress({%H-}UTF8Key: string; out AHandled: boolean); virtual;
GetPointAtnull141     function GetPointAt(const ACoord: TPointF; ARightButton: boolean): integer;
Rendernull142     function Render(ADest: TBGRABitmap; const {%H-}ALayoutRect: TRect): TRect; virtual;
GetRenderBoundsnull143     function GetRenderBounds(const {%H-}ALayoutRect: TRect): TRect; virtual;
SnapToGridnull144     function SnapToGrid(const ACoord: TPointF; AIsViewCoord: boolean): TPointF;
OriginalCoordToViewnull145     function OriginalCoordToView(const AImageCoord: TPointF): TPointF;
ViewCoordToOriginalnull146     function ViewCoordToOriginal(const AViewCoord: TPointF): TPointF;
147     property Matrix: TAffineMatrix read FMatrix write SetMatrix;
148     property GridMatrix: TAffineMatrix read FGridMatrix write SetGridMatrix;
149     property GridActive: boolean read FGridActive write SetGridActive;
150     property Focused: boolean read FFocused write SetFocused;
151     property PointSize: single read FPointSize write FPointSize;
152     property PointCount: integer read GetPointCount;
153     property PointCoord[AIndex: integer]: TPointF read GetPointCoord;
154     property PointHighlighted[AIndex: integer]: boolean read GetPointHighlighted write SetPointHighlighted;
155     property OnFocusChanged: TNotifyEvent read FOnFocusChanged write FOnFocusChanged;
156     property IsMovingPoint: boolean read GetIsMovingPoint;
157   end;
158 
159   TBGRACustomOriginalStorage = class;
160   ArrayOfSingle = array of single;
161 
162   TBGRAOriginalDiff = class
163     procedure Apply(AOriginal: TBGRALayerCustomOriginal); virtual; abstract;
164     procedure Unapply(AOriginal: TBGRALayerCustomOriginal); virtual; abstract;
CanAppendnull165     function CanAppend(ADiff: TBGRAOriginalDiff): boolean; virtual; abstract;
166     procedure Append(ADiff: TBGRAOriginalDiff); virtual; abstract;
IsIdentitynull167     function IsIdentity: boolean; virtual; abstract;
168   end;
169 
170   { TBGRALayerCustomOriginal }
171 
172   TBGRALayerCustomOriginal = class
173   private
174     FOnChange: TOriginalChangeEvent;
175     FOnEditingChange: TOriginalEditingChangeEvent;
176     FRenderStorage: TBGRACustomOriginalStorage;
GetDiffExpectednull177     function GetDiffExpected: boolean;
178     procedure SetOnChange(AValue: TOriginalChangeEvent);
179     procedure SetRenderStorage(AValue: TBGRACustomOriginalStorage);
180   protected
181     FGuid: TGuid;
GetGuidnull182     function GetGuid: TGuid;
183     procedure SetGuid(AValue: TGuid);
184     procedure NotifyChange(ADiff: TBGRAOriginalDiff = nil); overload;
185     procedure NotifyChange(ABounds: TRectF; ADiff: TBGRAOriginalDiff = nil); overload;
186     procedure NotifyEditorChange;
187     property DiffExpected: boolean read GetDiffExpected;
188   public
189     constructor Create; virtual;
190     destructor Destroy; override;
191     //one of the two Render functions must be overriden
192     procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); virtual;
193     procedure Render(ADest: TBGRABitmap; ARenderOffset: TPoint; AMatrix: TAffineMatrix; ADraft: boolean); virtual;
GetRenderBoundsnull194     function GetRenderBounds(ADestRect: TRect; AMatrix: TAffineMatrix): TRect; virtual; abstract;
195     procedure ConfigureEditor({%H-}AEditor: TBGRAOriginalEditor); virtual;
196     procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); virtual; abstract;
197     procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); virtual; abstract;
198     procedure LoadFromFile(AFilenameUTF8: string); virtual;
199     procedure LoadFromStream(AStream: TStream); virtual;
200     procedure LoadFromResource(AFilename: string);
201     procedure SaveToFile(AFilenameUTF8: string); virtual;
202     procedure SaveToStream(AStream: TStream); virtual;
CreateEditornull203     function CreateEditor: TBGRAOriginalEditor; virtual;
StorageClassNamenull204     class function StorageClassName: RawByteString; virtual; abstract;
CanConvertToSVGnull205     class function CanConvertToSVG: boolean; virtual;
IsInfiniteSurfacenull206     function IsInfiniteSurface: boolean; virtual;
ConvertToSVGnull207     function ConvertToSVG(const {%H-}AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; virtual;
Duplicatenull208     function Duplicate: TBGRALayerCustomOriginal; virtual;
209     property Guid: TGuid read GetGuid write SetGuid;
210     property OnChange: TOriginalChangeEvent read FOnChange write SetOnChange;
211     property OnEditingChange: TOriginalEditingChangeEvent read FOnEditingChange write FOnEditingChange;
212     property RenderStorage: TBGRACustomOriginalStorage read FRenderStorage write SetRenderStorage;
213   end;
214 
215   TBGRALayerImageOriginal = class;
216 
217   { TBGRAImageOriginalDiff }
218 
219   TBGRAImageOriginalDiff = class(TBGRAOriginalDiff)
220   protected
221     FContentVersionBefore,FContentVersionAfter: integer;
222     FImageBefore,FImageAfter: TBGRABitmap;
223     FJpegStreamBefore,FJpegStreamAfter: TMemoryStream;
224   public
225     constructor Create(AFromOriginal: TBGRALayerImageOriginal);
226     destructor Destroy; override;
227     procedure ComputeDiff(AToOriginal: TBGRALayerImageOriginal);
228     procedure Apply(AOriginal: TBGRALayerCustomOriginal); override;
229     procedure Unapply(AOriginal: TBGRALayerCustomOriginal); override;
CanAppendnull230     function CanAppend(ADiff: TBGRAOriginalDiff): boolean; override;
231     procedure Append(ADiff: TBGRAOriginalDiff); override;
IsIdentitynull232     function IsIdentity: boolean; override;
233   end;
234 
235   { TBGRALayerImageOriginal }
236 
237   TBGRALayerImageOriginal = class(TBGRALayerCustomOriginal)
238   private
GetImageHeightnull239     function GetImageHeight: integer;
GetImageWidthnull240     function GetImageWidth: integer;
241   protected
242     FImage: TBGRABitmap;
243     FJpegStream: TMemoryStream;
244     FContentVersion: integer;
245     FDiff: TBGRAImageOriginalDiff;
246     procedure BeginUpdate;
247     procedure EndUpdate;
248     procedure InternalLoadImageFromStream(AStream: TStream; AUpdate: boolean);
249     procedure InternalClear;
250   public
251     constructor Create; override;
252     destructor Destroy; override;
ConvertToSVGnull253     function ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject; override;
254     procedure Render(ADest: TBGRABitmap; AMatrix: TAffineMatrix; ADraft: boolean); override;
GetRenderBoundsnull255     function GetRenderBounds({%H-}ADestRect: TRect; AMatrix: TAffineMatrix): TRect; override;
256     procedure LoadFromStorage(AStorage: TBGRACustomOriginalStorage); override;
257     procedure SaveToStorage(AStorage: TBGRACustomOriginalStorage); override;
258     procedure LoadFromStream(AStream: TStream); override;
259     procedure Clear;
260     procedure LoadImageFromStream(AStream: TStream);
261     procedure SaveImageToStream(AStream: TStream);
262     procedure AssignImage(AImage: TBGRACustomBitmap);
GetImageCopynull263     function GetImageCopy: TBGRABitmap;
StorageClassNamenull264     class function StorageClassName: RawByteString; override;
CanConvertToSVGnull265     class function CanConvertToSVG: boolean; override;
266     property Width: integer read GetImageWidth;
267     property Height: integer read GetImageHeight;
268   end;
269 
270   { TBGRACustomOriginalStorage }
271 
272   TBGRACustomOriginalStorage = class
273   protected
274     FFormats: TFormatSettings;
GetBoolnull275     function GetBool(AName: utf8string): boolean;
GetBoolDefnull276     function GetBoolDef(AName: utf8string; ADefault: boolean): boolean;
GetColorArraynull277     function GetColorArray(AName: UTF8String): ArrayOfTBGRAPixel;
GetIntegernull278     function GetInteger(AName: utf8string): integer;
GetIntegerDefnull279     function GetIntegerDef(AName: utf8string; ADefault: integer): integer;
GetPointFnull280     function GetPointF(AName: utf8string): TPointF;
GetRectFnull281     function GetRectF(AName: utf8string): TRectF;
GetRectnull282     function GetRect(AName: utf8string): TRect;
GetAffineMatrixnull283     function GetAffineMatrix(AName: utf8string): TAffineMatrix;
GetRawStringnull284     function GetRawString(AName: utf8string): RawByteString; virtual; abstract;
GetSinglenull285     function GetSingle(AName: utf8string): single;
GetSingleArraynull286     function GetSingleArray(AName: utf8string): ArrayOfSingle;
GetSingleDefnull287     function GetSingleDef(AName: utf8string; ADefault: single): single;
GetColornull288     function GetColor(AName: UTF8String): TBGRAPixel;
289     procedure SetBool(AName: utf8string; AValue: boolean);
290     procedure SetColorArray(AName: UTF8String; AValue: ArrayOfTBGRAPixel);
291     procedure SetInteger(AName: utf8string; AValue: integer);
292     procedure SetPointF(AName: utf8string; AValue: TPointF);
293     procedure SetRectF(AName: utf8string; AValue: TRectF);
294     procedure SetRect(AName: utf8string; AValue: TRect);
295     procedure SetAffineMatrix(AName: utf8string; const AValue: TAffineMatrix);
296     procedure SetRawString(AName: utf8string; AValue: RawByteString); virtual; abstract;
297     procedure SetSingle(AName: utf8string; AValue: single);
298     procedure SetSingleArray(AName: utf8string; AValue: ArrayOfSingle);
299     procedure SetColor(AName: UTF8String; AValue: TBGRAPixel);
GetDelimiternull300     function GetDelimiter: char;
GetEmptynull301     function GetEmpty: boolean; virtual; abstract;
302   public
303     constructor Create;
Duplicatenull304     function Duplicate: TBGRACustomOriginalStorage; virtual; abstract;
305     procedure RemoveAttribute(AName: utf8string); virtual; abstract;
HasAttributenull306     function HasAttribute(AName: utf8string): boolean; virtual; abstract;
307     procedure RemoveObject(AName: utf8string); virtual; abstract;
CreateObjectnull308     function CreateObject(AName: utf8string): TBGRACustomOriginalStorage; virtual; abstract;
OpenObjectnull309     function OpenObject(AName: utf8string): TBGRACustomOriginalStorage; virtual; abstract;
ObjectExistsnull310     function ObjectExists(AName: utf8string): boolean; virtual; abstract;
311     procedure EnumerateObjects(AList: TStringList); virtual; abstract;
312     procedure EnumerateFiles(AList: TStringList); virtual; abstract;
313     procedure RemoveFile(AName: utf8string); virtual; abstract;
GetFileStreamnull314     function GetFileStream(AName: UTF8String): TStream; virtual; abstract;
ReadFilenull315     function ReadFile(AName: UTF8String; ADest: TStream): boolean; virtual; abstract;
ReadBitmapnull316     function ReadBitmap(AName: UTF8String; ADest: TCustomUniversalBitmap): boolean; virtual; abstract;
317     procedure WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean = false); virtual; abstract;
FileExistsnull318     function FileExists(AName: UTF8String): boolean; virtual; abstract;
FloatEqualsnull319     function FloatEquals(AName: utf8string; AValue: single): boolean;
PointFEqualsnull320     function PointFEquals(AName: utf8string; const AValue: TPointF): boolean;
AffineMatrixEqualsnull321     function AffineMatrixEquals(AName: utf8string; const AValue: TAffineMatrix): boolean;
322     property RawString[AName: utf8string]: RawByteString read GetRawString write SetRawString;
323     property Int[AName: utf8string]: integer read GetInteger write SetInteger;
324     property IntDef[AName: utf8string; ADefault: integer]: integer read GetIntegerDef;
325     property Bool[AName: utf8string]: boolean read GetBool write SetBool;
326     property BoolDef[AName: utf8string; ADefault: boolean]: boolean read GetBoolDef;
327     property Float[AName: utf8string]: single read GetSingle write SetSingle;
328     property FloatArray[AName: utf8string]: ArrayOfSingle read GetSingleArray write SetSingleArray;
329     property FloatDef[AName: utf8string; ADefault: single]: single read GetSingleDef;
330     property PointF[AName: utf8string]: TPointF read GetPointF write SetPointF;
331     property RectangleF[AName: utf8string]: TRectF read GetRectF write SetRectF;
332     property Rectangle[AName: utf8string]: TRect read GetRect write SetRect;
333     property AffineMatrix[AName: utf8string]: TAffineMatrix read GetAffineMatrix write SetAffineMatrix;
334     property Color[AName: UTF8String]: TBGRAPixel read GetColor write SetColor;
335     property ColorArray[AName: UTF8String]: ArrayOfTBGRAPixel read GetColorArray write SetColorArray;
336     property Empty: boolean read GetEmpty;
337   end;
338 
339   { TBGRAMemOriginalStorage }
340 
341   TBGRAMemOriginalStorage = class(TBGRACustomOriginalStorage)
342   protected
343     FMemDir: TMemDirectory;
344     FMemDirOwned: boolean;
GetRawStringnull345     function GetRawString(AName: utf8string): RawByteString; override;
346     procedure SetRawString(AName: utf8string; AValue: RawByteString); override;
GetEmptynull347     function GetEmpty: boolean; override;
348   public
349     destructor Destroy; override;
350     constructor Create;
351     constructor Create(AMemDir: TMemDirectory; AMemDirOwned: boolean = false);
Equalsnull352     function Equals(Obj: TObject): boolean; override;
Duplicatenull353     function Duplicate: TBGRACustomOriginalStorage; override;
354     procedure RemoveAttribute(AName: utf8string); override;
HasAttributenull355     function HasAttribute(AName: utf8string): boolean; override;
356     procedure RemoveObject(AName: utf8string); override;
CreateObjectnull357     function CreateObject(AName: utf8string): TBGRACustomOriginalStorage; override;
OpenObjectnull358     function OpenObject(AName: utf8string): TBGRACustomOriginalStorage; override;
ObjectExistsnull359     function ObjectExists(AName: utf8string): boolean; override;
360     procedure EnumerateObjects(AList: TStringList); override;
361     procedure EnumerateFiles(AList: TStringList); override;
362     procedure RemoveFile(AName: utf8string); override;
GetFileStreamnull363     function GetFileStream(AName: UTF8String): TStream; override;
ReadBitmapnull364     function ReadBitmap(AName: UTF8String; ADest: TCustomUniversalBitmap): boolean; override;
ReadFilenull365     function ReadFile(AName: UTF8String; ADest: TStream): boolean; override;
366     procedure WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean = false); override;
FileExistsnull367     function FileExists(AName: UTF8String): boolean; override;
368     procedure SaveToStream(AStream: TStream);
369     procedure LoadFromStream(AStream: TStream);
370     procedure LoadFromResource(AFilename: string);
371     procedure CopyTo(AMemDir: TMemDirectory);
372   end;
373 
374 procedure RegisterLayerOriginal(AClass: TBGRALayerOriginalAny);
FindLayerOriginalClassnull375 function FindLayerOriginalClass(AStorageClassName: string): TBGRALayerOriginalAny;
376 
377 implementation
378 
379 uses BGRAPolygon, math, BGRAMultiFileType, BGRAUTF8, BGRAGraphics, BGRASVG, BGRASVGShapes;
380 
381 {$IFDEF BGRABITMAP_USE_LCL}
LCLKeyToSpecialKeynull382 function LCLKeyToSpecialKey(AKey: Word; AShift: TShiftState): TSpecialKey;
383 var
384   sk: TSpecialKey;
385 begin
386   if (((AKey >= VK_A) and (AKey <= VK_Z)) or
387      ((AKey >= VK_0) and (AKey <= VK_9))) and (AShift*[ssCtrl,ssAlt]=[]) then exit(skUnknown);
388   for sk := low(TSpecialKey) to high(TSpecialKey) do
389     if AKey = SpecialKeyToLCL[sk] then exit(sk);
390   exit(skUnknown);
391 end;
392 {$ENDIF}
393 
394 var
395   LayerOriginalClasses: array of TBGRALayerOriginalAny;
396 
397 procedure RegisterLayerOriginal(AClass: TBGRALayerOriginalAny);
398 begin
399   setlength(LayerOriginalClasses, length(LayerOriginalClasses)+1);
400   LayerOriginalClasses[high(LayerOriginalClasses)] := AClass;
401 end;
402 
FindLayerOriginalClassnull403 function FindLayerOriginalClass(AStorageClassName: string): TBGRALayerOriginalAny;
404 var
405   i: Integer;
406 begin
407   for i := 0 to high(LayerOriginalClasses) do
408     if LayerOriginalClasses[i].StorageClassName = AStorageClassName then
409       exit(LayerOriginalClasses[i]);
410   exit(nil);
411 end;
412 
413 { TBGRAImageOriginalDiff }
414 
415 constructor TBGRAImageOriginalDiff.Create(AFromOriginal: TBGRALayerImageOriginal);
416 begin
417   FImageBefore := AFromOriginal.FImage.NewReference;
418   if Assigned(AFromOriginal.FJpegStream) then
419   begin
420     FJpegStreamBefore := TMemoryStream.Create;
421     AFromOriginal.FJpegStream.Position:= 0;
422     FJpegStreamBefore.CopyFrom(AFromOriginal.FJpegStream, AFromOriginal.FJpegStream.Size);
423   end;
424   FContentVersionBefore:= AFromOriginal.FContentVersion;
425 end;
426 
427 procedure TBGRAImageOriginalDiff.ComputeDiff(
428   AToOriginal: TBGRALayerImageOriginal);
429 begin
430   if Assigned(FImageAfter) then FImageAfter.FreeReference;
431   FImageAfter := AToOriginal.FImage.NewReference;
432   FreeAndNil(FJpegStreamAfter);
433   if Assigned(AToOriginal.FJpegStream) then
434   begin
435     FJpegStreamAfter := TMemoryStream.Create;
436     AToOriginal.FJpegStream.Position:= 0;
437     FJpegStreamAfter.CopyFrom(AToOriginal.FJpegStream, AToOriginal.FJpegStream.Size);
438   end;
439   FContentVersionAfter:= AToOriginal.FContentVersion;
440 end;
441 
442 procedure TBGRAImageOriginalDiff.Apply(AOriginal: TBGRALayerCustomOriginal);
443 var
444   orig: TBGRALayerImageOriginal;
445 begin
446   orig := AOriginal as TBGRALayerImageOriginal;
447   orig.FImage.FreeReference;
448   orig.FImage := FImageAfter.NewReference;
449   FreeAndNil(orig.FJpegStream);
450   if Assigned(FJpegStreamAfter) then
451   begin
452     orig.FJpegStream := TMemoryStream.Create;
453     FJpegStreamAfter.Position := 0;
454     orig.FJpegStream.CopyFrom(FJpegStreamAfter, FJpegStreamAfter.Size);
455   end;
456   orig.FContentVersion := FContentVersionAfter;
457 end;
458 
459 procedure TBGRAImageOriginalDiff.Unapply(AOriginal: TBGRALayerCustomOriginal);
460 var
461   orig: TBGRALayerImageOriginal;
462 begin
463   orig := AOriginal as TBGRALayerImageOriginal;
464   orig.FImage.FreeReference;
465   orig.FImage := FImageBefore.NewReference;
466   FreeAndNil(orig.FJpegStream);
467   if Assigned(FJpegStreamBefore) then
468   begin
469     orig.FJpegStream := TMemoryStream.Create;
470     FJpegStreamBefore.Position := 0;
471     orig.FJpegStream.CopyFrom(FJpegStreamBefore, FJpegStreamBefore.Size);
472   end;
473   orig.FContentVersion := FContentVersionBefore;
474 end;
475 
TBGRAImageOriginalDiff.CanAppendnull476 function TBGRAImageOriginalDiff.CanAppend(ADiff: TBGRAOriginalDiff): boolean;
477 begin
478   result := (ADiff is TBGRAImageOriginalDiff) and
479     (TBGRAImageOriginalDiff(ADiff).FContentVersionAfter >= FContentVersionAfter);
480 end;
481 
482 procedure TBGRAImageOriginalDiff.Append(ADiff: TBGRAOriginalDiff);
483 var
484   next: TBGRAImageOriginalDiff;
485 begin
486   next := ADiff as TBGRAImageOriginalDiff;
487   if next.FContentVersionAfter < FContentVersionAfter then
488     raise exception.Create('Cannot append diff made before this one.');
489   FImageAfter.FreeReference;
490   FImageAfter := next.FImageAfter.NewReference;
491   FreeAndNil(FJpegStreamAfter);
492   if Assigned(next.FJpegStreamAfter) then
493   begin
494     FJpegStreamAfter := TMemoryStream.Create;
495     next.FJpegStreamAfter.Position:= 0;
496     FJpegStreamAfter.CopyFrom(next.FJpegStreamAfter, next.FJpegStreamAfter.Size);
497   end;
498   FContentVersionAfter:= next.FContentVersionAfter;
499 end;
500 
TBGRAImageOriginalDiff.IsIdentitynull501 function TBGRAImageOriginalDiff.IsIdentity: boolean;
502 begin
503   result := FImageBefore.Equals(FImageAfter) and
504     ( ((FJpegStreamBefore=nil) and (FJpegStreamAfter=nil)) or
505       (Assigned(FJpegStreamBefore) and Assigned(FJpegStreamAfter) and
506        (FJpegStreamBefore.Size = FJpegStreamAfter.Size) and
507        CompareMem(FJpegStreamBefore.Memory,FJpegStreamBefore.Memory,FJpegStreamBefore.Size)) );
508 
509 end;
510 
511 destructor TBGRAImageOriginalDiff.Destroy;
512 begin
513   FImageBefore.FreeReference;
514   FImageAfter.FreeReference;
515   FJpegStreamBefore.Free;
516   FJpegStreamAfter.Free;
517   inherited Destroy;
518 end;
519 
520 { TBGRAOriginalEditor }
521 
522 procedure TBGRAOriginalEditor.SetMatrix(AValue: TAffineMatrix);
523 begin
524   if FMatrix=AValue then Exit;
525   FMatrix:=AValue;
526   FMatrixInverse := AffineMatrixInverse(FMatrix);
527 end;
528 
GetMoveCursornull529 function TBGRAOriginalEditor.GetMoveCursor(APointIndex: integer): TOriginalEditorCursor;
530 var
531   d: TPointF;
532   ratio: single;
533 begin
534   if (APointIndex < 0) or (APointIndex >= PointCount) then result := oecDefault else
535   if isEmptyPointF(FPoints[APointIndex].Origin) then
536   begin
537     if Assigned(FPoints[APointIndex].OnMove) then
538       result := oecMove
539     else
540       result := oecHandPoint;
541   end else
542   begin
543     d := AffineMatrixLinear(FMatrix)*(FPoints[APointIndex].Coord - FPoints[APointIndex].Origin);
544     ratio := sin(Pi/8);
545     if (d.x = 0) and (d.y = 0) then result := oecMove else
546     if abs(d.x)*ratio >= abs(d.y) then
547     begin
548       if d.x >= 0 then result := oecMoveE else result := oecMoveW
549     end else
550     if abs(d.y)*ratio >= abs(d.x) then
551     begin
552       if d.y >= 0 then result := oecMoveS else result := oecMoveN
553     end else
554     if (d.x > 0) and (d.y > 0) then result := oecMoveSE else
555     if (d.x < 0) and (d.y < 0) then result := oecMoveNW else
556     if (d.x > 0) and (d.y < 0) then result := oecMoveNE
557     else result := oecMoveSW;
558   end;
559 end;
560 
GetFixedShiftForButtonnull561 function TBGRAOriginalEditor.GetFixedShiftForButton(AShift: TShiftState;
562   ARightDown: boolean): TShiftState;
563 begin
564   result := AShift - [ssLeft,ssMiddle,ssRight];
565   if ARightDown then include(result, ssRight)
566   else include(result, ssLeft);
567 end;
568 
GetPointCoordnull569 function TBGRAOriginalEditor.GetPointCoord(AIndex: integer): TPointF;
570 begin
571   if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds');
572   result := FPoints[AIndex].Coord;
573 end;
574 
GetIsMovingPointnull575 function TBGRAOriginalEditor.GetIsMovingPoint: boolean;
576 begin
577   result := FPointMoving <> -1;
578 end;
579 
TBGRAOriginalEditor.GetPointCountnull580 function TBGRAOriginalEditor.GetPointCount: integer;
581 begin
582   result := length(FPoints);
583 end;
584 
TBGRAOriginalEditor.GetPointHighlightednull585 function TBGRAOriginalEditor.GetPointHighlighted(AIndex: integer): boolean;
586 begin
587   if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds');
588   result := FPoints[AIndex].Highlighted;
589 end;
590 
591 procedure TBGRAOriginalEditor.SetFocused(AValue: boolean);
592 begin
593   if FFocused=AValue then Exit;
594   FFocused:=AValue;
595   if Assigned(FOnFocusChanged) then FOnFocusChanged(self);
596 end;
597 
598 procedure TBGRAOriginalEditor.SetPointHighlighted(AIndex: integer;
599   AValue: boolean);
600 begin
601   if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds');
602   FPoints[AIndex].Highlighted := AValue;
603 end;
604 
605 procedure TBGRAOriginalEditor.SetGridActive(AValue: boolean);
606 begin
607   if FGridActive=AValue then Exit;
608   FGridActive:=AValue;
609 end;
610 
611 procedure TBGRAOriginalEditor.SetGridMatrix(AValue: TAffineMatrix);
612 begin
613   if FGridMatrix=AValue then Exit;
614   FGridMatrix:=AValue;
615   FGridMatrixInverse := AffineMatrixInverse(FGridMatrix);
616 end;
617 
TBGRAOriginalEditor.RenderPointnull618 function TBGRAOriginalEditor.RenderPoint(ADest: TBGRABitmap; ACoord: TPointF; AAlternateColor: boolean; AHighlighted: boolean): TRect;
619 const alpha = 192;
620 var filler: TBGRAMultishapeFiller;
621   c: TBGRAPixel;
622   penScale: Single;
623   oldClip: TRect;
624 begin
625   result := GetRenderPointBounds(ACoord, AHighlighted);
626   if not isEmptyPointF(ACoord) then
627   begin
628     oldClip := ADest.ClipRect;
629     ADest.IntersectClip(result);
630     if AAlternateColor then c := BGRA(255,128,128,alpha)
631       else if AHighlighted then c := BGRA(96,170,255,alpha)
632       else c := BGRA(255,255,255,alpha);
633     if AHighlighted then
634       ADest.GradientFill(result.Left, result.Top, result.Right, result.Bottom,
635                   c, BGRAPixelTransparent,
636                   gtRadial, PointF(ACoord.x,ACoord.y), PointF(result.right,ACoord.y),
637                   dmDrawWithTransparency);
638     penScale := FPointSize / 6;
639     if penScale < 1 then penScale := 1;
640     filler := TBGRAMultishapeFiller.Create;
641     filler.AddEllipseBorder(ACoord.x,ACoord.y, FPointSize-2,FPointSize-2, 3.5*penScale, BGRA(0,0,0,alpha));
642     filler.AddEllipseBorder(ACoord.x,ACoord.y, FPointSize-2,FPointSize-2, 1*penScale, c);
643     filler.PolygonOrder:= poLastOnTop;
644     filler.Draw(ADest);
645     filler.Free;
646     ADest.ClipRect := oldClip;
647   end;
648 end;
649 
GetRenderPointBoundsnull650 function TBGRAOriginalEditor.GetRenderPointBounds(ACoord: TPointF; AHighlighted: boolean): TRect;
651 var
652   r, penScale: Single;
653 begin
654   if isEmptyPointF(ACoord) then
655     result := EmptyRect
656   else
657   begin
658     penScale := FPointSize / 6;
659     if penScale < 1 then penScale := 1;
660     r := FPointSize + (penScale-1)*4;
661     if AHighlighted then r := max(r, FPointSize*2);
662     result := rect(floor(ACoord.x - r + 0.5), floor(ACoord.y - r + 0.5),
663                    ceil(ACoord.x + r + 0.5), ceil(ACoord.y + r + 0.5));
664   end;
665 end;
666 
RenderArrownull667 function TBGRAOriginalEditor.RenderArrow(ADest: TBGRABitmap; AOrigin,
668   AEndCoord: TPointF): TRect;
669 const alpha = 192;
670 var
671   pts, ptsContour: ArrayOfTPointF;
672   i: Integer;
673   rF: TRectF;
674   penScale: Single;
675 begin
676   if isEmptyPointF(AOrigin) or isEmptyPointF(AEndCoord) then
677     result := EmptyRect
678   else
679   begin
680     penScale := FPointSize / 6;
681     if penScale < 1 then penScale := 1;
682     ADest.Pen.Arrow.EndAsClassic;
683     ADest.Pen.Arrow.EndSize := PointF(FPointSize/penScale,FPointSize/penScale);
684     pts := ADest.ComputeWidePolyline([AOrigin,AEndCoord],1*penScale);
685     ADest.Pen.Arrow.EndAsNone;
686     ptsContour := ADest.ComputeWidePolygon(pts, 2*penScale);
687     ADest.FillPolyAntialias(ptsContour, BGRA(0,0,0,alpha));
688     ADest.FillPolyAntialias(pts, BGRA(255,255,255,alpha));
689     rF := RectF(AOrigin,AEndCoord);
690     for i := 0 to high(ptsContour) do
691     if not isEmptyPointF(ptsContour[i]) then
692     begin
693       if ptsContour[i].x < rF.Left then rF.Left := ptsContour[i].x;
694       if ptsContour[i].x > rF.Right then rF.Right := ptsContour[i].x;
695       if ptsContour[i].y < rF.Top then rF.Top := ptsContour[i].y;
696       if ptsContour[i].y > rF.Bottom then rF.Bottom := ptsContour[i].y;
697     end;
698     result := rect(floor(rF.Left+0.5),floor(rF.Top+0.5),ceil(rF.Right+0.5),ceil(rF.Bottom+0.5));
699   end;
700 end;
701 
TBGRAOriginalEditor.GetRenderArrowBoundsnull702 function TBGRAOriginalEditor.GetRenderArrowBounds(AOrigin, AEndCoord: TPointF): TRect;
703 var
704   penScale, margin: Single;
705 begin
706   if isEmptyPointF(AOrigin) or isEmptyPointF(AEndCoord) then
707     result := EmptyRect
708   else
709   begin
710     penScale := FPointSize / 6;
711     if penScale < 1 then penScale := 1;
712     margin := penScale * 1.5;
713     result := Rect(floor(AOrigin.x+0.5-margin),floor(AOrigin.y+0.5-margin),
714       ceil(AOrigin.x+0.5+margin),ceil(AOrigin.y+0.5+margin));
715     result.Union( rect(floor(AEndCoord.x+0.5-FPointSize-margin), floor(AEndCoord.y+0.5-FPointSize-margin),
716                       ceil(AEndCoord.x+0.5+FPointSize+margin), ceil(AEndCoord.y+0.5+FPointSize+margin)) );
717   end;
718 end;
719 
TBGRAOriginalEditor.RenderPolygonnull720 function TBGRAOriginalEditor.RenderPolygon(ADest: TBGRABitmap;
721   ACoords: array of TPointF; AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): TRect;
722 var
723   dashLen: integer;
724   i: integer;
725   ptsF: array of TPointF;
726   pts1,pts2: array of TPoint;
727 begin
728   dashLen := round(PointSize/2);
729   if dashLen < 1 then dashLen := 1;
730 
731   setlength(pts1, length(ACoords));
732   for i := 0 to high(ACoords) do
733     pts1[i] := ACoords[i].Round;
734 
735   setlength(ptsF, length(pts1));
736   for i := 0 to high(pts1) do
737     ptsF[i] := PointF(pts1[i]);
738 
739   if ABackColor.alpha <> 0 then
740     ADest.FillPolyAntialias(ptsF, ABackColor);
741 
742   case AStyle of
743   opsDash, opsDashWithShadow:
744     begin
745       if AStyle = opsDashWithShadow then
746       begin
747         //shadow
748         setlength(pts2,length(pts1));
749         for i := 0 to high(pts1) do
750           if not isEmptyPoint(pts1[i]) then
751             pts2[i] := Point(pts1[i].x+1,pts1[i].y+1)
752           else pts2[i] := EmptyPoint;
753         if AClosed then
754           ADest.DrawPolygonAntialias(pts2, BGRA(0,0,0,96))
755         else
756           ADest.DrawPolyLineAntialias(pts2, BGRA(0,0,0,96), true);
757         pts2:= nil;
758       end;
759 
760       //dotted line
761       if AClosed then
762         ADest.DrawPolygonAntialias(pts1, CSSIvory,BGRA(70,70,50),dashLen)
763       else
764         ADest.DrawPolyLineAntialias(pts1, CSSIvory,BGRA(70,70,50),dashLen, true);
765     end;
766   opsSolid:
767     begin
768       ADest.JoinStyle:= pjsRound;
769       ADest.LineCap:= pecRound;
770       //black outline
771       if AClosed then
772         ADest.DrawPolygonAntialias(ptsF, BGRA(0,0,0,192), 3)
773       else
774         ADest.DrawPolyLineAntialias(ptsF, BGRA(0,0,0,192), 3);
775 
776       if AClosed then
777         ADest.DrawPolygonAntialias(pts1, CSSIvory)
778       else
779         ADest.DrawPolyLineAntialias(pts1, CSSIvory, true);
780     end;
781   end;
782 
783   result := GetRenderPolygonBounds(ACoords);
784 end;
785 
TBGRAOriginalEditor.GetRenderPolygonBoundsnull786 function TBGRAOriginalEditor.GetRenderPolygonBounds(ACoords: array of TPointF): TRect;
787 var
788   first: Boolean;
789   rF: TRectF;
790   i: Integer;
791 begin
792   first:= true;
793   rF:= EmptyRectF;
794   for i := 0 to high(ACoords) do
795     if not isEmptyPointF(ACoords[i]) then
796     begin
797       if first then
798       begin
799         rF := RectF(Acoords[i],ACoords[i]);
800         first:= false;
801       end else
802       begin
803         if ACoords[i].x < rF.Left then rF.Left := ACoords[i].x;
804         if ACoords[i].x > rF.Right then rF.Right := ACoords[i].x;
805         if ACoords[i].y < rF.Top then rF.Top := ACoords[i].y;
806         if ACoords[i].y > rF.Bottom then rF.Bottom := ACoords[i].y;
807       end;
808     end;
809   if not first then
810     result := rect(floor(rF.Left-0.5),floor(rF.Top-0.5),ceil(rF.Right+1.5),ceil(rF.Bottom+1.5))
811   else
812     result := EmptyRect;
813 end;
814 
815 constructor TBGRAOriginalEditor.Create;
816 begin
817   FPointSize:= 6;
818   FMatrix := AffineMatrixIdentity;
819   FMatrixInverse := AffineMatrixIdentity;
820   FGridMatrix := AffineMatrixIdentity;
821   FGridMatrixInverse := AffineMatrixIdentity;
822   FGridActive:= false;
823   FPointMoving:= -1;
824   FStartMoveHandlers := TStartMoveHandlers.Create;
825   FCurHoverPoint:= -1;
826   FHoverPointHandlers := THoverPointHandlers.Create;
827   FClickPointHandlers := TClickPointHandlers.Create;
828 end;
829 
830 destructor TBGRAOriginalEditor.Destroy;
831 begin
832   FreeAndNil(FStartMoveHandlers);
833   FreeAndNil(FHoverPointHandlers);
834   FreeAndNil(FClickPointHandlers);
835   inherited Destroy;
836 end;
837 
838 procedure TBGRAOriginalEditor.Clear;
839 begin
840   FPoints := nil;
841   FPolylines := nil;
842   FStartMoveHandlers.Clear;
843   FHoverPointHandlers.Clear;
844   FClickPointHandlers.Clear;
845 end;
846 
847 procedure TBGRAOriginalEditor.AddStartMoveHandler(
848   AOnStartMove: TOriginalStartMovePointEvent);
849 begin
850   FStartMoveHandlers.Add(AOnStartMove);
851 end;
852 
853 procedure TBGRAOriginalEditor.AddClickPointHandler(
854   AOnClickPoint: TOriginalClickPointEvent);
855 begin
856   FClickPointHandlers.Add(AOnClickPoint);
857 end;
858 
859 procedure TBGRAOriginalEditor.AddHoverPointHandler(
860   AOnHoverPoint: TOriginalHoverPointEvent);
861 begin
862   FHoverPointHandlers.Add(AOnHoverPoint);
863 end;
864 
TBGRAOriginalEditor.AddPointnull865 function TBGRAOriginalEditor.AddPoint(const ACoord: TPointF;
866   AOnMove: TOriginalMovePointEvent; ARightButton: boolean; ASnapToPoint: integer): integer;
867 begin
868   setlength(FPoints, length(FPoints)+1);
869   result := High(FPoints);
870   with FPoints[result] do
871   begin
872     Origin := EmptyPointF;
873     Coord := ACoord;
874     OnMove := AOnMove;
875     OnAlternateMove:= nil;
876     RightButton:= ARightButton;
877     SnapToPoint:= ASnapToPoint;
878     HitBox := TAffineBox.EmptyBox;
879   end;
880 end;
881 
882 procedure TBGRAOriginalEditor.AddPointAlternateMove(AIndex: integer;
883   AOnAlternateMove: TOriginalMovePointEvent);
884 begin
885   if (AIndex >= 0) and (AIndex < PointCount) then
886     FPoints[AIndex].OnAlternateMove:= AOnAlternateMove;
887 end;
888 
TBGRAOriginalEditor.AddFixedPointnull889 function TBGRAOriginalEditor.AddFixedPoint(const ACoord: TPointF;
890   ARightButton: boolean): integer;
891 begin
892   setlength(FPoints, length(FPoints)+1);
893   result := High(FPoints);
894   with FPoints[result] do
895   begin
896     Origin := EmptyPointF;
897     Coord := ACoord;
898     OnMove := nil;
899     OnAlternateMove:= nil;
900     RightButton:= ARightButton;
901     Highlighted:= false;
902     SnapToPoint:= -1;
903     HitBox := TAffineBox.EmptyBox;
904   end;
905 end;
906 
AddArrownull907 function TBGRAOriginalEditor.AddArrow(const AOrigin, AEndCoord: TPointF;
908   AOnMoveEnd: TOriginalMovePointEvent; ARightButton: boolean): integer;
909 begin
910   setlength(FPoints, length(FPoints)+1);
911   result := High(FPoints);
912   with FPoints[result] do
913   begin
914     Origin := AOrigin;
915     Coord := AEndCoord;
916     OnMove := AOnMoveEnd;
917     OnAlternateMove:= nil;
918     RightButton:= ARightButton;
919     Highlighted:= false;
920     SnapToPoint:= -1;
921     HitBox := TAffineBox.EmptyBox;
922   end;
923 end;
924 
TBGRAOriginalEditor.AddPolylinenull925 function TBGRAOriginalEditor.AddPolyline(const ACoords: array of TPointF;
926   AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle): integer;
927 begin
928   result := AddPolyline(ACoords, AClosed, AStyle, BGRAPixelTransparent);
929 end;
930 
TBGRAOriginalEditor.AddPolylinenull931 function TBGRAOriginalEditor.AddPolyline(const ACoords: array of TPointF;
932   AClosed: boolean; AStyle: TBGRAOriginalPolylineStyle; ABackColor: TBGRAPixel): integer;
933 var
934   i: Integer;
935 begin
936   setlength(FPolylines, length(FPolylines)+1);
937   result := high(FPolylines);
938   setlength(FPolylines[result].Coords, length(ACoords));
939   for i := 0 to high(ACoords) do
940     FPolylines[result].Coords[i] := ACoords[i];
941   FPolylines[result].Closed:= AClosed;
942   FPolylines[result].Style := AStyle;
943   FPolylines[result].BackColor := ABackColor;
944 end;
945 
946 procedure TBGRAOriginalEditor.SetHitBox(AIndex: integer; AHitBox: TAffineBox);
947 begin
948   if (AIndex < 0) or (AIndex >= PointCount) then raise exception.Create('Index out of bounds');
949   FPoints[AIndex].HitBox := AHitBox;
950 end;
951 
952 procedure TBGRAOriginalEditor.MouseMove(Shift: TShiftState; ViewX, ViewY: single; out
953   ACursor: TOriginalEditorCursor; out AHandled: boolean);
954 var newMousePos, newCoord, snapCoord: TPointF;
955   hoverPoint, i: Integer;
956   subShift: TShiftState;
957 begin
958   AHandled := false;
959   newMousePos := ViewCoordToOriginal(PointF(ViewX,ViewY));
960   if (FPointMoving <> -1) and (FPointMoving < length(FPoints)) then
961   begin
962     newCoord := newMousePos + FPointCoordDelta;
963     if GridActive then newCoord := SnapToGrid(newCoord, false);
964     if FPoints[FPointMoving].SnapToPoint <> -1 then
965     begin
966       snapCoord := FPoints[FPoints[FPointMoving].SnapToPoint].Coord;
967       if VectLen(AffineMatrixLinear(FMatrix)*(snapCoord - newCoord)) < FPointSize then
968         newCoord := snapCoord;
969     end;
970     if newCoord <> FPoints[FPointMoving].Coord then
971     begin
972       FPointWasMoved:= true;
973       subShift := GetFixedShiftForButton(Shift, FMovingRightButton);
974       if (FMovingRightButton xor FPoints[FPointMoving].RightButton) and
975         Assigned(FPoints[FPointMoving].OnAlternateMove) then
976         FPoints[FPointMoving].OnAlternateMove(self, FPoints[FPointMoving].Coord, newCoord, subShift)
977       else
978         FPoints[FPointMoving].OnMove(self, FPoints[FPointMoving].Coord, newCoord, subShift);
979       if (FPointMoving >= 0) and (FPointMoving < length(FPoints)) then
980         FPoints[FPointMoving].Coord := newCoord
981       else
982         FPointMoving := -1;
983     end;
984     ACursor := GetMoveCursor(FPointMoving);
985     AHandled:= true;
986   end else
987   begin
988     hoverPoint := GetPointAt(newMousePos, false);
989     if hoverPoint <> -1 then
990       ACursor := GetMoveCursor(hoverPoint)
991     else
992       ACursor:= oecDefault;
993     if hoverPoint <> FCurHoverPoint then
994     begin
995       FCurHoverPoint:= hoverPoint;
996       for i := 0 to FHoverPointHandlers.Count-1 do
997         FHoverPointHandlers[i](self, FCurHoverPoint);
998     end;
999   end;
1000   FPrevMousePos:= newMousePos;
1001 end;
1002 
1003 procedure TBGRAOriginalEditor.MouseDown(RightButton: boolean;
1004   Shift: TShiftState; ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out
1005   AHandled: boolean);
1006 var
1007   i, clickedPoint: Integer;
1008   subShift: TShiftState;
1009 begin
1010   AHandled:= false;
1011   FPrevMousePos:= ViewCoordToOriginal(PointF(ViewX,ViewY));
1012   if FPointMoving = -1 then
1013   begin
1014     clickedPoint := GetPointAt(FPrevMousePos, RightButton);
1015     if clickedPoint <> -1 then
1016     begin
1017       subShift := GetFixedShiftForButton(Shift, RightButton);
1018       if Assigned(FPoints[clickedPoint].OnMove) then
1019       begin
1020         FPointMoving:= clickedPoint;
1021         FPointWasMoved:= false;
1022         FMovingRightButton:= RightButton;
1023         FPointCoordDelta := FPoints[FPointMoving].Coord - FPrevMousePos;
1024         for i := 0 to FStartMoveHandlers.Count-1 do
1025           FStartMoveHandlers[i](self, FPointMoving, subShift);
1026       end else
1027       begin
1028         for i := 0 to FClickPointHandlers.Count-1 do
1029           FClickPointHandlers[i](self, clickedPoint, subShift);
1030       end;
1031       AHandled:= true;
1032     end;
1033   end;
1034   if FPointMoving <> -1 then
1035   begin
1036     ACursor := GetMoveCursor(FPointMoving);
1037     AHandled:= true;
1038   end
1039   else
1040     ACursor := oecDefault;
1041 end;
1042 
1043 procedure TBGRAOriginalEditor.MouseUp(RightButton: boolean; Shift: TShiftState;
1044   ViewX, ViewY: single; out ACursor: TOriginalEditorCursor; out AHandled: boolean);
1045 var
1046   i: Integer;
1047   subShift: TShiftState;
1048 begin
1049   AHandled:= false;
1050   if (RightButton = FMovingRightButton) and (FPointMoving <> -1) then
1051   begin
1052     if not FPointWasMoved then
1053     begin
1054       subShift := GetFixedShiftForButton(Shift, RightButton);
1055       for i := 0 to FClickPointHandlers.Count-1 do
1056         FClickPointHandlers[i](self, FPointMoving, subShift);
1057     end;
1058     FPointMoving:= -1;
1059     AHandled:= true;
1060   end;
1061   ACursor := oecDefault;
1062 end;
1063 
1064 procedure TBGRAOriginalEditor.KeyDown(Shift: TShiftState; Key: TSpecialKey; out
1065   AHandled: boolean);
1066 begin
1067   AHandled := false;
1068 end;
1069 
1070 procedure TBGRAOriginalEditor.KeyUp(Shift: TShiftState; Key: TSpecialKey; out
1071   AHandled: boolean);
1072 begin
1073   AHandled := false;
1074 end;
1075 
1076 procedure TBGRAOriginalEditor.KeyPress(UTF8Key: string; out AHandled: boolean);
1077 begin
1078   AHandled := false;
1079 end;
1080 
GetPointAtnull1081 function TBGRAOriginalEditor.GetPointAt(const ACoord: TPointF; ARightButton: boolean): integer;
1082 var v: TPointF;
1083   curDist,newDist: single;
1084   i: Integer;
1085   transfCoord: TPointF;
1086 begin
1087   if ARightButton then
1088     curDist := sqr(2.25*FPointSize)
1089   else
1090     curDist := sqr(1.25*FPointSize);
1091   result := -1;
1092   transfCoord:= Matrix*ACoord;
1093 
1094   for i := 0 to high(FPoints) do
1095   if FPoints[i].RightButton = ARightButton then
1096   begin
1097     v := Matrix*FPoints[i].Coord - transfCoord;
1098     newDist := v*v;
1099     if newDist <= curDist then
1100     begin
1101       curDist:= newDist;
1102       result := i;
1103     end;
1104   end;
1105   if result <> -1 then exit;
1106 
1107   if not ARightButton then
1108     curDist := sqr(2.25*FPointSize)
1109   else
1110     curDist := sqr(1.25*FPointSize);
1111   for i := 0 to high(FPoints) do
1112   if FPoints[i].RightButton <> ARightButton then
1113   begin
1114     v := Matrix*FPoints[i].Coord - transfCoord;
1115     newDist := v*v;
1116     if newDist <= curDist then
1117     begin
1118       curDist:= newDist;
1119       result := i;
1120     end;
1121   end;
1122 
1123   for i := 0 to high(FPoints) do
1124   if (FPoints[i].RightButton = ARightButton)
1125     and FPoints[i].HitBox.Contains(ACoord) then exit(i);
1126 
1127   for i := 0 to high(FPoints) do
1128   if (FPoints[i].RightButton <> ARightButton)
1129     and FPoints[i].HitBox.Contains(ACoord) then exit(i);
1130 end;
1131 
TBGRAOriginalEditor.Rendernull1132 function TBGRAOriginalEditor.Render(ADest: TBGRABitmap; const ALayoutRect: TRect): TRect;
1133 var
1134   i,j: Integer;
1135   elemRect: TRect;
1136   ptsF: array of TPointF;
1137 begin
1138   result := EmptyRect;
1139   for i := 0 to high(FPoints) do
1140   begin
1141     if isEmptyPointF(FPoints[i].Origin) then
1142       elemRect := RenderPoint(ADest, OriginalCoordToView(FPoints[i].Coord), FPoints[i].RightButton, FPoints[i].Highlighted)
1143     else
1144       elemRect := RenderArrow(ADest, OriginalCoordToView(FPoints[i].Origin), OriginalCoordToView(FPoints[i].Coord));
1145     if not elemRect.IsEmpty then
1146     begin
1147       if result.IsEmpty then
1148         result := elemRect
1149       else
1150         result.Union(elemRect);
1151     end;
1152   end;
1153   for i := 0 to high(FPolylines) do
1154   begin
1155     with FPolylines[i] do
1156     begin
1157       setlength(ptsF, length(Coords));
1158       for j := 0 to high(Coords) do
1159         if IsEmptyPointF(Coords[j]) then
1160           ptsF[j] := EmptyPointF
1161         else
1162           ptsF[j] := OriginalCoordToView(Coords[j]);
1163       elemRect := RenderPolygon(ADest, ptsF, Closed, Style, BackColor);
1164     end;
1165     if not elemRect.IsEmpty then
1166     begin
1167       if result.IsEmpty then
1168         result := elemRect
1169       else
1170         result.Union(elemRect);
1171     end;
1172   end;
1173 end;
1174 
GetRenderBoundsnull1175 function TBGRAOriginalEditor.GetRenderBounds(const ALayoutRect: TRect): TRect;
1176 var
1177   i,j: Integer;
1178   elemRect: TRect;
1179   ptsF: array of TPointF;
1180 begin
1181   result := EmptyRect;
1182   for i := 0 to high(FPoints) do
1183   begin
1184     if isEmptyPointF(FPoints[i].Origin) then
1185       elemRect := GetRenderPointBounds(OriginalCoordToView(FPoints[i].Coord), FPoints[i].Highlighted)
1186     else
1187       elemRect := GetRenderArrowBounds(OriginalCoordToView(FPoints[i].Origin), OriginalCoordToView(FPoints[i].Coord));
1188     if not elemRect.IsEmpty then
1189     begin
1190       if result.IsEmpty then
1191         result := elemRect
1192       else
1193         result.Union(elemRect);
1194     end;
1195   end;
1196   for i := 0 to high(FPolylines) do
1197   begin
1198     with FPolylines[i] do
1199     begin
1200       setlength(ptsF, length(Coords));
1201       for j := 0 to high(Coords) do
1202         if IsEmptyPointF(Coords[j]) then
1203           ptsF[j] := EmptyPointF
1204         else
1205           ptsF[j] := OriginalCoordToView(Coords[j]);
1206       elemRect := GetRenderPolygonBounds(ptsF);
1207     end;
1208     if not elemRect.IsEmpty then
1209     begin
1210       if result.IsEmpty then
1211         result := elemRect
1212       else
1213         result.Union(elemRect);
1214     end;
1215   end;
1216 end;
1217 
SnapToGridnull1218 function TBGRAOriginalEditor.SnapToGrid(const ACoord: TPointF;
1219   AIsViewCoord: boolean): TPointF;
1220 var
1221   gridCoord: TPointF;
1222 begin
1223   if AIsViewCoord then
1224     gridCoord := FGridMatrixInverse*ViewCoordToOriginal(ACoord)
1225   else
1226     gridCoord := FGridMatrixInverse*ACoord;
1227   gridCoord.x := round(gridCoord.x);
1228   gridCoord.y := round(gridCoord.y);
1229   result := FGridMatrix*gridCoord;
1230   if AIsViewCoord then
1231     result := OriginalCoordToView(result);
1232 end;
1233 
TBGRAOriginalEditor.OriginalCoordToViewnull1234 function TBGRAOriginalEditor.OriginalCoordToView(const AImageCoord: TPointF): TPointF;
1235 begin
1236   result := FMatrix*AImageCoord;
1237 end;
1238 
TBGRAOriginalEditor.ViewCoordToOriginalnull1239 function TBGRAOriginalEditor.ViewCoordToOriginal(const AViewCoord: TPointF): TPointF;
1240 begin
1241   result := FMatrixInverse*AViewCoord;
1242 end;
1243 
1244 { TBGRAMemOriginalStorage }
1245 
TBGRAMemOriginalStorage.GetRawStringnull1246 function TBGRAMemOriginalStorage.GetRawString(AName: utf8string): RawByteString;
1247 var
1248   idx: Integer;
1249 begin
1250   if pos('.',AName)<>0 then exit('');
1251   idx := FMemDir.IndexOf(AName,'',true);
1252   if idx = -1 then
1253     result := ''
1254   else if FMemDir.IsDirectory[idx] then
1255     raise exception.Create('This name refers to an object and not an attribute')
1256   else
1257     result := FMemDir.RawString[idx];
1258 end;
1259 
1260 procedure TBGRAMemOriginalStorage.SetRawString(AName: utf8string;
1261   AValue: RawByteString);
1262 var
1263   idx: Integer;
1264 begin
1265   if pos('.',AName)<>0 then
1266     raise exception.Create('Attribute name cannot contain "."');
1267   idx := FMemDir.IndexOf(AName,'',true);
1268   if idx = -1 then
1269     FMemDir.Add(AName,'',AValue)
1270   else if FMemDir.IsDirectory[idx] then
1271     raise exception.Create('This name refers to an existing object and so cannot be an attribute')
1272   else
1273     FMemDir.RawString[idx] := AValue;
1274 end;
1275 
TBGRAMemOriginalStorage.GetEmptynull1276 function TBGRAMemOriginalStorage.GetEmpty: boolean;
1277 begin
1278   result := FMemDir.Count = 0;
1279 end;
1280 
1281 destructor TBGRAMemOriginalStorage.Destroy;
1282 begin
1283   if FMemDirOwned then FreeAndNil(FMemDir);
1284   inherited Destroy;
1285 end;
1286 
1287 constructor TBGRAMemOriginalStorage.Create;
1288 begin
1289   inherited Create;
1290   FMemDir := TMemDirectory.Create;
1291   FMemDirOwned:= true;
1292 end;
1293 
1294 constructor TBGRAMemOriginalStorage.Create(AMemDir: TMemDirectory; AMemDirOwned: boolean = false);
1295 begin
1296   inherited Create;
1297   FMemDir := AMemDir;
1298   FMemDirOwned:= AMemDirOwned;
1299 end;
1300 
TBGRAMemOriginalStorage.Equalsnull1301 function TBGRAMemOriginalStorage.Equals(Obj: TObject): boolean;
1302 var
1303   other: TBGRAMemOriginalStorage;
1304 begin
1305   if not (Obj is TBGRAMemOriginalStorage) then exit(false);
1306   other := TBGRAMemOriginalStorage(obj);
1307   result := FMemDir.Equals(other.FMemDir);
1308 end;
1309 
Duplicatenull1310 function TBGRAMemOriginalStorage.Duplicate: TBGRACustomOriginalStorage;
1311 begin
1312   result := TBGRAMemOriginalStorage.Create;
1313   CopyTo(TBGRAMemOriginalStorage(result).FMemDir);
1314 end;
1315 
1316 procedure TBGRAMemOriginalStorage.RemoveAttribute(AName: utf8string);
1317 var
1318   idx: Integer;
1319 begin
1320   if pos('.',AName)<>0 then exit;
1321   idx := FMemDir.IndexOf(AName,'',true);
1322   if idx = -1 then exit
1323   else if FMemDir.IsDirectory[idx] then
1324     raise exception.Create('This name refers to an object and not an attribute')
1325   else
1326     FMemDir.Delete(idx);
1327 end;
1328 
TBGRAMemOriginalStorage.HasAttributenull1329 function TBGRAMemOriginalStorage.HasAttribute(AName: utf8string): boolean;
1330 var
1331   idx: Integer;
1332 begin
1333   if pos('.',AName)<>0 then exit(false);
1334   idx := FMemDir.IndexOf(AName,'',true);
1335   if idx = -1 then exit(false)
1336   else exit(not FMemDir.IsDirectory[idx]);
1337 end;
1338 
1339 procedure TBGRAMemOriginalStorage.RemoveObject(AName: utf8string);
1340 var
1341   idx: Integer;
1342 begin
1343   idx := FMemDir.IndexOf(EntryFilename(AName));
1344   if idx = -1 then exit
1345   else if not FMemDir.IsDirectory[idx] then
1346     raise exception.Create('This name refers to an attribute and not an object')
1347   else
1348     FMemDir.Delete(idx);
1349 end;
1350 
CreateObjectnull1351 function TBGRAMemOriginalStorage.CreateObject(AName: utf8string): TBGRACustomOriginalStorage;
1352 var
1353   dirIdx: Integer;
1354 begin
1355   if pos('.',AName)<>0 then
1356     raise exception.Create('An object cannot contain "."');
1357   RemoveObject(AName);
1358   dirIdx := FMemDir.AddDirectory(AName,'');
1359   result := TBGRAMemOriginalStorage.Create(FMemDir.Directory[dirIdx]);
1360 end;
1361 
TBGRAMemOriginalStorage.OpenObjectnull1362 function TBGRAMemOriginalStorage.OpenObject(AName: utf8string): TBGRACustomOriginalStorage;
1363 var
1364   dir: TMemDirectory;
1365 begin
1366   if pos('.',AName)<>0 then
1367     raise exception.Create('An object cannot contain "."');
1368   dir := FMemDir.FindPath(AName);
1369   if dir = nil then
1370     result := nil
1371   else
1372     result := TBGRAMemOriginalStorage.Create(dir);
1373 end;
1374 
ObjectExistsnull1375 function TBGRAMemOriginalStorage.ObjectExists(AName: utf8string): boolean;
1376 var
1377   dir: TMemDirectory;
1378 begin
1379   if pos('.',AName)<>0 then exit(false);
1380   dir := FMemDir.FindPath(AName);
1381   result:= Assigned(dir);
1382 end;
1383 
1384 procedure TBGRAMemOriginalStorage.EnumerateObjects(AList: TStringList);
1385 var
1386   i: Integer;
1387 begin
1388   for i := 0 to FMemDir.Count-1 do
1389     if FMemDir.IsDirectory[i] then
1390       AList.Add(FMemDir.Entry[i].Name);
1391 end;
1392 
1393 procedure TBGRAMemOriginalStorage.EnumerateFiles(AList: TStringList);
1394 var
1395   i: Integer;
1396 begin
1397   for i := 0 to FMemDir.Count-1 do
1398     if not FMemDir.IsDirectory[i] then
1399       AList.Add(FMemDir.Entry[i].Name);
1400 end;
1401 
1402 procedure TBGRAMemOriginalStorage.RemoveFile(AName: utf8string);
1403 var
1404   idx: Integer;
1405 begin
1406   idx := FMemDir.IndexOf(EntryFilename(AName));
1407   if idx = -1 then exit
1408   else if FMemDir.IsDirectory[idx] then
1409     raise exception.Create('This name refers to an object and not a file')
1410   else
1411     FMemDir.Delete(idx);
1412 end;
1413 
GetFileStreamnull1414 function TBGRAMemOriginalStorage.GetFileStream(AName: UTF8String): TStream;
1415 var
1416   entryId: Integer;
1417 begin
1418   entryId := FMemDir.IndexOf(EntryFilename(AName));
1419   if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then
1420   begin
1421     with FMemDir.Entry[entryId] do
1422       result := GetStream;
1423   end
1424   else
1425     result := nil;
1426 end;
1427 
ReadBitmapnull1428 function TBGRAMemOriginalStorage.ReadBitmap(AName: UTF8String;
1429   ADest: TCustomUniversalBitmap): boolean;
1430 var
1431   entryId: Integer;
1432   stream: TStream;
1433 begin
1434   entryId := FMemDir.IndexOf(EntryFilename(AName));
1435   if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then
1436   begin
1437     if FMemDir.IsEntryCompressed[entryId] then
1438     begin
1439       stream := TMemoryStream.Create;
1440       try
1441         with FMemDir.Entry[entryId] do
1442         begin
1443           if CopyTo(stream) <> FileSize then
1444             result := false
1445           else
1446           begin
1447             stream.Position:= 0;
1448             ADest.LoadFromStream(stream);
1449             result := true;
1450           end;
1451         end;
1452       finally
1453         stream.Free;
1454       end;
1455     end else
1456     with FMemDir.Entry[entryId] do
1457     begin
1458       stream := GetStream;
1459       stream.Position:= 0;
1460       ADest.LoadFromStream(stream);
1461       result := true;
1462     end;
1463   end
1464   else
1465     result := false;
1466 end;
1467 
TBGRAMemOriginalStorage.ReadFilenull1468 function TBGRAMemOriginalStorage.ReadFile(AName: UTF8String; ADest: TStream): boolean;
1469 var
1470   entryId: Integer;
1471 begin
1472   entryId := FMemDir.IndexOf(EntryFilename(AName));
1473   if (entryId <> -1) and not FMemDir.IsDirectory[entryId] then
1474   begin
1475     with FMemDir.Entry[entryId] do
1476       result := CopyTo(ADest) = FileSize
1477   end
1478   else
1479     result := false;
1480 end;
1481 
1482 procedure TBGRAMemOriginalStorage.WriteFile(AName: UTF8String; ASource: TStream; ACompress: boolean; AOwnStream: boolean);
1483 var
1484   idxEntry: Integer;
1485 begin
1486   idxEntry := FMemDir.Add(EntryFilename(AName), ASource, true, AOwnStream);
1487   if ACompress then FMemDir.IsEntryCompressed[idxEntry] := true;
1488 end;
1489 
TBGRAMemOriginalStorage.FileExistsnull1490 function TBGRAMemOriginalStorage.FileExists(AName: UTF8String): boolean;
1491 var
1492   entryId: Integer;
1493 begin
1494   entryId := FMemDir.IndexOf(EntryFilename(AName));
1495   result := (entryId <> -1) and not FMemDir.IsDirectory[entryId];
1496 end;
1497 
1498 procedure TBGRAMemOriginalStorage.SaveToStream(AStream: TStream);
1499 begin
1500   FMemDir.SaveToStream(AStream);
1501 end;
1502 
1503 procedure TBGRAMemOriginalStorage.LoadFromStream(AStream: TStream);
1504 begin
1505   FMemDir.LoadFromStream(AStream);
1506 end;
1507 
1508 procedure TBGRAMemOriginalStorage.LoadFromResource(AFilename: string);
1509 begin
1510   FMemDir.LoadFromResource(AFilename);
1511 end;
1512 
1513 procedure TBGRAMemOriginalStorage.CopyTo(AMemDir: TMemDirectory);
1514 begin
1515   FMemDir.CopyTo(AMemDir, true);
1516 end;
1517 
1518 { TBGRACustomOriginalStorage }
1519 
GetColornull1520 function TBGRACustomOriginalStorage.GetColor(AName: UTF8String): TBGRAPixel;
1521 begin
1522   result := StrToBGRA(RawString[AName], BGRAPixelTransparent);
1523 end;
1524 
1525 procedure TBGRACustomOriginalStorage.SetColor(AName: UTF8String;
1526   AValue: TBGRAPixel);
1527 begin
1528   RawString[AName] := LowerCase(BGRAToStr(AValue, CSSColors));
1529 end;
1530 
TBGRACustomOriginalStorage.GetDelimiternull1531 function TBGRACustomOriginalStorage.GetDelimiter: char;
1532 begin
1533   if FFormats.DecimalSeparator = ',' then
1534     result := ';' else result := ',';
1535 end;
1536 
GetRectFnull1537 function TBGRACustomOriginalStorage.GetRectF(AName: utf8string): TRectF;
1538 var
1539   a: array of Single;
1540 begin
1541   a := FloatArray[AName];
1542   if length(a)<4 then
1543     result := EmptyRectF
1544   else
1545   begin
1546     result.Left := a[0];
1547     result.Top := a[1];
1548     result.Right := a[2];
1549     result.Bottom := a[3];
1550   end;
1551 end;
1552 
1553 procedure TBGRACustomOriginalStorage.SetRectF(AName: utf8string; AValue: TRectF);
1554 var
1555   a: array of Single;
1556 begin
1557   setlength(a,4);
1558   a[0] := AValue.Left;
1559   a[1] := AValue.Top;
1560   a[2] := AValue.Right;
1561   a[3] := AValue.Bottom;
1562   FloatArray[AName] := a;
1563 end;
1564 
TBGRACustomOriginalStorage.GetAffineMatrixnull1565 function TBGRACustomOriginalStorage.GetAffineMatrix(AName: utf8string): TAffineMatrix;
1566 var
1567   stream: TMemoryStream;
1568 begin
1569   stream:= TMemoryStream.Create;
1570   if ReadFile(AName, stream) and (stream.Size >= sizeof(result)) then
1571   begin
1572     stream.Position:= 0;
1573     {$PUSH}{$HINTS OFF}stream.ReadBuffer({%H-}result, sizeof({%H-}result));{$POP}
1574     LongWord(result[1,1]) := NtoLE(LongWord(result[1,1]));
1575     LongWord(result[2,1]) := NtoLE(LongWord(result[2,1]));
1576     LongWord(result[1,2]) := NtoLE(LongWord(result[1,2]));
1577     LongWord(result[2,2]) := NtoLE(LongWord(result[2,2]));
1578     LongWord(result[1,3]) := NtoLE(LongWord(result[1,3]));
1579     LongWord(result[2,3]) := NtoLE(LongWord(result[2,3]));
1580   end else
1581     result := AffineMatrixIdentity;
1582   stream.Free;
1583 end;
1584 
1585 procedure TBGRACustomOriginalStorage.SetAffineMatrix(AName: utf8string;
1586   const AValue: TAffineMatrix);
1587 var
1588   stream: TMemoryStream;
1589 begin
1590   stream:= TMemoryStream.Create;
1591   stream.WriteBuffer(AValue, sizeof(AValue));
1592   WriteFile(AName,stream,false,true);
1593 end;
1594 
GetRectnull1595 function TBGRACustomOriginalStorage.GetRect(AName: utf8string): TRect;
1596 var
1597   rF: TRectF;
1598 begin
1599   rF := RectangleF[AName];
1600   result := rect(round(rF.Left),round(rF.Top),round(rF.Right),round(rF.Bottom));
1601 end;
1602 
1603 procedure TBGRACustomOriginalStorage.SetRect(AName: utf8string; AValue: TRect);
1604 var
1605   rF: TRectF;
1606 begin
1607   rF := rectF(AValue.Left,AValue.Top,AValue.Right,AValue.Bottom);
1608   RectangleF[AName] := rF;
1609 end;
1610 
TBGRACustomOriginalStorage.GetBoolDefnull1611 function TBGRACustomOriginalStorage.GetBoolDef(AName: utf8string;
1612   ADefault: boolean): boolean;
1613 begin
1614   if RawString[AName] = 'true' then result := true
1615   else if RawString[AName] = 'false' then result := false
1616   else result := ADefault;
1617 end;
1618 
TBGRACustomOriginalStorage.GetBoolnull1619 function TBGRACustomOriginalStorage.GetBool(AName: utf8string): boolean;
1620 begin
1621   result := GetBoolDef(AName, false);
1622 end;
1623 
GetSingleArraynull1624 function TBGRACustomOriginalStorage.GetSingleArray(AName: utf8string): ArrayOfSingle;
1625 var
1626   textVal: String;
1627   values: TStringList;
1628   i: Integer;
1629 begin
1630   textVal := Trim(RawString[AName]);
1631   if textVal = '' then exit(nil);
1632   values := TStringList.Create;
1633   values.StrictDelimiter := true;
1634   values.Delimiter:= GetDelimiter;
1635   values.DelimitedText:= textVal;
1636   setlength(result, values.Count);
1637   for i := 0 to high(result) do
1638     if CompareText(values[i],'none')=0 then
1639       result[i] := EmptySingle
1640     else
1641       result[i] := StrToFloatDef(values[i], 0, FFormats);
1642   values.Free;
1643 end;
1644 
TBGRACustomOriginalStorage.GetColorArraynull1645 function TBGRACustomOriginalStorage.GetColorArray(AName: UTF8String
1646   ): ArrayOfTBGRAPixel;
1647 var colorNames: TStringList;
1648   i: Integer;
1649 begin
1650   colorNames := TStringList.Create;
1651   colorNames.StrictDelimiter := true;
1652   colorNames.Delimiter:= GetDelimiter;
1653   colorNames.DelimitedText:= RawString[AName];
1654   setlength(result, colorNames.Count);
1655   for i := 0 to high(result) do
1656     result[i] := StrToBGRA(colorNames[i],BGRAPixelTransparent);
1657   colorNames.Free;
1658 end;
1659 
GetIntegerDefnull1660 function TBGRACustomOriginalStorage.GetIntegerDef(AName: utf8string;
1661   ADefault: integer): integer;
1662 begin
1663   result := StrToIntDef(RawString[AName],ADefault);
1664 end;
1665 
TBGRACustomOriginalStorage.GetSingleDefnull1666 function TBGRACustomOriginalStorage.GetSingleDef(AName: utf8string;
1667   ADefault: single): single;
1668 begin
1669   result := StrToFloatDef(RawString[AName], ADefault, FFormats);
1670 end;
1671 
1672 procedure TBGRACustomOriginalStorage.SetBool(AName: utf8string; AValue: boolean);
1673 begin
1674   RawString[AName] := BoolToStr(AValue,'true','false');
1675 end;
1676 
1677 procedure TBGRACustomOriginalStorage.SetSingleArray(AName: utf8string;
1678   AValue: ArrayOfSingle);
1679 var
1680   values: TStringList;
1681   i: Integer;
1682 begin
1683   values:= TStringList.Create;
1684   values.StrictDelimiter:= true;
1685   values.Delimiter:= GetDelimiter;
1686   for i := 0 to high(AValue) do
1687     if AValue[i] = EmptySingle then
1688       values.Add('none')
1689     else
1690       values.Add(FloatToStr(AValue[i], FFormats));
1691   RawString[AName] := values.DelimitedText;
1692   values.Free;
1693 end;
1694 
1695 procedure TBGRACustomOriginalStorage.SetColorArray(AName: UTF8String;
1696   AValue: ArrayOfTBGRAPixel);
1697 var colorNames: TStringList;
1698   i: Integer;
1699 begin
1700   colorNames := TStringList.Create;
1701   colorNames.StrictDelimiter := true;
1702   colorNames.Delimiter:= GetDelimiter;
1703   for i := 0 to high(AValue) do
1704     colorNames.Add(LowerCase(BGRAToStr(AValue[i], CSSColors)));
1705   RawString[AName] := colorNames.DelimitedText;
1706   colorNames.Free;
1707 end;
1708 
TBGRACustomOriginalStorage.GetIntegernull1709 function TBGRACustomOriginalStorage.GetInteger(AName: utf8string): integer;
1710 begin
1711   result := GetIntegerDef(AName,0);
1712 end;
1713 
TBGRACustomOriginalStorage.GetPointFnull1714 function TBGRACustomOriginalStorage.GetPointF(AName: utf8string): TPointF;
1715 var
1716   s: String;
1717   posComma: integer;
1718 begin
1719   s := RawString[AName];
1720   posComma := pos(GetDelimiter,s);
1721   if posComma = 0 then
1722     exit(EmptyPointF);
1723 
1724   result.x := StrToFloat(copy(s,1,posComma-1), FFormats);
1725   result.y := StrToFloat(copy(s,posComma+1,length(s)-posComma), FFormats);
1726 end;
1727 
TBGRACustomOriginalStorage.GetSinglenull1728 function TBGRACustomOriginalStorage.GetSingle(AName: utf8string): single;
1729 begin
1730   result := GetSingleDef(AName, EmptySingle);
1731 end;
1732 
1733 procedure TBGRACustomOriginalStorage.SetInteger(AName: utf8string;
1734   AValue: integer);
1735 begin
1736   RawString[AName] := IntToStr(AValue);
1737 end;
1738 
1739 procedure TBGRACustomOriginalStorage.SetPointF(AName: utf8string;
1740   AValue: TPointF);
1741 begin
1742   if isEmptyPointF(AValue) then RemoveAttribute(AName)
1743   else RawString[AName] := FloatToStrF(AValue.x, ffGeneral,7,3, FFormats)+GetDelimiter+FloatToStrF(AValue.y, ffGeneral,7,3, FFormats);
1744 end;
1745 
1746 procedure TBGRACustomOriginalStorage.SetSingle(AName: utf8string; AValue: single);
1747 begin
1748   if AValue = EmptySingle then RemoveAttribute(AName)
1749   else RawString[AName] := FloatToStrF(AValue, ffGeneral,7,3, FFormats);
1750 end;
1751 
1752 constructor TBGRACustomOriginalStorage.Create;
1753 begin
1754   FFormats := DefaultFormatSettings;
1755   FFormats.DecimalSeparator := '.';
1756 end;
1757 
FloatEqualsnull1758 function TBGRACustomOriginalStorage.FloatEquals(AName: utf8string;
1759   AValue: single): boolean;
1760 var
1761   curValue: Single;
1762 begin
1763   curValue := Float[AName];
1764   if curValue = EmptySingle then
1765     result := (AValue = EmptySingle) else
1766   if AValue = EmptySingle then
1767     result := false else
1768     result := (FloatToStrF(AValue, ffGeneral,7,3, FFormats) =
1769               FloatToStrF(curValue, ffGeneral,7,3, FFormats));
1770 end;
1771 
TBGRACustomOriginalStorage.PointFEqualsnull1772 function TBGRACustomOriginalStorage.PointFEquals(AName: utf8string;
1773   const AValue: TPointF): boolean;
1774 var
1775   curValue: TPointF;
1776 begin
1777   curValue := PointF[AName];
1778   if isEmptyPointF(curValue) then
1779     result := isEmptyPointF(AValue) else
1780   if isEmptyPointF(AValue) then
1781     result := False else
1782     result := (FloatToStrF(AValue.x, ffGeneral,7,3, FFormats) =
1783               FloatToStrF(curValue.x, ffGeneral,7,3, FFormats)) and
1784               (FloatToStrF(AValue.y, ffGeneral,7,3, FFormats) =
1785               FloatToStrF(curValue.y, ffGeneral,7,3, FFormats));
1786 end;
1787 
AffineMatrixEqualsnull1788 function TBGRACustomOriginalStorage.AffineMatrixEquals(AName: utf8string;
1789   const AValue: TAffineMatrix): boolean;
1790 begin
1791   result := (AffineMatrix[AName] = AValue);
1792 end;
1793 
1794 { TBGRALayerCustomOriginal }
1795 
1796 procedure TBGRALayerCustomOriginal.SetOnChange(AValue: TOriginalChangeEvent);
1797 begin
1798   if FOnChange=AValue then Exit;
1799   FOnChange:=AValue;
1800 end;
1801 
TBGRALayerCustomOriginal.GetDiffExpectednull1802 function TBGRALayerCustomOriginal.GetDiffExpected: boolean;
1803 begin
1804   result := Assigned(FOnChange);
1805 end;
1806 
1807 procedure TBGRALayerCustomOriginal.SetRenderStorage(AValue: TBGRACustomOriginalStorage);
1808 begin
1809   if FRenderStorage=AValue then Exit;
1810   FRenderStorage:=AValue;
1811 end;
1812 
GetGuidnull1813 function TBGRALayerCustomOriginal.GetGuid: TGuid;
1814 begin
1815   result := FGuid;
1816 end;
1817 
1818 procedure TBGRALayerCustomOriginal.SetGuid(AValue: TGuid);
1819 begin
1820   FGuid := AValue;
1821 end;
1822 
1823 procedure TBGRALayerCustomOriginal.NotifyChange(ADiff: TBGRAOriginalDiff);
1824 begin
1825   if Assigned(FOnChange) then
1826     FOnChange(self, nil, ADiff);
1827   ADiff.Free;
1828 end;
1829 
1830 procedure TBGRALayerCustomOriginal.NotifyChange(ABounds: TRectF; ADiff: TBGRAOriginalDiff);
1831 begin
1832   if Assigned(FOnChange) then
1833     FOnChange(self, @ABounds, ADiff);
1834   ADiff.Free;
1835 end;
1836 
1837 procedure TBGRALayerCustomOriginal.NotifyEditorChange;
1838 begin
1839   if Assigned(FOnEditingChange) then
1840     FOnEditingChange(self);
1841 end;
1842 
1843 constructor TBGRALayerCustomOriginal.Create;
1844 begin
1845   FGuid := GUID_NULL;
1846   FRenderStorage := nil;
1847 end;
1848 
1849 destructor TBGRALayerCustomOriginal.Destroy;
1850 begin
1851   inherited Destroy;
1852 end;
1853 
1854 procedure TBGRALayerCustomOriginal.Render(ADest: TBGRABitmap;
1855   AMatrix: TAffineMatrix; ADraft: boolean);
1856 begin
1857   Render(ADest, Point(0,0), AMatrix, ADraft);
1858 end;
1859 
1860 procedure TBGRALayerCustomOriginal.Render(ADest: TBGRABitmap;
1861   ARenderOffset: TPoint; AMatrix: TAffineMatrix; ADraft: boolean);
1862 begin
1863   Render(ADest, AffineMatrixTranslation(ARenderOffset.X, ARenderOffset.Y)*AMatrix, ADraft);
1864 end;
1865 
1866 procedure TBGRALayerCustomOriginal.ConfigureEditor(AEditor: TBGRAOriginalEditor);
1867 begin
1868   //nothing
1869 end;
1870 
1871 procedure TBGRALayerCustomOriginal.LoadFromFile(AFilenameUTF8: string);
1872 var
1873   s: TFileStreamUTF8;
1874 begin
1875   s := TFileStreamUTF8.Create(AFilenameUTF8, fmOpenRead, fmShareDenyWrite);
1876   try
1877     LoadFromStream(s);
1878   finally
1879     s.Free;
1880   end;
1881 end;
1882 
1883 procedure TBGRALayerCustomOriginal.LoadFromStream(AStream: TStream);
1884 var storage: TBGRAMemOriginalStorage;
1885   memDir: TMemDirectory;
1886 begin
1887   memDir := TMemDirectory.Create;
1888   storage := nil;
1889   try
1890     memDir.LoadFromStream(AStream);
1891     storage := TBGRAMemOriginalStorage.Create(memDir);
1892     if storage.RawString['class'] <> StorageClassName then
1893       raise exception.Create('Invalid class');
1894     LoadFromStorage(storage);
1895     FreeAndNil(storage);
1896   finally
1897     storage.Free;
1898     memDir.Free;
1899   end;
1900 end;
1901 
1902 procedure TBGRALayerCustomOriginal.LoadFromResource(AFilename: string);
1903 var
1904   stream: TStream;
1905 begin
1906   stream := BGRAResource.GetResourceStream(AFilename);
1907   try
1908     LoadFromStream(stream);
1909   finally
1910     stream.Free;
1911   end;
1912 end;
1913 
1914 procedure TBGRALayerCustomOriginal.SaveToFile(AFilenameUTF8: string);
1915 var
1916   s: TFileStreamUTF8;
1917 begin
1918   s := TFileStreamUTF8.Create(AFilenameUTF8, fmCreate);
1919   try
1920     SaveToStream(s);
1921   finally
1922     s.Free;
1923   end;
1924 end;
1925 
1926 procedure TBGRALayerCustomOriginal.SaveToStream(AStream: TStream);
1927 var storage: TBGRAMemOriginalStorage;
1928   memDir: TMemDirectory;
1929 begin
1930   memDir := TMemDirectory.Create;
1931   storage := nil;
1932   try
1933     storage := TBGRAMemOriginalStorage.Create(memDir);
1934     storage.RawString['class'] := StorageClassName;
1935     SaveToStorage(storage);
1936     FreeAndNil(storage);
1937     memDir.SaveToStream(AStream);
1938   finally
1939     storage.Free;
1940     memDir.Free;
1941   end;
1942 end;
1943 
TBGRALayerCustomOriginal.CreateEditornull1944 function TBGRALayerCustomOriginal.CreateEditor: TBGRAOriginalEditor;
1945 begin
1946   result := TBGRAOriginalEditor.Create;
1947 end;
1948 
TBGRALayerCustomOriginal.CanConvertToSVGnull1949 class function TBGRALayerCustomOriginal.CanConvertToSVG: boolean;
1950 begin
1951   result := false;
1952 end;
1953 
TBGRALayerCustomOriginal.IsInfiniteSurfacenull1954 function TBGRALayerCustomOriginal.IsInfiniteSurface: boolean;
1955 begin
1956   result := false;
1957 end;
1958 
ConvertToSVGnull1959 function TBGRALayerCustomOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject;
1960 begin
1961   AOffset := Point(0,0);
1962   raise exception.Create('Not implemented');
1963 end;
1964 
Duplicatenull1965 function TBGRALayerCustomOriginal.Duplicate: TBGRALayerCustomOriginal;
1966 var
1967   storage: TBGRAMemOriginalStorage;
1968   c: TBGRALayerOriginalAny;
1969 begin
1970   c := FindLayerOriginalClass(StorageClassName);
1971   if c = nil then raise exception.Create('Original class is not registered');
1972   storage := TBGRAMemOriginalStorage.Create;
1973   try
1974     SaveToStorage(storage);
1975     result := c.Create;
1976     result.LoadFromStorage(storage);
1977   finally
1978     storage.Free;
1979   end;
1980 end;
1981 
1982 { TBGRALayerImageOriginal }
1983 
GetImageHeightnull1984 function TBGRALayerImageOriginal.GetImageHeight: integer;
1985 begin
1986   if Assigned(FImage) then
1987     result := FImage.Height
1988   else
1989     result := 0;
1990 end;
1991 
TBGRALayerImageOriginal.GetImageWidthnull1992 function TBGRALayerImageOriginal.GetImageWidth: integer;
1993 begin
1994   if Assigned(FImage) then
1995     result := FImage.Width
1996   else
1997     result := 0;
1998 end;
1999 
2000 procedure TBGRALayerImageOriginal.BeginUpdate;
2001 begin
2002   if DiffExpected and (FDiff=nil) then
2003     FDiff := TBGRAImageOriginalDiff.Create(self);
2004 end;
2005 
2006 procedure TBGRALayerImageOriginal.EndUpdate;
2007 begin
2008   if Assigned(FDiff) then FDiff.ComputeDiff(self);
2009   NotifyChange(FDiff);
2010   FDiff := nil;
2011 end;
2012 
2013 procedure TBGRALayerImageOriginal.InternalLoadImageFromStream(AStream: TStream; AUpdate: boolean);
2014 var
2015   newJpegStream: TMemoryStream;
2016   newImage: TBGRABitmap;
2017 begin
2018   if DetectFileFormat(AStream) = ifJpeg then
2019   begin
2020     newJpegStream := TMemoryStream.Create;
2021     try
2022       newJpegStream.CopyFrom(AStream, AStream.Size);
2023       newJpegStream.Position := 0;
2024       newImage := TBGRABitmap.Create(newJpegStream);
2025       if AUpdate then BeginUpdate;
2026       InternalClear;
2027       FImage := newImage;
2028       FJpegStream := newJpegStream;
2029       newImage := nil;
2030       newJpegStream := nil;
2031       if AUpdate then
2032       begin
2033         Inc(FContentVersion);
2034         EndUpdate;
2035       end;
2036     finally
2037       newJpegStream.Free;
2038       newImage.Free;
2039     end;
2040   end else
2041   begin
2042     newImage := TBGRABitmap.Create(AStream);
2043     if AUpdate then BeginUpdate;
2044     InternalClear;
2045     FImage := newImage;
2046     if AUpdate then
2047     begin
2048       Inc(FContentVersion);
2049       EndUpdate;
2050     end;
2051   end;
2052 end;
2053 
2054 procedure TBGRALayerImageOriginal.InternalClear;
2055 begin
2056   if Assigned(FImage) then
2057   begin
2058     FImage.FreeReference;
2059     FImage := nil
2060   end;
2061   FreeAndNil(FJpegStream);
2062 end;
2063 
2064 constructor TBGRALayerImageOriginal.Create;
2065 begin
2066   inherited Create;
2067   FImage := nil;
2068   FContentVersion := 0;
2069   FJpegStream := nil;
2070 end;
2071 
2072 destructor TBGRALayerImageOriginal.Destroy;
2073 begin
2074   FImage.FreeReference;
2075   FJpegStream.Free;
2076   FDiff.Free;
2077   inherited Destroy;
2078 end;
2079 
ConvertToSVGnull2080 function TBGRALayerImageOriginal.ConvertToSVG(const AMatrix: TAffineMatrix; out AOffset: TPoint): TObject;
2081 var
2082   svg: TBGRASVG;
2083   img: TSVGImage;
2084 begin
2085   svg := TBGRASVG.Create(Width, Height, cuPixel);
2086   Result:= svg;
2087   AOffset := Point(0,0);
2088   if Assigned(FJpegStream) then
2089     img := svg.Content.AppendImage(0,0,Width,Height,FJpegStream,'image/jpeg') else
2090   if Assigned(FImage) then
2091     img := svg.Content.AppendImage(0,0,Width,Height,FImage,false);
2092   img.matrix[cuCustom] := AMatrix;
2093 end;
2094 
2095 procedure TBGRALayerImageOriginal.Render(ADest: TBGRABitmap;
2096   AMatrix: TAffineMatrix; ADraft: boolean);
2097 var resampleFilter: TResampleFilter;
2098 begin
2099   if ADraft then resampleFilter := rfBox else resampleFilter:= rfCosine;
2100   if Assigned(FImage) then
2101     ADest.PutImageAffine(AMatrix, FImage, resampleFilter, dmSet);
2102 end;
2103 
GetRenderBoundsnull2104 function TBGRALayerImageOriginal.GetRenderBounds(ADestRect: TRect;
2105   AMatrix: TAffineMatrix): TRect;
2106 var
2107   aff: TAffineBox;
2108 begin
2109   if Assigned(FImage) then
2110   begin
2111     aff := AMatrix*TAffineBox.AffineBox(PointF(0,0),PointF(FImage.Width,0),PointF(0,FImage.Height));
2112     result := aff.RectBounds;
2113   end else
2114     result := EmptyRect;
2115 end;
2116 
2117 procedure TBGRALayerImageOriginal.LoadFromStorage(
2118   AStorage: TBGRACustomOriginalStorage);
2119 var imgStream: TMemoryStream;
2120   newImage: TBGRABitmap;
2121 begin
2122   imgStream := TMemoryStream.Create;
2123   try
2124     if AStorage.ReadFile('content.png', imgStream) then
2125     begin
2126       imgStream.Position:= 0;
2127       newImage := TBGRABitmap.Create(imgStream);
2128       InternalClear;
2129       FImage := newImage;
2130     end else
2131     if AStorage.ReadFile('content.jpg', imgStream) then
2132     begin
2133       imgStream.Position:= 0;
2134       newImage := TBGRABitmap.Create(imgStream);
2135       InternalClear;
2136       FImage := newImage;
2137       FJpegStream := imgStream;
2138       imgStream:= nil;
2139     end else
2140       InternalClear;
2141     FContentVersion := AStorage.Int['content-version'];
2142   finally
2143     imgStream.Free;
2144   end;
2145 end;
2146 
2147 procedure TBGRALayerImageOriginal.SaveToStorage(
2148   AStorage: TBGRACustomOriginalStorage);
2149 var imgStream: TMemoryStream;
2150 begin
2151   if Assigned(FImage) then
2152   begin
2153     if FContentVersion > AStorage.Int['content-version'] then
2154     begin
2155       if Assigned(FJpegStream) then
2156       begin
2157         AStorage.WriteFile('content.jpg', FJpegStream, false);
2158         AStorage.RemoveFile('content.png');
2159         AStorage.Int['content-version'] := FContentVersion;
2160       end else
2161       begin
2162         imgStream := TMemoryStream.Create;
2163         try
2164           FImage.SaveToStreamAsPng(imgStream);
2165           AStorage.RemoveFile('content.jpg');
2166           AStorage.WriteFile('content.png', imgStream, false);
2167           AStorage.Int['content-version'] := FContentVersion;
2168         finally
2169           imgStream.Free;
2170         end;
2171       end;
2172     end;
2173   end else
2174   begin
2175     AStorage.RemoveFile('content.jpg');
2176     AStorage.RemoveFile('content.png');
2177     AStorage.Int['content-version'] := FContentVersion;
2178   end;
2179 end;
2180 
2181 procedure TBGRALayerImageOriginal.LoadFromStream(AStream: TStream);
2182 begin
2183   if TMemDirectory.CheckHeader(AStream) then
2184     inherited LoadFromStream(AStream)
2185   else
2186   begin
2187     InternalLoadImageFromStream(AStream, False);
2188     inc(FContentVersion);
2189   end;
2190 end;
2191 
2192 procedure TBGRALayerImageOriginal.Clear;
2193 begin
2194   BeginUpdate;
2195   InternalClear;
2196   Inc(FContentVersion);
2197   EndUpdate;
2198 end;
2199 
2200 procedure TBGRALayerImageOriginal.LoadImageFromStream(AStream: TStream);
2201 begin
2202   InternalLoadImageFromStream(AStream, True);
2203 end;
2204 
2205 procedure TBGRALayerImageOriginal.SaveImageToStream(AStream: TStream);
2206 begin
2207   if Assigned(FJpegStream) then
2208   begin
2209     FJpegStream.Position := 0;
2210     if AStream.CopyFrom(FJpegStream, FJpegStream.Size)<>FJpegStream.Size then
2211       raise exception.Create('Error while saving');
2212   end else
2213   if Assigned(FImage) then
2214     FImage.SaveToStreamAsPng(AStream)
2215   else raise exception.Create('No image to be saved');
2216 end;
2217 
2218 procedure TBGRALayerImageOriginal.AssignImage(AImage: TBGRACustomBitmap);
2219 var
2220   newImage: TBGRABitmap;
2221 begin
2222   newImage := TBGRABitmap.Create;
2223   newImage.Assign(AImage);
2224   BeginUpdate;
2225   InternalClear;
2226   FImage := newImage;
2227   Inc(FContentVersion);
2228   EndUpdate;
2229 end;
2230 
GetImageCopynull2231 function TBGRALayerImageOriginal.GetImageCopy: TBGRABitmap;
2232 begin
2233   if FImage = nil then result := nil
2234   else result := FImage.Duplicate;
2235 end;
2236 
TBGRALayerImageOriginal.StorageClassNamenull2237 class function TBGRALayerImageOriginal.StorageClassName: RawByteString;
2238 begin
2239   result := 'image';
2240 end;
2241 
TBGRALayerImageOriginal.CanConvertToSVGnull2242 class function TBGRALayerImageOriginal.CanConvertToSVG: boolean;
2243 begin
2244   Result:= true;
2245 end;
2246 
2247 initialization
2248 
2249   RegisterLayerOriginal(TBGRALayerImageOriginal);
2250 
2251 end.
2252 
2253