1 // SPDX-License-Identifier: GPL-3.0-only
2 unit umain;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 uses
9   Classes, SysUtils, Types, FileUtil, Forms, Controls, Graphics, Dialogs,
10   LCLType, ExtCtrls, StdCtrls, ComCtrls, ExtDlgs, Menus, ActnList, LCScaleDPI,
11   BCTrackbarUpdown, BCPanel, BCButton, BGRAVirtualScreen, BGRAImageList,
12   BGRABitmap, BGRABitmapTypes, BGRAGraphics, BGRALazPaint, BGRALayerOriginal,
13   BGRATransform, BGRAGradientScanner, LCVectorOriginal, LCVectorShapes,
14   LCVectorRectShapes, LCVectorPolyShapes, LCVectorTextShapes,
15   LCVectorialFillControl, LCVectorialFill, LCVectorMultishape, fgl;
16 
17 const
18   RenderDelayMs = 100; //minimum delay between the end of the last rendering and the beginning of the next rendering
19   ToolIconSize = 36;
20   ActionIconSize = 24;
21   EditorPointSize = 7;
22   DefaultImageWidth = 640;
23   DefaultImageHeight = 480;
24   PenStyleToStr : array[TPenStyle] of string = ('─────', '─ ─ ─ ─', '···············', '─ · ─ · ─', '─ ·· ─ ·· ╴', 'InsideFrame', 'Pattern', 'Clear');
25   PhongShapeKindToStr: array[TPhongShapeKind] of string = ('Rectangle', 'Round rectangle', 'Half sphere', 'Cone top', 'Cone side',
26                      'Horizontal cylinder', 'Vertical cylinder');
27 
28 type
29   TPaintTool = (ptHand, ptMovePenFillPoint, ptMoveBackFillPoint, ptMoveOutlineFillPoint, ptRectangle, ptEllipse, ptPolyline, ptCurve, ptPolygon, ptClosedCurve,
30                 ptPhongShape, ptText);
31 
32 const
33   PaintToolClass : array[TPaintTool] of TVectorShapeAny =
34     (nil, nil, nil, nil, TRectShape, TEllipseShape, TPolylineShape, TCurveShape, TPolylineShape, TCurveShape,
35      TPhongShape, TTextShape);
36 
IsCreateShapeToolnull37 function IsCreateShapeTool(ATool: TPaintTool): boolean;
38 
39 const
40   SplineStyleToStr : array[TSplineStyle] of string =
41     ('Inside','Inside + ends','Crossing','Crossing + ends','Outside','Round outside','Vertex to side','Easy Bézier');
42 
43   FontBidiModeToStr : array[TFontBidiMode] of string =
44     ('Auto', 'Left to right', 'Right to left');
45 
46 type
47   TOriginalDiffList = specialize TFPGObjectList<TBGRAOriginalDiff>;
48 
49   { TForm1 }
50 
51   TForm1 = class(TForm)
52     OutlineFillControl: TLCVectorialFillControl;
53     ButtonMoveOutlineFillPoints: TToolButton;
54     LOutline: TLabel;
55     PanelOutlineFill: TBCPanel;
56     PanelOutlineFillHead: TPanel;
57     PenFillControl: TLCVectorialFillControl;
58     ButtonMoveBackFillPoints: TToolButton;
59     ButtonMovePenFillPoints: TToolButton;
60     LBack: TLabel;
61     BackFillControl: TLCVectorialFillControl;
62     LPen: TLabel;
63     PanelPenFill: TBCPanel;
64     PanelBackFillHead: TPanel;
65     PanelPenFillHead: TPanel;
66     ShapeSendToBack: TAction;
67     ShapeBringToFront: TAction;
68     ShapeMoveDown: TAction;
69     ShapeMoveUp: TAction;
70     DelayedRenderTimer: TTimer;
71     ToolBarBackFill: TToolBar;
72     ToolBarOutlineFill: TToolBar;
73     ToolBarPenFill: TToolBar;
74     ToolButtonTextShape: TToolButton;
75     UpDownOutlineWidth: TBCTrackbarUpdown;
76     VectorImageList24: TBGRAImageList;
77     ActionList: TActionList;
78     EditCopy: TAction;
79     EditCut: TAction;
80     EditDelete: TAction;
81     EditPaste: TAction;
82     FileNew: TAction;
83     FileOpen: TAction;
84     FileSave: TAction;
85     FileSaveAs: TAction;
86     ButtonPenStyle: TBCButton;
87     Label3: TLabel;
88     PanelBackFill: TBCPanel;
89     PanelBasicStyle: TBCPanel;
90     PanelExtendedStyle: TBCPanel;
91     PanelFile: TBCPanel;
92     PanelShape: TBCPanel;
93     PenStyleImageList: TBGRAImageList;
94     ToolBarFile: TToolBar;
95     ToolBarEdit: TToolBar;
96     ToolBarTop: TToolBar;
97     ToolBarJoinStyle: TToolBar;
98     ToolButton1: TToolButton;
99     ToolButton10: TToolButton;
100     ToolButton11: TToolButton;
101     ToolButton12: TToolButton;
102     ToolButton13: TToolButton;
103     ToolButton3: TToolButton;
104     ToolButton4: TToolButton;
105     ToolButton5: TToolButton;
106     ToolButton6: TToolButton;
107     ToolButton7: TToolButton;
108     ToolButton8: TToolButton;
109     ToolButton9: TToolButton;
110     ToolButtonJoinBevel: TToolButton;
111     ToolButtonJoinMiter: TToolButton;
112     ToolButtonJoinRound: TToolButton;
113     ToolButtonPhongShape: TToolButton;
114     BCPanelToolChoice: TBCPanel;
115     BCPanelToolbar: TBCPanel;
116     ToolImageList48: TBGRAImageList;
117     BGRAVirtualScreen1: TBGRAVirtualScreen;
118     OpenDialog1: TOpenDialog;
119     OpenPictureDialog1: TOpenPictureDialog;
120     SaveDialog1: TSaveDialog;
121     ToolBarTools: TToolBar;
122     ToolButtonPolyline: TToolButton;
123     ToolButtonCurve: TToolButton;
124     ToolButtonMove: TToolButton;
125     ToolButtonClosedCurve: TToolButton;
126     ToolButtonPolygon: TToolButton;
127     ToolButtonRectangle: TToolButton;
128     ToolButtonEllipse: TToolButton;
129     UpDownPenWidth: TBCTrackbarUpdown;
130     procedure BCPanelToolbarResize(Sender: TObject);
131     procedure BCPanelToolChoiceResize(Sender: TObject);
132     procedure BGRAVirtualScreen1Enter(Sender: TObject);
133     procedure BGRAVirtualScreen1Exit(Sender: TObject);
134     procedure BGRAVirtualScreen1MouseWheel(Sender: TObject; {%H-}Shift: TShiftState;
135       WheelDelta: Integer; {%H-}MousePos: TPoint; var {%H-}Handled: Boolean);
136     procedure DelayedRenderTimerTimer(Sender: TObject);
137     procedure EditCopyExecute(Sender: TObject);
138     procedure EditCutExecute(Sender: TObject);
139     procedure EditDeleteExecute(Sender: TObject);
140     procedure EditPasteExecute(Sender: TObject);
141     procedure EditPasteUpdate(Sender: TObject);
142     procedure FileNewExecute(Sender: TObject);
143     procedure FileOpenExecute(Sender: TObject);
144     procedure FileSaveAsExecute(Sender: TObject);
145     procedure FileSaveExecute(Sender: TObject);
146     procedure BackFillControlResize(Sender: TObject);
147     procedure OutlineFillControlResize(Sender: TObject);
148     procedure PanelFileResize(Sender: TObject);
149     procedure PanelShapeResize(Sender: TObject);
150     procedure ShapeBringToFrontExecute(Sender: TObject);
151     procedure ShapeMoveDownExecute(Sender: TObject);
152     procedure ShapeMoveUpExecute(Sender: TObject);
153     procedure ShapeSendToBackExecute(Sender: TObject);
154     procedure ToolButtonJoinClick(Sender: TObject);
155     procedure UpDownOutlineWidthChange(Sender: TObject; AByUser: boolean);
156     procedure UpDownPenWidthChange(Sender: TObject; AByUser: boolean);
157     procedure BGRAVirtualScreen1MouseDown(Sender: TObject;
158       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
159     procedure BGRAVirtualScreen1MouseMove(Sender: TObject; Shift: TShiftState;
160       X, Y: Integer);
161     procedure BGRAVirtualScreen1MouseUp(Sender: TObject; Button: TMouseButton;
162       Shift: TShiftState; X, Y: Integer);
163     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
164     procedure FormCreate(Sender: TObject);
165     procedure FormDestroy(Sender: TObject);
166     procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
167     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
168     procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
169     procedure ToolButtonClick(Sender: TObject);
170   private
171     FSpecialKeyPressed: array[TSpecialKey] of boolean;
172     FLastBackspaceOrDel: boolean;
173     FLastRenderDateTime: TDateTime;
174     FNextRenderDraft: boolean;
175 
176     FPenWidth: single;
177     FPenStyle: TBGRAPenStyle;
178     FPenJoinStyle: TPenJoinStyle;
179     FPenStyleMenu: TPopupMenu;
180     FOutlineWidth: Single;
181 
182     FFlattened: TBGRABitmap;
183     FLastEditorBounds: TRect;
184     FUpdatingFromShape: boolean;
185     FUpdatingSpinEditPenWidth: boolean;
186     FCurrentTool: TPaintTool;
187 
188     FSplineStyle: TSplineStyle;
189     FSplineStyleMenu: TPopupMenu;
190     FComboboxSplineStyle: TBCButton;
191     FSplineToolbar: TToolBar;
192 
193     FPhongShapeKind: TPhongShapeKind;
194     FPhongShapeKindToolbar: TToolBar;
195     FUpDownPhongBorderSize: TBCTrackbarUpdown;
196     FPhongShapeAltitude,FPhongBorderSize: single;
197 
198     FTextToolbar: TToolbar;
199     FTextDirectionButton: TToolButton;
200     FTextFontName: string;
201     FTextFontNameEditing: boolean;
202     FTextFontStyle: TFontStyles;
203     FTextFontHeight: single;
204     FTextAlign: TBidiTextAlignment;
205     FTextAlignButton: array[TAlignment] of TToolButton;
206     FTextDirection: TFontBidiMode;
207     FTextDirectionMenu: TPopupMenu;
208     FTextPenPhong: boolean;
209     FTextAltitudePercent: single;
210 
211     FInRemoveShapeIfEmpty: Boolean;
212     FFullIconHeight: integer;
213     FVectorImageList: TBGRAImageList;
214     procedure ComboBoxSplineStyleClick(Sender: TObject);
GetOriginalZoomFactornull215     function GetOriginalZoomFactor: single;
GetOutlineWidthnull216     function GetOutlineWidth: single;
GetPenStylenull217     function GetPenStyle: TBGRAPenStyle;
GetPenWidthnull218     function GetPenWidth: single;
GetSplineStylenull219     function GetSplineStyle: TSplineStyle;
GetVectorOriginalnull220     function GetVectorOriginal: TVectorOriginal;
GetVectorTransformnull221     function GetVectorTransform: TAffineMatrix;
GetZoomFactornull222     function GetZoomFactor: single;
223     procedure ImageChange(ARectF: TRectF);
224     procedure LoadVectorImages;
225     procedure OnClickSplineStyleItem(ASender: TObject);
226     procedure OnEditingChange({%H-}ASender: TObject; AOriginal: TBGRALayerCustomOriginal);
227     procedure OnEditorFocusChange(Sender: TObject);
228     procedure OnOriginalChange({%H-}ASender: TObject; AOriginal: TBGRALayerCustomOriginal;
229                                var ADiff: TBGRAOriginalDiff);
230     procedure OnPhongBorderSizeChange(Sender: TObject; AByUser: boolean);
231     procedure OnPhongShapeAltitudeChange(Sender: TObject; AByUser: boolean);
232     procedure OnSelectShape(ASender: TObject; AShape: TVectorShape; APreviousShape: TVectorShape);
233     procedure OnClickPenStyle(ASender: TObject);
234     procedure OnTextAltitudePercentChange(Sender: TObject; AByUser: boolean);
235     procedure PhongShapeKindClick(Sender: TObject);
236     procedure RequestBackFillUpdate(Sender: TObject);
237     procedure RequestOutlineFillUpdate(Sender: TObject);
238     procedure OnBackFillChange({%H-}ASender: TObject);
239     procedure SetCurrentTool(AValue: TPaintTool);
240     procedure SetOutlineWidth(AValue: single);
241     procedure SetPenJoinStyle(AValue: TPenJoinStyle);
242     procedure SetPenStyle(AValue: TBGRAPenStyle);
243     procedure SetPenWidth(AValue: single);
244     procedure SetPhongShapeKind(AValue: TPhongShapeKind);
245     procedure SetSplineStyle(AValue: TSplineStyle);
246     procedure SetVectorLayerIndex(AValue: integer);
247     procedure SetZoomFactor(AValue: single);
248     procedure SplineToolbarClick(Sender: TObject);
249     procedure TextPenPhongClick(Sender: TObject);
250     procedure UpdateViewCursor(ACursor: TOriginalEditorCursor);
251     procedure RenderAndUpdate(ADraft: boolean);
252     procedure DoRenderAndUpdate;
253     procedure FocusView;
254     procedure UpdateFlattenedImage(ARect: TRect; AUpdateView: boolean = true);
255     procedure UpdateView(AImageChangeRect: TRect);
256     procedure UpdateToolbarFromShape(AShape: TVectorShape);
257     procedure UpdateTitleBar;
258     procedure ImageChangesCompletely;
CreateShapenull259     function CreateShape(const APoint1, APoint2: TPointF): TVectorShape;
260     procedure RemoveExtendedStyleControls;
261     procedure UpdateBackToolFillPoints;
262     procedure UpdatePenToolFillPoints;
263     procedure UpdateOutlineToolFillPoints;
264     procedure UpdateShapeBackFill;
265     procedure UpdateShapePenFill;
266     procedure UpdateShapeOutlineFill;
267     procedure UpdateShapeUserMode;
268     procedure UpdateShapeActions(AShape: TVectorShape);
269     procedure RemoveShapeIfEmpty(AShape: TVectorShape);
VirtualScreenToImgCoordnull270     function VirtualScreenToImgCoord(X,Y: Integer): TPointF;
271     procedure SetEditorGrid(AActive: boolean);
272     procedure RequestBackFillAdjustToShape(Sender: TObject);
273     procedure PenFillControlResize(Sender: TObject);
274     procedure RequestPenFillAdjustToShape(Sender: TObject);
275     procedure RequestPenFillUpdate(Sender: TObject);
276     procedure RequestOutlineFillAdjustToShape(Sender: TObject);
277     procedure AdjustToolbarTop;
278     procedure UpdateSplineToolbar;
SnapToGridnull279     function SnapToGrid(APoint: TPointF): TPointF;
ImgCoordToOriginalCoordnull280     function ImgCoordToOriginalCoord(APoint: TPointF): TPointF;
281     procedure TextAlignClick(Sender: TObject);
282     procedure OnTextFontHeightChange(Sender: TObject; AByUser: boolean);
283     procedure TextDirClick(Sender: TObject);
284     procedure OnClickTextDirectionItem(Sender: TObject);
285     procedure UpdateTextAlignment;
286     procedure TextStyleClick(Sender: TObject);
287     procedure TextFontTextBoxChange(Sender: TObject);
288     procedure TextFontTextBoxEnter(Sender: TObject);
289     procedure TextFontTextBoxExit(Sender: TObject);
290     procedure NewImage(AWidth,AHeight: integer);
291     procedure SetImage(AImage: TBGRALazPaintImage);
292     procedure AddDiff({%H-}AOriginal: TBGRALayerCustomOriginal; ADiff: TBGRAOriginalDiff);
293   public
294     { public declarations }
295     img: TBGRALazPaintImage;
296     FVectorLayerIndex: Integer;
297     FDiffList: TOriginalDiffList;
298     FDiffListPos,
299     FDiffListSavePos: integer;
300     FDiffAppend: boolean;
301     FDiffLastDate: TDateTime;
302     filename: string;
303     zoom: TAffineMatrix;
304     newShape: TVectorShape;
305     justDown, shapeAdded: boolean;
306     newStartPoint: TPointF;
307     newButton: TMouseButton;
308     mouseState: TShiftState;
309     baseCaption: string;
310     procedure DoCopy;
311     procedure DoCut;
312     procedure DoPaste;
313     procedure DoDelete;
314     procedure DoUndo;
315     procedure DoRedo;
316     property vectorTransform: TAffineMatrix read GetVectorTransform;
317     property penWidth: single read GetPenWidth write SetPenWidth;
318     property penStyle: TBGRAPenStyle read GetPenStyle write SetPenStyle;
319     property outlineWidth: single read GetOutlineWidth write SetOutlineWidth;
320     property splineStyle: TSplineStyle read GetSplineStyle write SetSplineStyle;
321     property currentTool: TPaintTool read FCurrentTool write SetCurrentTool;
322     property joinStyle: TPenJoinStyle read FPenJoinStyle write SetPenJoinStyle;
323     property phongShapeKind: TPhongShapeKind read FPhongShapeKind write SetPhongShapeKind;
324     property originalZoomFactor: single read GetOriginalZoomFactor;
325     property zoomFactor: single read GetZoomFactor write SetZoomFactor;
326     property vectorOriginal: TVectorOriginal read GetVectorOriginal;
327     property vectorLayerIndex: integer read FVectorLayerIndex write SetVectorLayerIndex;
328   end;
329 
330 var
331   Form1: TForm1;
332 
333 implementation
334 
335 uses math, BGRAPen, BGRAThumbnail, BGRAGradientOriginal, LCVectorClipboard, LResources, LCToolbars,
336   BGRAText, BGRAUTF8;
337 
338 {$R *.lfm}
339 
IsCreateShapeToolnull340 function IsCreateShapeTool(ATool: TPaintTool): boolean;
341 begin
342   result := PaintToolClass[ATool] <> nil;
343 end;
344 
345 procedure TForm1.LoadVectorImages;
346 var
347   lst: TStringList;
348   i: Integer;
349 begin
350   FFullIconHeight := ActionIconSize+4;
351   ToolbarTop.ButtonHeight:= 2*FFullIconHeight+3;
352   LBack.Height := FFullIconHeight;
353   LPen.Height := FFullIconHeight;
354   LOutline.Height := FFullIconHeight;
355 
356   if VectorImageList24.Height = ActionIconSize then
357   begin
358     FVectorImageList := VectorImageList24;
359     exit;
360   end;
361 
362   FVectorImageList:= TBGRAImageList.Create(self);
363   FVectorImageList.Width := ActionIconSize;
364   FVectorImageList.Height := ActionIconSize;
365   lst := TStringList.Create;
366   lst.CommaText := GetResourceString('vectorimages.lst');
367   for i := 0 to lst.Count-1 do
368     LoadToolbarImage(FVectorImageList, i, lst[i]);
369   lst.Free;
370 
371   SetToolbarImages(ToolBarFile, FVectorImageList);
372   SetToolbarImages(ToolBarEdit, FVectorImageList);
373   SetToolBarImages(ToolBarBackFill, FVectorImageList);
374   SetToolBarImages(ToolBarPenFill, FVectorImageList);
375   SetToolBarImages(ToolBarOutlineFill, FVectorImageList);
376 end;
377 
378 { TForm1 }
379 
380 procedure TForm1.FormCreate(Sender: TObject);
381 var
382   item: TMenuItem;
383   ps: TPenStyle;
384   ss: TSplineStyle;
385   toolImageList: TBGRAImageList;
386   i: Integer;
387   td: TFontBidiMode;
388 begin
389   baseCaption:= Caption;
390   if ToolIconSize <> ToolImageList48.Width then
391   begin
392     toolImageList := TBGRAImageList.Create(self);
393     ScaleImageList(ToolImageList48, ToolIconSize,ToolIconSize, toolImageList);
394     SetToolbarImages(ToolBarTools, toolImageList);
395   end;
396 
397   LoadVectorImages;
398 
399   for i := 0 to ActionList.ActionCount-1 do
400     with (ActionList.Actions[i] as TAction) do
401       if Hint = '' then Hint := Caption;
402 
403   NewImage(DefaultImageWidth, DefaultImageHeight);
404   zoom := AffineMatrixScale(1,1);
405   FPenStyleMenu := TPopupMenu.Create(nil);
406   item:= TMenuItem.Create(FPenStyleMenu); item.Caption := PenStyleToStr[psClear];
407   item.OnClick := @OnClickPenStyle;       item.Tag := ord(psClear);
408   FPenStyleMenu.Items.Add(item);
409   for ps := psSolid to psDashDotDot do
410   begin
411     item:= TMenuItem.Create(FPenStyleMenu); item.Caption := PenStyleToStr[ps];
412     item.OnClick := @OnClickPenStyle;       item.Tag := ord(ps);
413     FPenStyleMenu.Items.Add(item);
414   end;
415   ButtonPenStyle.DropDownMenu := FPenStyleMenu;
416 
417   PenFillControl.ToolIconSize:= ActionIconSize;
418   PenFillControl.SolidColor := BGRABlack;
419   PenFillControl.GradStartColor := BGRAWhite;
420   PenFillControl.GradEndColor := BGRABlack;
421   PenFillControl.OnFillChange:=@RequestPenFillUpdate;
422   PenFillControl.OnAdjustToShape:=@RequestPenFillAdjustToShape;
423   PenFillControl.OnResize:=@PenFillControlResize;
424 
425   BackFillControl.ToolIconSize:= ActionIconSize;
426   BackFillControl.SolidColor := CSSDodgerBlue;
427   BackFillControl.GradStartColor := MergeBGRA(CSSDodgerBlue,BGRAWhite);
428   BackFillControl.GradEndColor := MergeBGRA(CSSDodgerBlue,BGRABlack);
429   BackFillControl.OnFillChange:= @RequestBackFillUpdate;
430   BackFillControl.OnAdjustToShape:= @RequestBackFillAdjustToShape;
431   BackFillControl.OnResize:= @BackFillControlResize;
432 
433   OutlineFillControl.ToolIconSize:= ActionIconSize;
434   OutlineFillControl.SolidColor := CSSYellow;
435   OutlineFillControl.FillType:= vftNone;
436   OutlineFillControl.GradStartColor := BGRAWhite;
437   OutlineFillControl.GradEndColor := CSSYellow;
438   OutlineFillControl.OnFillChange:= @RequestOutlineFillUpdate;
439   OutlineFillControl.OnAdjustToShape:= @RequestOutlineFillAdjustToShape;
440   OutlineFillControl.OnResize:= @OutlineFillControlResize;
441 
442   FSplineStyleMenu := TPopupMenu.Create(nil);
443   for ss := low(TSplineStyle) to high(TSplineStyle) do
444   begin
445     item := TMenuItem.Create(FSplineStyleMenu); item.Caption := SplineStyleToStr[ss];
446     item.OnClick:=@OnClickSplineStyleItem;      item.Tag := ord(ss);
447     FSplineStyleMenu.Items.Add(item);
448   end;
449 
450   FTextDirectionMenu := TPopupMenu.Create(nil);
451   FTextDirectionMenu.Images := VectorImageList24;
452   for td := low(TFontBidiMode) to high(TFontBidiMode) do
453   begin
454     item := TMenuItem.Create(FTextDirectionMenu); item.Caption := FontBidiModeToStr[td];
455     item.OnClick:=@OnClickTextDirectionItem;      item.Tag := ord(td);
456     item.ImageIndex:= 31+ord(td);
457     FTextDirectionMenu.Items.Add(item);
458   end;
459 
460   newShape:= nil;
461   penWidth := 5;
462   penStyle := SolidPenStyle;
463   outlineWidth := DefaultShapeOutlineWidth;
464   joinStyle:= pjsBevel;
465   currentTool:= ptHand;
466   splineStyle:= ssEasyBezier;
467   FPhongShapeAltitude := DefaultPhongShapeAltitudePercent;
468   FPhongBorderSize := DefaultPhongBorderSizePercent;
469   FTextDirection:= fbmAuto;
470   FTextAlign:= btaNatural;
471   FTextFontName := TTextShape.DefaultFontName;
472   FTextFontStyle:= [];
473   FTextFontHeight:= TTextShape.DefaultFontEmHeight;
474   FTextPenPhong:= false;
475   FTextAltitudePercent:= TTextShape.DefaultAltitudePercent;
476   UpdateBackToolFillPoints;
477   UpdatePenToolFillPoints;
478   UpdateOutlineToolFillPoints;
479   UpdateShapeActions(nil);
480 end;
481 
482 procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
483 var
484   topLeftF, bottomRightF: TPointF;
485   zoomBounds: TRect;
486 begin
487   topLeftF := zoom*PointF(0,0);
488   bottomRightF := zoom*PointF(img.Width,img.Height);
489   zoomBounds := Rect(round(topLeftF.X),round(topLeftF.Y),round(bottomRightF.X),round(bottomRightF.Y));
490   Bitmap.DrawCheckers(zoomBounds, CSSWhite,CSSSilver);
491   if FFlattened = nil then
492     UpdateFlattenedImage(rect(0,0,img.Width,img.Height), false);
493   Bitmap.StretchPutImage(zoomBounds, FFlattened, dmLinearBlend);
494   if vectorLayerIndex <> -1 then
495     FLastEditorBounds := img.DrawEditor(Bitmap, vectorLayerIndex, zoom, EditorPointSize)
496   else
497     FLastEditorBounds := EmptyRect;
498 end;
499 
500 procedure TForm1.BGRAVirtualScreen1MouseDown(Sender: TObject;
501   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
502 var
503   imgPtF: TPointF;
504   cur: TOriginalEditorCursor;
505   handled: boolean;
506 begin
507   FocusView;
508   mouseState:= Shift;
509   if [ssLeft,ssRight]*mouseState = [] then FDiffAppend := false;
510   imgPtF := VirtualScreenToImgCoord(X,Y);
511   SetEditorGrid(ssCtrl in Shift);
512   img.MouseDown(Button=mbRight, Shift, imgPtF.x, imgPtF.y, cur, handled);
513   UpdateViewCursor(cur);
514   if handled then
515   begin
516     UpdateTextAlignment;
517     exit;
518   end;
519 
520   if not justDown and not Assigned(newShape) then
521   begin
522     newStartPoint := ImgCoordToOriginalCoord(imgPtF);
523     newButton := Button;
524     justDown := true;
525   end;
526 end;
527 
528 procedure TForm1.UpDownPenWidthChange(Sender: TObject; AByUser: boolean);
529 begin
530   if FUpdatingSpinEditPenWidth or not AByUser then exit;
531   penWidth := UpDownPenWidth.Value*0.1;
532 end;
533 
534 procedure TForm1.ShapeBringToFrontExecute(Sender: TObject);
535 begin
536   if Assigned(vectorOriginal) and
537      Assigned(vectorOriginal.SelectedShape) then
538   begin
539     vectorOriginal.SelectedShape.BringToFront;
540     UpdateShapeActions(vectorOriginal.SelectedShape);
541   end;
542 end;
543 
544 procedure TForm1.ShapeMoveDownExecute(Sender: TObject);
545 begin
546   if Assigned(vectorOriginal) and
547      Assigned(vectorOriginal.SelectedShape) then
548   begin
549     vectorOriginal.SelectedShape.MoveDown(true);
550     UpdateShapeActions(vectorOriginal.SelectedShape);
551   end;
552 end;
553 
554 procedure TForm1.ShapeMoveUpExecute(Sender: TObject);
555 begin
556   if Assigned(vectorOriginal) and
557      Assigned(vectorOriginal.SelectedShape) then
558   begin
559     vectorOriginal.SelectedShape.MoveUp(true);
560     UpdateShapeActions(vectorOriginal.SelectedShape);
561   end;
562 end;
563 
564 procedure TForm1.ShapeSendToBackExecute(Sender: TObject);
565 begin
566   if Assigned(vectorOriginal) and
567      Assigned(vectorOriginal.SelectedShape) then
568   begin
569     vectorOriginal.SelectedShape.SendToBack;
570     UpdateShapeActions(vectorOriginal.SelectedShape);
571   end;
572 end;
573 
574 procedure TForm1.ToolButtonJoinClick(Sender: TObject);
575 begin
576   if (Sender as TToolButton).Down then
577   begin
578     if Sender = ToolButtonJoinRound then joinStyle := pjsRound else
579     if Sender = ToolButtonJoinBevel then joinStyle := pjsBevel else
580     if Sender = ToolButtonJoinMiter then joinStyle := pjsMiter;
581   end;
582 end;
583 
584 procedure TForm1.UpDownOutlineWidthChange(Sender: TObject; AByUser: boolean);
585 begin
586   if not AByUser then exit;
587   outlineWidth := UpDownOutlineWidth.Value/10;
588 end;
589 
590 procedure TForm1.EditCopyExecute(Sender: TObject);
591 begin
592   DoCopy;
593 end;
594 
595 procedure TForm1.EditCutExecute(Sender: TObject);
596 begin
597   DoCut;
598 end;
599 
600 procedure TForm1.EditDeleteExecute(Sender: TObject);
601 begin
602   DoDelete;
603 end;
604 
605 procedure TForm1.EditPasteExecute(Sender: TObject);
606 begin
607   DoPaste;
608 end;
609 
610 procedure TForm1.EditPasteUpdate(Sender: TObject);
611 begin
612   EditPaste.Enabled := ClipboardHasShapes;
613 end;
614 
615 procedure TForm1.FileNewExecute(Sender: TObject);
616 var
617   dimStr: String;
618   newWidth, newheight, idxX: integer;
619 begin
620   if Assigned(vectorOriginal) then
621   begin
622     try
623       if Assigned(img) then
624         dimStr := inttostr(img.Width)+'x'+inttostr(img.Height)
625       else
626         dimStr := inttostr(DefaultImageWidth)+'x'+inttostr(DefaultImageHeight);
627       dimStr := InputBox('New image','Dimensions:',dimStr);
628       idxX := pos('x',dimStr);
629       if idxX=0 then exit;
630       newWidth := StrToInt(copy(dimStr,1,idxX-1));
631       newheight := StrToInt(copy(dimStr,idxX+1,length(dimStr)-idxX));
632     except
633       on ex:exception do
634       begin
635         ShowMessage(ex.Message);
636         exit;
637       end;
638     end;
639     NewImage(newWidth,newheight);
640   end;
641 end;
642 
643 procedure TForm1.FileOpenExecute(Sender: TObject);
644 var
645   openedImg: TBGRALazPaintImage;
646   openedLayer, i: Integer;
647 begin
648   if OpenDialog1.Execute then
649   begin
650     openedImg := TBGRALazPaintImage.Create;
651     try
652       openedImg.LoadFromFile(OpenDialog1.FileName);
653       openedLayer := -1;
654       for i := 0 to openedImg.NbLayers-1 do
655         if openedImg.LayerOriginalClass[i] = TVectorOriginal then
656         begin
657           openedLayer:= i;
658           break;
659         end;
660       if openedLayer= -1 then raise exception.Create('Cannot find any vector layer');
661 
662       SetImage(openedImg);
663       openedImg := nil;
664       vectorLayerIndex:= openedLayer;
665       filename:= OpenDialog1.FileName;
666       UpdateTitleBar;
667     except
668       on ex: exception do
669         ShowMessage(ex.Message);
670     end;
671     openedImg.Free;
672   end;
673 end;
674 
675 procedure TForm1.FileSaveAsExecute(Sender: TObject);
676 begin
677   if not Assigned(img) then exit;
678   if SaveDialog1.Execute then
679   begin
680     try
681       if Assigned(vectorOriginal) then RemoveShapeIfEmpty(vectorOriginal.SelectedShape);
682       img.SaveToFile(SaveDialog1.FileName);
683       filename := SaveDialog1.FileName;
684       UpdateTitleBar;
685     except
686       on ex: exception do
687         ShowMessage(ex.Message);
688     end;
689   end;
690 end;
691 
692 procedure TForm1.FileSaveExecute(Sender: TObject);
693 begin
694   if filename = '' then
695     FileSaveAs.Execute
696   else
697   begin
698     try
699       if Assigned(vectorOriginal) then RemoveShapeIfEmpty(vectorOriginal.SelectedShape);
700       img.SaveToFile(filename);
701     except
702       on ex: exception do
703         ShowMessage(ex.Message);
704     end;
705   end;
706 end;
707 
708 procedure TForm1.BackFillControlResize(Sender: TObject);
709 begin
710   PanelBackFill.ClientWidth := PanelBackFillHead.Width+BackFillControl.Width+2;
711 end;
712 
713 procedure TForm1.OutlineFillControlResize(Sender: TObject);
714 begin
715   PanelOutlineFill.ClientWidth := PanelOutlineFillHead.Width+OutlineFillControl.Width+2;
716 end;
717 
718 procedure TForm1.PanelFileResize(Sender: TObject);
719 begin
720   ToolBarFile.Width := GetToolbarSize(ToolBarFile).cx;
721   PanelFile.Width := ToolBarFile.Width+3;
722 end;
723 
724 procedure TForm1.PanelShapeResize(Sender: TObject);
725 begin
726   ToolBarEdit.Width := GetToolbarSize(ToolBarEdit).cx;
727   PanelShape.Width := ToolBarEdit.Width+3;
728 end;
729 
730 procedure TForm1.BCPanelToolChoiceResize(Sender: TObject);
731 begin
732   ToolbarTools.Width := GetToolbarSize(ToolbarTools).cx;
733   BCPanelToolChoice.Width := ToolbarTools.Width+3;
734 end;
735 
736 procedure TForm1.BGRAVirtualScreen1Enter(Sender: TObject);
737 begin
738   if Assigned(img) then img.EditorFocused:= true;
739 end;
740 
741 procedure TForm1.BGRAVirtualScreen1Exit(Sender: TObject);
742 begin
743   if Assigned(img) then img.EditorFocused:= false;
744 end;
745 
746 procedure TForm1.BGRAVirtualScreen1MouseWheel(Sender: TObject;
747   Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
748   var Handled: Boolean);
749 begin
750   zoomFactor := zoomFactor*power(2, WheelDelta/240);
751 end;
752 
753 procedure TForm1.DelayedRenderTimerTimer(Sender: TObject);
754 begin
755   DelayedRenderTimer.Enabled:= false;
756   DoRenderAndUpdate;
757 end;
758 
759 procedure TForm1.BCPanelToolbarResize(Sender: TObject);
760 begin
761   AdjustToolbarTop;
762 end;
763 
764 procedure TForm1.BGRAVirtualScreen1MouseMove(Sender: TObject;
765   Shift: TShiftState; X, Y: Integer);
766 var
767   imgPtF, ptF: TPointF;
768   prevRF, rF: TRectF;
769   cur: TOriginalEditorCursor;
770   handled: boolean;
771   vectorFill: TVectorialFill;
772 begin
773   mouseState:= Shift;
774   if [ssLeft,ssRight]*mouseState = [] then FDiffAppend := false;
775   imgPtF := VirtualScreenToImgCoord(X,Y);
776   SetEditorGrid(ssCtrl in Shift);
777   img.MouseMove(Shift, imgPtF.X, imgPtF.Y, cur, handled);
778   if handled then UpdateTextAlignment;
779   UpdateViewCursor(cur);
780 
781   if Assigned(vectorOriginal) then
782   begin
783     ptF := ImgCoordToOriginalCoord(imgPtF);
784     if justDown and not Assigned(newShape) and IsCreateShapeTool(currentTool) and
785       (VectLen(ptF-newStartPoint) >= EditorPointSize) then
786     begin
787       vectorOriginal.DeselectShapes;
788       newShape := CreateShape(newStartPoint,ptF);
789       shapeAdded := false;
790       rF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
791       ImageChange(rF);
792       justDown := false;
793       if IsEmptyRectF(rF) and newShape.CreateEmpty then
794       begin
795         vectorOriginal.DeselectShapes;
796         vectorOriginal.AddShape(newShape);
797         vectorOriginal.SelectShape(newShape);
798         currentTool:= ptHand;
799         shapeAdded := true;
800       end;
801     end else
802     if Assigned(newShape) then
803     begin
804       prevRF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
805       newShape.QuickDefine(newStartPoint,ptF);
806       if (vsfBackFill in newShape.Fields) and (newShape.BackFill.FillType in [vftGradient, vftTexture]) then
807       begin
808         vectorFill := BackFillControl.CreateShapeFill(newShape);
809         newShape.BackFill := vectorFill;
810         vectorFill.Free;
811       end;
812       if (vsfPenFill in newShape.Fields) and (newShape.PenFill.FillType in [vftGradient, vftTexture]) then
813       begin
814         vectorFill := PenFillControl.CreateShapeFill(newShape);
815         newShape.PenFill := vectorFill;
816         vectorFill.Free;
817       end;
818       if (vsfOutlineFill in newShape.Fields) and (newShape.OutlineFill.FillType in [vftGradient, vftTexture]) then
819       begin
820         vectorFill := OutlineFillControl.CreateShapeFill(newShape);
821         newShape.OutlineFill := vectorFill;
822         vectorFill.Free;
823       end;
824       rF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
825       ImageChange(rF.Union(prevRF, true));
826     end;
827   end;
828 end;
829 
830 procedure TForm1.BGRAVirtualScreen1MouseUp(Sender: TObject;
831   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
832 var
833   rF: TRectF;
834   imgPtF: TPointF;
835   handled: boolean;
836   cur: TOriginalEditorCursor;
837   addedShape, curShape: TVectorShape;
838 begin
839   mouseState:= Shift;
840   if [ssLeft,ssRight]*mouseState = [] then FDiffAppend := false;
841   imgPtF := VirtualScreenToImgCoord(X,Y);
842   SetEditorGrid(ssCtrl in Shift);
843   img.MouseUp(Button = mbRight, Shift, imgPtF.X, imgPtF.Y, cur, handled);
844   if handled then
845   begin
846     UpdateTextAlignment;
847     RenderAndUpdate(false);
848   end;
849   UpdateViewCursor(cur);
850 
851   if Assigned(vectorOriginal) then
852   begin
853     if justDown and (Button = newButton) then
854     begin
855       if IsCreateShapeTool(currentTool) and (vsuCreate in PaintToolClass[currentTool].Usermodes) then
856       begin
857         vectorOriginal.DeselectShapes;
858         vectorOriginal.AddShape(CreateShape(newStartPoint,newStartPoint), vsuCreate);
859       end else
860       if IsCreateShapeTool(currentTool) and PaintToolClass[currentTool].CreateEmpty then
861       begin
862         vectorOriginal.DeselectShapes;
863         addedShape := CreateShape(newStartPoint,newStartPoint);
864         vectorOriginal.AddShape(addedShape);
865         vectorOriginal.SelectShape(addedShape);
866         currentTool:= ptHand;
867       end else
868         vectorOriginal.MouseClick(newStartPoint, DoScaleX(6, 96)/zoomFactor*originalZoomFactor,
869                                   ssCtrl in Shift);
870       justDown:= false;
871     end
872     else if Assigned(newShape) and (Button = newButton) then
873     begin
874       if shapeAdded then
875         newShape := nil
876       else
877       begin
878         rF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
879         if not IsEmptyRectF(rF) or (vsuCreate in newShape.Usermodes) then
880         begin
881           addedShape := newShape;
882           newShape := nil;
883           vectorOriginal.AddShape(addedShape, vsuCreate);
884         end
885         else
886         begin
887           FreeAndNil(newShape);
888           ShowMessage('Shape is empty and was not added');
889         end;
890       end;
891     end;
892   end;
893 
894   if Assigned(vectorOriginal) and
895      Assigned(vectorOriginal.SelectedShape) then
896   begin
897     curShape := vectorOriginal.SelectedShape;
898     case currentTool of
899       ptMoveBackFillPoint: if curShape.Usermode <> vsuEditBackFill then currentTool := ptHand;
900       ptMovePenFillPoint: if curShape.Usermode <> vsuEditPenFill then currentTool := ptHand;
901       ptMoveOutlineFillPoint: if curShape.Usermode <> vsuEditOutlineFill then currentTool := ptHand;
902     end;
903   end;
904 end;
905 
906 procedure TForm1.FormDestroy(Sender: TObject);
907 begin
908   RemoveExtendedStyleControls;
909   if (newShape <> nil) and not shapeAdded then FreeAndNil(newShape);
910   img.Free;
911   FDiffList.Free;
912   FFlattened.Free;
913   ButtonPenStyle.DropDownMenu := nil;
914   FPenStyleMenu.Free;
915   FSplineStyleMenu.Free;
916   FTextDirectionMenu.Free;
917 end;
918 
919 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
920 var
921   AHandled: boolean;
922   sk: TSpecialKey;
923 begin
924   FLastBackspaceOrDel:= (Key=VK_BACK) or (Key=VK_DELETE);
925   if FTextFontNameEditing then
926   begin
927     if Key=VK_RETURN then
928     begin
929       FocusView;
930       Key := 0;
931     end;
932     exit;
933   end;
934 
935   if Assigned(img) and img.EditorFocused then
936   begin
937     sk := LCLKeyToSpecialKey(Key, Shift);
938     if sk<>skUnknown then
939     begin
940       FSpecialKeyPressed[sk] := true;
941       img.KeyDown(Shift, sk, AHandled);
942       if AHandled then
943       begin
944         Key := 0;
945         UpdateTextAlignment;
946       end;
947     end;
948   end;
949 
950   if (Key = VK_X) and (ssCtrl in Shift) then
951   begin
952     Key := 0;
953     DoCut;
954   end else
955   if (Key = VK_C) and (ssCtrl in Shift) then
956   begin
957     Key := 0;
958     DoCopy;
959   end else
960   if (Key = VK_V) and (ssCtrl in Shift) then
961   begin
962     Key := 0;
963     DoPaste;
964   end else
965   if Key = VK_DELETE then
966   begin
967     Key := 0;
968     DoDelete;
969   end else
970   if (Key = VK_Z) and ([ssCtrl,ssShift]*Shift=[ssCtrl]) and (FDiffListPos > 0) and
971     not FDiffAppend then
972   begin
973     Key := 0;
974     DoUndo;
975   end else
976   if ( ((Key = VK_Y) and ([ssCtrl,ssShift]*Shift=[ssCtrl])) or
977        ((Key = VK_Z) and ([ssCtrl,ssShift]*Shift=[ssCtrl,ssShift])) )
978      and Assigned(FDiffList) and (FDiffListPos < FDiffList.Count) and
979      not FDiffAppend then
980   begin
981     Key := 0;
982     DoRedo;
983   end else
984   if (Key = VK_RETURN) and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
985   begin
986     Key := 0;
987     vectorOriginal.DeselectShapes;
988   end;
989 end;
990 
991 procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
992 var
993   AHandled: boolean;
994   sk: TSpecialKey;
995 begin
996   sk := LCLKeyToSpecialKey(Key, Shift);
997   if Assigned(img) and FSpecialKeyPressed[sk] then
998   begin
999     img.KeyUp(Shift, sk, AHandled);
1000     FSpecialKeyPressed[sk] := false;
1001     if AHandled then
1002     begin
1003       Key:= 0;
1004       UpdateTextAlignment;
1005     end;
1006   end;
1007 end;
1008 
1009 procedure TForm1.FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
1010 var AHandled: boolean;
1011 begin
1012   FLastBackspaceOrDel:= (UTF8Key=#8);
1013   if FTextFontNameEditing then exit;
1014   if Assigned(img) and img.EditorFocused then
1015   begin
1016     img.KeyPress(UTF8Key, AHandled);
1017     if AHandled then
1018     begin
1019       UTF8Key:= '';
1020       UpdateTextAlignment;
1021     end;
1022   end;
1023 end;
1024 
1025 procedure TForm1.ToolButtonClick(Sender: TObject);
1026 begin
1027   if Sender = ButtonMoveBackFillPoints then
1028     if ButtonMoveBackFillPoints.Down then
1029     begin
1030       ToolButtonMove.Down := true;
1031       ButtonMovePenFillPoints.Down := false;
1032       ButtonMoveOutlineFillPoints.Down := false;
1033     end;
1034   if Sender = ButtonMovePenFillPoints then
1035     if ButtonMovePenFillPoints.Down then
1036     begin
1037       ToolButtonMove.Down := true;
1038       ButtonMoveBackFillPoints.Down := false;
1039       ButtonMoveOutlineFillPoints.Down := false;
1040     end;
1041   if Sender = ButtonMoveOutlineFillPoints then
1042     if ButtonMoveOutlineFillPoints.Down then
1043     begin
1044       ToolButtonMove.Down := true;
1045       ButtonMovePenFillPoints.Down := false;
1046       ButtonMoveBackFillPoints.Down := false;
1047     end;
1048 
1049   FCurrentTool := ptHand;
1050   if ButtonMoveBackFillPoints.Down then FCurrentTool:= ptMoveBackFillPoint;
1051   if ButtonMovePenFillPoints.Down then FCurrentTool:= ptMovePenFillPoint;
1052   if ButtonMoveOutlineFillPoints.Down then FCurrentTool:= ptMoveOutlineFillPoint;
1053   if ToolButtonEllipse.Down then FCurrentTool:= ptEllipse;
1054   if ToolButtonRectangle.Down then FCurrentTool:= ptRectangle;
1055   if ToolButtonPolyline.Down then FCurrentTool:= ptPolyline;
1056   if ToolButtonCurve.Down then FCurrentTool:= ptCurve;
1057   if ToolButtonPolygon.Down then FCurrentTool:= ptPolygon;
1058   if ToolButtonClosedCurve.Down then FCurrentTool:= ptClosedCurve;
1059   if ToolButtonPhongShape.Down then FCurrentTool:= ptPhongShape;
1060   if ToolButtonTextShape.Down then FCurrentTool:= ptText;
1061 
1062   if currentTool <> ptMoveBackFillPoint then ButtonMoveBackFillPoints.Down := false;
1063   if currentTool <> ptMovePenFillPoint then ButtonMovePenFillPoints.Down := false;
1064   if currentTool <> ptMoveOutlineFillPoint then ButtonMoveOutlineFillPoints.Down := false;
1065 
1066   if IsCreateShapeTool(currentTool) then
1067   begin
1068     if Assigned(vectorOriginal) and (vectorOriginal.SelectedShape <> nil) then vectorOriginal.DeselectShapes
1069     else UpdateToolbarFromShape(nil);
1070 
1071     if currentTool in [ptPolyline, ptCurve] then
1072       BackFillControl.FillType := vftNone;
1073   end;
1074 
1075   UpdateShapeUserMode;
1076 
1077   if not Assigned(vectorOriginal) or (vectorOriginal.SelectedShape = nil) then
1078     UpdateToolbarFromShape(nil);
1079 end;
1080 
1081 procedure TForm1.ComboBoxSplineStyleClick(Sender: TObject);
1082 var
1083   btn: TControl;
1084   i: Integer;
1085 begin
1086   if Assigned(FSplineStyleMenu) then
1087   begin
1088     btn := Sender as TControl;
1089     for i := 0 to FSplineStyleMenu.Items.Count-1 do
1090       FSplineStyleMenu.Items[i].Checked:= FSplineStyleMenu.Items[i].Tag=ord(FSplineStyle);
1091     with btn.ClientToScreen(Point(0,btn.Height)) do
1092       FSplineStyleMenu.PopUp(X,Y);
1093   end;
1094 end;
1095 
GetOriginalZoomFactornull1096 function TForm1.GetOriginalZoomFactor: single;
1097 var
1098   m: TAffineMatrix;
1099 begin
1100   m := vectorTransform;
1101   result := (VectLen(PointF(m[1,1],m[2,1]))+VectLen(PointF(m[1,2],m[2,2])))/2;
1102 end;
1103 
TForm1.GetOutlineWidthnull1104 function TForm1.GetOutlineWidth: single;
1105 begin
1106   result := FOutlineWidth;
1107 end;
1108 
GetPenStylenull1109 function TForm1.GetPenStyle: TBGRAPenStyle;
1110 begin
1111   result := FPenStyle;
1112 end;
1113 
GetPenWidthnull1114 function TForm1.GetPenWidth: single;
1115 begin
1116   result := FPenWidth;
1117 end;
1118 
TForm1.GetSplineStylenull1119 function TForm1.GetSplineStyle: TSplineStyle;
1120 begin
1121   result := FSplineStyle;
1122 end;
1123 
GetVectorOriginalnull1124 function TForm1.GetVectorOriginal: TVectorOriginal;
1125 begin
1126   if Assigned(img) and (vectorLayerIndex >= 0) and (vectorLayerIndex < img.NbLayers) and
1127      (img.LayerOriginalClass[vectorLayerIndex] = TVectorOriginal) then
1128    result := img.LayerOriginal[vectorLayerIndex] as TVectorOriginal
1129   else
1130     result := nil
1131 end;
1132 
GetVectorTransformnull1133 function TForm1.GetVectorTransform: TAffineMatrix;
1134 begin
1135   if Assigned(img) and (vectorLayerIndex<>-1) then
1136     result:= img.LayerOriginalMatrix[vectorLayerIndex]
1137   else
1138     result:= AffineMatrixIdentity;
1139 end;
1140 
GetZoomFactornull1141 function TForm1.GetZoomFactor: single;
1142 begin
1143   result := (VectLen(PointF(zoom[1,1],zoom[2,1]))+VectLen(PointF(zoom[1,2],zoom[2,2])))/2;
1144 end;
1145 
1146 procedure TForm1.ImageChange(ARectF: TRectF);
1147 var
1148   changeRect: TRect;
1149 begin
1150   if not IsEmptyRectF(ARectF) then
1151   begin
1152     changeRect := rect(floor(ARectF.Left),floor(ARectF.Top),ceil(ARectF.Right),ceil(ARectF.Bottom));
1153     UpdateFlattenedImage(changeRect);
1154   end;
1155 end;
1156 
1157 procedure TForm1.OnClickSplineStyleItem(ASender: TObject);
1158 begin
1159   splineStyle := TSplineStyle((ASender as TMenuItem).Tag);
1160   UpdateSplineToolbar;
1161 end;
1162 
1163 procedure TForm1.OnClickTextDirectionItem(Sender: TObject);
1164 var
1165   itm: TMenuItem;
1166   td: TFontBidiMode;
1167 begin
1168   itm := TMenuItem(Sender);
1169   td := TFontBidiMode(itm.Tag);
1170   FTextDirection:= td;
1171   if Assigned(FTextDirectionButton) then
1172     FTextDirectionButton.ImageIndex:= 31 + ord(FTextDirection);
1173   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1174     (vectorOriginal.SelectedShape is TTextShape) then
1175   begin
1176     TTextShape(vectorOriginal.SelectedShape).FontBidiMode:= td;
1177     UpdateTextAlignment;
1178   end;
1179 end;
1180 
1181 procedure TForm1.UpdateTextAlignment;
1182 var
1183   alignment: TAlignment;
1184 begin
1185   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1186     (vectorOriginal.SelectedShape is TTextShape) then
1187   begin
1188     FTextAlign:= TTextShape(vectorOriginal.SelectedShape).BidiParagraphAlignment;
1189     alignment := TTextShape(vectorOriginal.SelectedShape).ParagraphAlignment;
1190     if Assigned(FTextAlignButton[alignment]) then FTextAlignButton[alignment].Down := true;
1191   end;
1192 end;
1193 
1194 procedure TForm1.OnEditingChange(ASender: TObject;
1195   AOriginal: TBGRALayerCustomOriginal);
1196 begin
1197   if AOriginal <> vectorOriginal then exit;
1198   UpdateView(EmptyRect);
1199 end;
1200 
1201 procedure TForm1.OnEditorFocusChange(Sender: TObject);
1202 begin
1203   UpdateView(EmptyRect);
1204 end;
1205 
1206 procedure TForm1.OnOriginalChange(ASender: TObject; AOriginal: TBGRALayerCustomOriginal;
1207   var ADiff: TBGRAOriginalDiff);
1208 var
1209   slowShape: boolean;
1210 begin
1211   if AOriginal <> vectorOriginal then exit;
1212   slowShape := false;
1213   if mouseState * [ssLeft,ssRight] <> [] then
1214   begin
1215     if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1216       slowShape := vectorOriginal.SelectedShape.GetIsSlow(vectorTransform);
1217   end;
1218   RenderAndUpdate(slowShape);
1219   AddDiff(AOriginal, ADiff);
1220   ADiff := nil;
1221 end;
1222 
1223 procedure TForm1.OnPhongBorderSizeChange(Sender: TObject; AByUser: boolean);
1224 begin
1225   FPhongBorderSize:= (Sender as TBCTrackbarUpdown).Value;
1226   if AByUser and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1227     (vectorOriginal.SelectedShape is TPhongShape) then
1228     TPhongShape(vectorOriginal.SelectedShape).BorderSizePercent:= FPhongBorderSize;
1229 end;
1230 
1231 procedure TForm1.OnPhongShapeAltitudeChange(Sender: TObject; AByUser: boolean);
1232 begin
1233   FPhongShapeAltitude:= (Sender as TBCTrackbarUpdown).Value;
1234   if AByUser and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1235     (vectorOriginal.SelectedShape is TPhongShape) then
1236     TPhongShape(vectorOriginal.SelectedShape).ShapeAltitudePercent:= FPhongShapeAltitude;
1237 end;
1238 
1239 procedure TForm1.OnSelectShape(ASender: TObject; AShape: TVectorShape;
1240   APreviousShape: TVectorShape);
1241 begin
1242   if ASender <> vectorOriginal then exit;
1243   UpdateToolbarFromShape(AShape);
1244   case currentTool of
1245     ptMoveBackFillPoint: if AShape.Usermode <> vsuEditBackFill then currentTool := ptHand;
1246     ptMovePenFillPoint: if AShape.Usermode <> vsuEditPenFill then currentTool := ptHand;
1247     ptMoveOutlineFillPoint: if AShape.Usermode <> vsuEditOutlineFill then currentTool := ptHand;
1248   end;
1249   UpdateShapeActions(AShape);
1250   RemoveShapeIfEmpty(APreviousShape);
1251 end;
1252 
1253 procedure TForm1.OnClickPenStyle(ASender: TObject);
1254 begin
1255   penStyle := PenStyleToBGRA(TPenStyle((ASender as TMenuItem).Tag));
1256 end;
1257 
1258 procedure TForm1.OnTextAltitudePercentChange(Sender: TObject; AByUser: boolean);
1259 begin
1260   if AByUser then
1261   begin
1262     FTextAltitudePercent:= TBCTrackbarUpdown(Sender).Value;
1263     if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1264     begin
1265       if vectorOriginal.SelectedShape is TTextShape then
1266         TTextShape(vectorOriginal.SelectedShape).AltitudePercent:= FTextAltitudePercent;
1267     end;
1268   end;
1269 end;
1270 
1271 procedure TForm1.OnTextFontHeightChange(Sender: TObject; AByUser: boolean);
1272 begin
1273   if AByUser then
1274   begin
1275     FTextFontHeight:= TBCTrackbarUpdown(Sender).Value;
1276     if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1277     begin
1278       if vectorOriginal.SelectedShape is TTextShape then
1279         TTextShape(vectorOriginal.SelectedShape).FontEmHeight:= FTextFontHeight;
1280     end;
1281   end;
1282 end;
1283 
1284 procedure TForm1.PhongShapeKindClick(Sender: TObject);
1285 begin
1286   if (Sender as TToolButton).Down then
1287     phongShapeKind:= TPhongShapeKind((Sender as TToolButton).Tag);
1288 end;
1289 
1290 procedure TForm1.RequestBackFillUpdate(Sender: TObject);
1291 begin
1292   if not FUpdatingFromShape then
1293   begin
1294     UpdateShapeBackFill;
1295     UpdateBackToolFillPoints;
1296   end;
1297 end;
1298 
1299 procedure TForm1.RequestOutlineFillUpdate(Sender: TObject);
1300 begin
1301   if not FUpdatingFromShape then
1302   begin
1303     UpdateShapeOutlineFill;
1304     UpdateOutlineToolFillPoints;
1305   end;
1306 end;
1307 
1308 procedure TForm1.OnBackFillChange(ASender: TObject);
1309 begin
1310   if not FUpdatingFromShape then
1311     UpdateShapeBackFill;
1312 end;
1313 
1314 procedure TForm1.SetCurrentTool(AValue: TPaintTool);
1315 begin
1316   FCurrentTool:=AValue;
1317   ToolButtonMove.Down := FCurrentTool = ptHand;
1318   ToolButtonRectangle.Down := FCurrentTool = ptRectangle;
1319   ToolButtonEllipse.Down := FCurrentTool = ptEllipse;
1320   ToolButtonPolygon.Down := FCurrentTool = ptPolygon;
1321   ToolButtonClosedCurve.Down := FCurrentTool = ptClosedCurve;
1322   ToolButtonPolyline.Down := FCurrentTool = ptPolyline;
1323   ToolButtonCurve.Down := FCurrentTool = ptCurve;
1324   ToolButtonPhongShape.Down:= FCurrentTool = ptPhongShape;
1325   ButtonMoveBackFillPoints.Down := FCurrentTool = ptMoveBackFillPoint;
1326   ButtonMovePenFillPoints.Down := FCurrentTool = ptMovePenFillPoint;
1327   ButtonMoveOutlineFillPoints.Down := FCurrentTool = ptMoveOutlineFillPoint;
1328   UpdateShapeUserMode;
1329 end;
1330 
1331 procedure TForm1.SetOutlineWidth(AValue: single);
1332 begin
1333   FOutlineWidth := AValue;
1334   UpDownOutlineWidth.Value := round(AValue*10);
1335   if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1336     vectorOriginal.SelectedShape.OutlineWidth:= FOutlineWidth;
1337 end;
1338 
1339 procedure TForm1.SetPenJoinStyle(AValue: TPenJoinStyle);
1340 begin
1341   if FPenJoinStyle=AValue then Exit;
1342   FPenJoinStyle:=AValue;
1343   ToolButtonJoinRound.Down:= FPenJoinStyle = pjsRound;
1344   ToolButtonJoinBevel.Down:= FPenJoinStyle = pjsBevel;
1345   ToolButtonJoinMiter.Down:= FPenJoinStyle = pjsMiter;
1346   if not FUpdatingFromShape and Assigned(vectorOriginal) then
1347   begin
1348     if Assigned(vectorOriginal.SelectedShape) then
1349       vectorOriginal.SelectedShape.JoinStyle := FPenJoinStyle;
1350   end;
1351 end;
1352 
1353 procedure TForm1.SetPenStyle(AValue: TBGRAPenStyle);
1354 begin
1355   FPenStyle := AValue;
1356   ButtonPenStyle.Caption:= PenStyleToStr[BGRAToPenStyle(AValue)];
1357   if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1358     vectorOriginal.SelectedShape.PenStyle := FPenStyle;
1359 end;
1360 
1361 procedure TForm1.SetPenWidth(AValue: single);
1362 var
1363   cur: single;
1364 begin
1365   FPenWidth := AValue;
1366   cur := UpDownPenWidth.Value*0.1;
1367   if AValue <> cur then
1368   begin
1369     FUpdatingSpinEditPenWidth:= true;
1370     UpDownPenWidth.Value := Round(AValue*10);
1371     FUpdatingSpinEditPenWidth:= false;
1372   end;
1373   if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1374     vectorOriginal.SelectedShape.PenWidth:= penWidth;
1375 end;
1376 
1377 procedure TForm1.SetPhongShapeKind(AValue: TPhongShapeKind);
1378 var
1379   btn: TToolButton;
1380   i: Integer;
1381 begin
1382   if FPhongShapeKind=AValue then Exit;
1383   FPhongShapeKind:=AValue;
1384   if Assigned(FPhongShapeKindToolbar) then
1385     for i := 0 to FPhongShapeKindToolbar.ButtonCount-1 do
1386     begin
1387       btn := FPhongShapeKindToolbar.Buttons[i];
1388       if btn.Tag = ord(FPhongShapeKind) then btn.Down := true;
1389     end;
1390   if Assigned(FUpDownPhongBorderSize) then
1391     FUpDownPhongBorderSize.Enabled:= (FPhongShapeKind in[pskRectangle,pskRoundRectangle]);
1392 
1393   if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1394   begin
1395     if vectorOriginal.SelectedShape is TPhongShape then
1396       TPhongShape(vectorOriginal.SelectedShape).ShapeKind:= FPhongShapeKind;
1397   end;
1398 end;
1399 
1400 procedure TForm1.SetSplineStyle(AValue: TSplineStyle);
1401 begin
1402   FSplineStyle := AValue;
1403   if Assigned(FComboboxSplineStyle) then
1404     FComboboxSplineStyle.Caption:= SplineStyleToStr[FSplineStyle];
1405   if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1406     (vectorOriginal.SelectedShape is TCurveShape) then
1407     TCurveShape(vectorOriginal.SelectedShape).SplineStyle := FSplineStyle;
1408 end;
1409 
1410 procedure TForm1.SetVectorLayerIndex(AValue: integer);
1411 var
1412   prevOrig: TVectorOriginal;
1413 begin
1414   if FVectorLayerIndex=AValue then Exit;
1415   prevOrig := vectorOriginal;
1416   if Assigned(prevOrig) then prevOrig.OnSelectShape:= nil;
1417   if Assigned(img) and (AValue >= 0) and (AValue < img.NbLayers) and
1418     (img.LayerOriginalClass[AValue] = TVectorOriginal) then
1419   begin
1420     FVectorLayerIndex:= AValue;
1421     vectorOriginal.OnSelectShape:= @OnSelectShape;
1422   end else
1423     FVectorLayerIndex:= -1;
1424 end;
1425 
1426 procedure TForm1.SetZoomFactor(AValue: single);
1427 begin
1428   zoom := AffineMatrixScale(AValue,AValue);
1429   BGRAVirtualScreen1.DiscardBitmap;
1430 end;
1431 
1432 procedure TForm1.SplineToolbarClick(Sender: TObject);
1433 var
1434   btn: TToolButton;
1435 begin
1436   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1437      (vectorOriginal.SelectedShape is TCurveShape) then
1438   begin
1439     btn := Sender as TToolButton;
1440     if btn.Down then
1441       vectorOriginal.SelectedShape.Usermode := TVectorShapeUsermode(btn.Tag);
1442   end;
1443 end;
1444 
1445 procedure TForm1.TextPenPhongClick(Sender: TObject);
1446 var
1447   btn: TToolButton;
1448 begin
1449   btn := Sender as TToolButton;
1450   FTextPenPhong := btn.Down;
1451   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1452      (vectorOriginal.SelectedShape is TTextShape) then
1453      TTextShape(vectorOriginal.SelectedShape).PenPhong:= FTextPenPhong;
1454 end;
1455 
1456 procedure TForm1.TextFontTextBoxChange(Sender: TObject);
1457 var
1458   i, prevSelStart, prevSelLen: Integer;
1459   tb: TEdit;
1460   fontFound: Boolean;
1461   similarCount,similarIndex, nameLen: integer;
1462   nameTyped: TCaption;
1463 begin
1464   tb := Sender as TEdit;
1465   fontFound := false;
1466   similarCount := 0;
1467   similarIndex := -1;
1468   nameTyped := tb.Text;
1469   nameLen := UTF8Length(nameTyped);
1470   for i := 0 to Screen.Fonts.Count-1 do
1471     if CompareText(nameTyped, Screen.Fonts[i])=0 then
1472     begin
1473       prevSelStart := tb.SelStart;
1474       prevSelLen := tb.SelLength;
1475       tb.Text := Screen.Fonts[i];
1476       tb.SelStart := prevSelStart;
1477       tb.SelLength := prevSelLen;
1478       fontFound := true;
1479       break;
1480     end else
1481     if (tb.SelStart = nameLen) and (CompareText(nameTyped, copy(Screen.Fonts[i],1,length(nameTyped)))=0) then
1482     begin
1483       inc(similarCount);
1484       similarIndex := i;
1485     end;
1486 
1487   if not fontFound and (similarCount = 1) and not FLastBackspaceOrDel then
1488   begin
1489     tb.Text := Screen.Fonts[similarIndex];
1490     tb.SelStart:= nameLen;
1491     tb.SelLength:= UTF8Length(tb.Text)-nameLen;
1492     fontFound := true;
1493   end;
1494 
1495   if fontFound then
1496   begin
1497     FTextFontName := tb.Text;
1498 
1499     if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1500       (vectorOriginal.SelectedShape is TTextShape) then
1501       TTextShape(vectorOriginal.SelectedShape).FontName := FTextFontName;
1502   end;
1503 end;
1504 
1505 procedure TForm1.TextFontTextBoxEnter(Sender: TObject);
1506 begin
1507   FTextFontNameEditing := true;
1508 end;
1509 
1510 procedure TForm1.TextFontTextBoxExit(Sender: TObject);
1511 var
1512   tb: TEdit;
1513 begin
1514   FTextFontNameEditing := false;
1515   tb := Sender as TEdit;
1516   tb.Text := FTextFontName;
1517 end;
1518 
1519 procedure TForm1.NewImage(AWidth, AHeight: integer);
1520 var
1521   orig: TVectorOriginal;
1522   newImg: TBGRALazPaintImage;
1523   layerIndex: Integer;
1524 begin
1525   newImg := TBGRALazPaintImage.Create(AWidth,AHeight);
1526   orig := TVectorOriginal.Create;
1527   layerIndex := newImg.AddLayerFromOwnedOriginal(orig);
1528   SetImage(newImg);
1529   filename := '';
1530   UpdateTitleBar;
1531   vectorLayerIndex := layerIndex;
1532 end;
1533 
1534 procedure TForm1.SetImage(AImage: TBGRALazPaintImage);
1535 begin
1536   FreeAndNil(img);
1537   FreeAndNil(FDiffList);
1538   FDiffListPos := 0;
1539   FDiffListSavePos := 0;
1540   FDiffAppend := false;
1541   img := AImage;
1542   img.OnOriginalEditingChange:= @OnEditingChange;
1543   img.EditorFocused:= BGRAVirtualScreen1.Focused;
1544   img.OnEditorFocusChanged:=@OnEditorFocusChange;
1545   img.OnOriginalChange:= @OnOriginalChange;
1546   FVectorLayerIndex:= -1;
1547   ImageChangesCompletely;
1548 end;
1549 
1550 procedure TForm1.AddDiff(AOriginal: TBGRALayerCustomOriginal;
1551   ADiff: TBGRAOriginalDiff);
1552 const DiffMinDelay = 1000 / (1000*60*60*24);
1553 begin
1554   if ADiff = nil then exit;
1555   if FDiffList=nil then FDiffList := TOriginalDiffList.Create;
1556   while FDiffList.Count > FDiffListPos do FDiffList.Delete(FDiffList.Count-1);
1557   if FDiffListSavePos > FDiffList.Count then FDiffListSavePos:= maxLongint;
1558   if (FDiffList.Count>0) and FDiffList[FDiffList.Count-1].CanAppend(ADiff) and
1559     (FDiffAppend or (Now < FDiffLastDate+DiffMinDelay)) then
1560   begin
1561     FDiffList[FDiffList.Count-1].Append(ADiff);
1562     ADiff.Free;
1563   end
1564   else
1565   begin
1566     FDiffListPos := FDiffList.Add(ADiff)+1;
1567     FDiffAppend:= [ssLeft,ssRight]*mouseState <> [];
1568   end;
1569   FDiffLastDate := Now;
1570   UpdateTitleBar;
1571 end;
1572 
1573 procedure TForm1.TextStyleClick(Sender: TObject);
1574 var
1575   btn: TToolButton;
1576   s: TFontStyle;
1577 begin
1578   btn := Sender as TToolButton;
1579   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
1580     (vectorOriginal.SelectedShape is TTextShape) then
1581   begin
1582     FTextFontStyle := TTextShape(vectorOriginal.SelectedShape).FontStyle;
1583     s := TFontStyle(btn.Tag);
1584     Exclude(FTextFontStyle, s);
1585     if btn.Down then Include(FTextFontStyle, s);
1586     TTextShape(vectorOriginal.SelectedShape).FontStyle := FTextFontStyle;
1587   end;
1588 end;
1589 
1590 procedure TForm1.TextDirClick(Sender: TObject);
1591 var
1592   btn: TToolButton;
1593 begin
1594   btn := TToolButton(Sender);
1595   with btn.ClientToScreen(Point(0,btn.Height)) do
1596     FTextDirectionMenu.PopUp(X,Y);
1597 end;
1598 
1599 procedure TForm1.TextAlignClick(Sender: TObject);
1600 var
1601   alignment: TAlignment;
1602 begin
1603   alignment := TAlignment(TToolButton(Sender).Tag);
1604   FTextAlign:= AlignmentToBidiTextAlignment(alignment, FTextDirection=fbmRightToLeft);
1605   if not FUpdatingFromShape and Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
1606   begin
1607     if vectorOriginal.SelectedShape is TTextShape then
1608     begin
1609       TTextShape(vectorOriginal.SelectedShape).ParagraphAlignment:= alignment;
1610       FTextAlign:= TTextShape(vectorOriginal.SelectedShape).BidiParagraphAlignment;
1611     end;
1612   end;
1613 end;
1614 
1615 procedure TForm1.UpdateViewCursor(ACursor: TOriginalEditorCursor);
1616 begin
1617   case ACursor of
1618     oecDefault: BGRAVirtualScreen1.Cursor := crDefault;
1619     oecMove: BGRAVirtualScreen1.Cursor := crSizeAll;
1620     oecMoveN: BGRAVirtualScreen1.Cursor := crSizeN;
1621     oecMoveS: BGRAVirtualScreen1.Cursor := crSizeS;
1622     oecMoveE: BGRAVirtualScreen1.Cursor := crSizeE;
1623     oecMoveW: BGRAVirtualScreen1.Cursor := crSizeW;
1624     oecMoveNE: BGRAVirtualScreen1.Cursor := crSizeNE;
1625     oecMoveSW: BGRAVirtualScreen1.Cursor := crSizeSW;
1626     oecMoveNW: BGRAVirtualScreen1.Cursor := crSizeNW;
1627     oecMoveSE: BGRAVirtualScreen1.Cursor := crSizeSE;
1628     oecHandPoint: BGRAVirtualScreen1.Cursor := crHandPoint;
1629     oecText: BGRAVirtualScreen1.Cursor := crIBeam;
1630   end;
1631 end;
1632 
1633 procedure TForm1.RenderAndUpdate(ADraft: boolean);
1634 const
1635   MsInDay = 1000*60*60*24;
1636   RenderDelayDateTime = RenderDelayMs/MsInDay;
1637 var
1638   nowValue: TDateTime;
1639 begin
1640   nowValue := Now;
1641   FNextRenderDraft := ADraft;
1642   if (FLastRenderDateTime = 0) or (nowValue - FLastRenderDateTime >= RenderDelayDateTime) then
1643   begin
1644     DoRenderAndUpdate;
1645     DelayedRenderTimer.Enabled := false;
1646   end
1647   else
1648   if not DelayedRenderTimer.Enabled then
1649   begin
1650     DelayedRenderTimer.Interval:= max(round(RenderDelayMs - (nowValue - FLastRenderDateTime)*MsInDay), 1);
1651     DelayedRenderTimer.Enabled := true;
1652   end;
1653 end;
1654 
1655 procedure TForm1.DoRenderAndUpdate;
1656 var
1657   renderedRect: TRect;
1658 begin
1659   renderedRect := img.RenderOriginalsIfNecessary(FNextRenderDraft);
1660   UpdateFlattenedImage(renderedRect);
1661   FLastRenderDateTime:= Now;
1662 end;
1663 
1664 procedure TForm1.FocusView;
1665 begin
1666   if not BGRAVirtualScreen1.Focused then BGRAVirtualScreen1.SetFocus;
1667 end;
1668 
1669 procedure TForm1.UpdateFlattenedImage(ARect: TRect; AUpdateView: boolean);
1670 var
1671   shapeRectF: TRectF;
1672   shapeRect: TRect;
1673 begin
1674   img.FreezeExceptOneLayer(vectorLayerIndex);
1675   if FFlattened = nil then
1676     FFlattened := img.ComputeFlatImage
1677   else
1678   if not IsRectEmpty(ARect) then
1679   begin
1680     FFlattened.FillRect(ARect,BGRAPixelTransparent,dmSet);
1681     FFlattened.ClipRect := ARect;
1682     img.Draw(FFlattened, 0,0);
1683     FFlattened.NoClip;
1684   end;
1685 
1686   if Assigned(newShape) and not IsRectEmpty(ARect) then
1687   begin
1688     shapeRectF := newShape.GetRenderBounds(InfiniteRect, vectorTransform);
1689     with shapeRectF do
1690       shapeRect := rect(floor(Left),floor(Top),ceil(Right),ceil(Bottom));
1691     if IntersectRect(shapeRect, shapeRect, ARect) then
1692     begin
1693       FFlattened.ClipRect := shapeRect;
1694       newShape.Render(FFlattened, vectorTransform, newShape.GetIsSlow(vectorTransform));
1695       FFlattened.NoClip;
1696     end;
1697   end;
1698 
1699   if AUpdateView then
1700     UpdateView(ARect);
1701 end;
1702 
1703 procedure TForm1.UpdateView(AImageChangeRect: TRect);
1704 var
1705   viewRectF: TRectF;
1706   viewRect, newEditorBounds: TRect;
1707 begin
1708   if IsRectEmpty(AImageChangeRect) then
1709   begin
1710     viewRectF := EmptyRectF;
1711     viewRect := EmptyRect;
1712   end
1713   else
1714   begin
1715     with AImageChangeRect do
1716       viewRectF := RectF(zoom* PointF(Left,Top), zoom* PointF(Right,Bottom));
1717     viewRect := rect(floor(viewRectF.Left),floor(viewRectF.Top),ceil(viewRectF.Right),ceil(viewRectF.Bottom));
1718   end;
1719 
1720   if not IsRectEmpty(FLastEditorBounds) then
1721   begin
1722     if IsRectEmpty(viewRect) then viewRect := FLastEditorBounds else
1723       UnionRect(viewRect,viewRect,FLastEditorBounds);
1724   end;
1725   if Assigned(img) then
1726   begin
1727     if vectorLayerIndex<>-1 then
1728     begin
1729       newEditorBounds := img.GetEditorBounds(vectorLayerIndex, zoom, EditorPointSize);
1730       if not IsRectEmpty(newEditorBounds) then
1731       begin
1732         if IsRectEmpty(viewRect) then viewRect := newEditorBounds else
1733           UnionRect(viewRect,viewRect,newEditorBounds);
1734       end;
1735     end;
1736   end;
1737 
1738   if not IsRectEmpty(viewRect) then
1739   begin
1740     viewRect.Inflate(1,1);
1741     BGRAVirtualScreen1.RedrawBitmap(viewRect);
1742   end;
1743 end;
1744 
1745 procedure TForm1.UpdateToolbarFromShape(AShape: TVectorShape);
1746 var
1747   f: TVectorShapeFields;
1748   nextControlPos: TPoint;
1749   mode: TVectorShapeUsermode;
1750   sk: TPhongShapeKind;
1751   btn: TToolButton;
1752   toolClass: TVectorShapeAny;
1753   alignment : TAlignment;
1754   tb: TEdit;
1755   fh: TBCTrackbarUpdown;
1756 begin
1757   RemoveExtendedStyleControls;
1758   alignment := BidiTextAlignmentToAlignment(FTextAlign, FTextDirection=fbmRightToLeft);
1759 
1760   if AShape <> nil then
1761   begin
1762     FUpdatingFromShape := true;
1763     mode := AShape.Usermode;
1764     f := AShape.MultiFields;
1765     toolClass := TVectorShapeAny(AShape.ClassType);
1766     if vsfPenFill in f then PenFillControl.AssignFill(AShape.PenFill);
1767     if vsfPenWidth in f then penWidth:= AShape.PenWidth;
1768     if vsfPenStyle in f then penStyle:= AShape.PenStyle;
1769     if vsfJoinStyle in f then joinStyle:= AShape.JoinStyle;
1770 
1771     if vsfBackFill in f then BackFillControl.AssignFill(AShape.BackFill);
1772     if vsfOutlineFill in f then
1773     begin
1774       OutlineFillControl.AssignFill(AShape.OutlineFill);
1775       outlineWidth := AShape.OutlineWidth;
1776     end;
1777 
1778     if AShape is TCurveShape then
1779       splineStyle:= TCurveShape(AShape).SplineStyle;
1780 
1781     if AShape is TPhongShape then
1782     begin
1783       phongShapeKind:= TPhongShape(AShape).ShapeKind;
1784       FPhongShapeAltitude:= TPhongShape(AShape).ShapeAltitudePercent;
1785       FPhongBorderSize:= TPhongShape(AShape).BorderSizePercent;
1786     end;
1787     if AShape is TTextShape then
1788     begin
1789       FTextAlign:= TTextShape(AShape).BidiParagraphAlignment;
1790       alignment := TTextShape(AShape).ParagraphAlignment;
1791       FTextFontHeight:= TTextShape(AShape).FontEmHeight;
1792       FTextFontName:= TTextShape(AShape).FontName;
1793       FTextFontStyle:= TTextShape(AShape).FontStyle;
1794       FTextDirection:= TTextShape(AShape).FontBidiMode;
1795       FTextPenPhong:= TTextShape(AShape).PenPhong;
1796       FTextAltitudePercent:= TTextShape(AShape).AltitudePercent;
1797     end;
1798 
1799     FUpdatingFromShape := false;
1800     PanelPenFill.Visible := vsfPenFill in f;
1801     PanelBackFill.Visible := vsfBackFill in f;
1802     PanelOutlineFill.Visible := vsfOutlineFill in f;
1803   end else
1804   begin
1805     toolClass:= PaintToolClass[currentTool];
1806     mode := vsuEdit;
1807     if IsCreateShapeTool(currentTool) then
1808     begin
1809       f := PaintToolClass[currentTool].Fields;
1810       PanelPenFill.Visible := vsfPenFill in f;
1811       PanelBackFill.Visible := vsfBackFill in f;
1812       PanelOutlineFill.Visible := vsfOutlineFill in f;
1813     end
1814     else
1815     begin
1816       f := [];
1817       PanelPenFill.Visible := true;
1818       PanelBackFill.Visible := true;
1819       PanelOutlineFill.Visible := true;
1820     end;
1821   end;
1822   UpdateBackToolFillPoints;
1823   UpdatePenToolFillPoints;
1824   UpdateOutlineToolFillPoints;
1825   UpDownPenWidth.Enabled := vsfPenWidth in f;
1826   ButtonPenStyle.Enabled:= vsfPenStyle in f;
1827   EnableDisableToolButtons([ToolButtonJoinRound,ToolButtonJoinBevel,ToolButtonJoinMiter], vsfJoinStyle in f);
1828   PanelBasicStyle.Visible := [vsfPenWidth,vsfPenStyle,vsfJoinStyle]*f <> [];
1829 
1830   PanelExtendedStyle.Visible := false;
1831   nextControlPos := Point(1,1);
1832 
1833   if toolClass = TCurveShape then
1834   begin
1835     PanelExtendedStyle.Visible := true;
1836 
1837     FSplineToolbar := CreateToolBar(FVectorImageList);
1838     FSplineToolbar.Left := nextControlPos.X;
1839     FSplineToolbar.Top := nextControlPos.Y;
1840     FSplineToolbar.Wrapable := false;
1841 
1842     AddToolbarCheckButton(FSplineToolbar, 'Move spline points', 20, @SplineToolbarClick, mode in [vsuEdit, vsuCreate], true, ord(vsuEdit));
1843     AddToolbarCheckButton(FSplineToolbar, 'Set to autodetect angle (A)', 21, @SplineToolbarClick, mode = vsuCurveSetAuto, true, ord(vsuCurveSetAuto));
1844     AddToolbarCheckButton(FSplineToolbar, 'Set to smooth (S)', 22, @SplineToolbarClick, mode = vsuCurveSetCurve, true, ord(vsuCurveSetCurve));
1845     AddToolbarCheckButton(FSplineToolbar, 'Set to angle (X)', 23, @SplineToolbarClick, mode = vsuCurveSetAngle, true, ord(vsuCurveSetAngle)).Wrap:= true;
1846 
1847     FComboboxSplineStyle := TBCButton.Create(FSplineToolbar);
1848     FComboboxSplineStyle.Style := bbtButton;
1849     FComboboxSplineStyle.Caption:= SplineStyleToStr[splineStyle];
1850     FComboboxSplineStyle.Width := 4*FSplineToolbar.ButtonWidth;
1851     FComboboxSplineStyle.Height := FSplineToolbar.ButtonHeight;
1852     FComboboxSplineStyle.OnClick:=@ComboBoxSplineStyleClick;
1853     FComboboxSplineStyle.StateNormal.Assign(ButtonPenStyle.StateNormal);
1854     FComboboxSplineStyle.StateHover.Assign(ButtonPenStyle.StateHover);
1855     FComboboxSplineStyle.StateClicked.Assign(ButtonPenStyle.StateClicked);
1856     FComboboxSplineStyle.Rounding.Assign(ButtonPenStyle.Rounding);
1857     FComboboxSplineStyle.DropDownArrow:= ButtonPenStyle.DropDownArrow;
1858     FComboboxSplineStyle.DropDownArrowSize:= ButtonPenStyle.DropDownArrowSize;
1859     AddToolbarControl(FSplineToolbar, FComboboxSplineStyle);
1860 
1861     UpdateSplineToolbar;
1862     PanelExtendedStyle.InsertControl(FSplineToolbar);
1863 
1864     with GetToolbarSize(FSplineToolbar,0) do
1865     begin
1866       FSplineToolbar.Width := cx+1;
1867       FSplineToolbar.Height := cy+1;
1868     end;
1869 
1870     nextControlPos.X := FSplineToolbar.Left + FSplineToolbar.Width;
1871   end;
1872 
1873   if toolClass = TPhongShape then
1874   begin
1875     PanelExtendedStyle.Visible := true;
1876 
1877     FPhongShapeKindToolbar := CreateToolBar(FVectorImageList);
1878     FPhongShapeKindToolbar.Left := nextControlPos.X;
1879     FPhongShapeKindToolbar.Top := nextControlPos.Y;
1880     FPhongShapeKindToolbar.Wrapable := false;
1881 
1882     AddToolbarLabel(FPhongShapeKindToolbar, 'Shape', self);
1883 
1884     for sk := low(TPhongShapeKind) to high(TPhongShapeKind) do
1885     begin
1886       btn := AddToolbarCheckButton(FPhongShapeKindToolbar, PhongShapeKindToStr[sk], 13+ord(sk), @PhongShapeKindClick, FPhongShapeKind = sk, true, ord(sk));
1887       if sk = high(TPhongShapeKind) then btn.Wrap:= true;
1888     end;
1889 
1890     AddToolbarLabel(FPhongShapeKindToolbar, 'Altitude', self);
1891     AddToolbarUpdown(FPhongShapeKindToolbar, 'Altitude', 0, 100, round(FPhongShapeAltitude), @OnPhongShapeAltitudeChange);
1892 
1893     AddToolbarLabel(FPhongShapeKindToolbar, 'Border', self);
1894     FUpDownPhongBorderSize := AddToolbarUpdown(FPhongShapeKindToolbar, 'Border size', 0, 100, round(FPhongBorderSize), @OnPhongBorderSizeChange);
1895     FUpDownPhongBorderSize.Enabled:= (phongShapeKind in[pskRectangle,pskRoundRectangle]);
1896 
1897     PanelExtendedStyle.InsertControl(FPhongShapeKindToolbar);
1898     with GetToolbarSize(FPhongShapeKindToolbar,0) do
1899     begin
1900       FPhongShapeKindToolbar.Width := cx+1;
1901       FPhongShapeKindToolbar.Height := cy+1;
1902     end;
1903 
1904     nextControlPos.X := FPhongShapeKindToolbar.Left + FPhongShapeKindToolbar.Width;
1905   end;
1906 
1907   if toolClass = TTextShape then
1908   begin
1909     PanelExtendedStyle.Visible := true;
1910 
1911     FTextToolbar := CreateToolBar(FVectorImageList);
1912     FTextToolbar.Left := nextControlPos.X;
1913     FTextToolbar.Top := nextControlPos.Y;
1914     FTextToolbar.Wrapable := false;
1915 
1916     AddToolbarLabel(FTextToolbar, 'Font', self);
1917     tb := AddToolbarTextBox(FTextToolbar, 'Font familiy', FTextFontName, @TextFontTextBoxChange);
1918     tb.OnEnter:=@TextFontTextBoxEnter;
1919     tb.OnExit:=@TextFontTextBoxExit;
1920     //AddToolbarButton(FTextToolbar, 'Choose font', 25, @TextChooseFontClick);
1921     FTextDirectionButton := AddToolbarButton(FTextToolbar, 'Text direction', 31 + ord(FTextDirection), @TextDirClick);
1922     FTextAlignButton[taLeftJustify] := AddToolbarCheckButton(FTextToolbar, 'Left align', 26, @TextAlignClick, alignment = taLeftJustify, True, ord(taLeftJustify));
1923     FTextAlignButton[taCenter] := AddToolbarCheckButton(FTextToolbar, 'Center', 27, @TextAlignClick, alignment = taCenter, True, ord(taCenter));
1924     FTextAlignButton[taRightJustify] := AddToolbarCheckButton(FTextToolbar, 'Right align', 28, @TextAlignClick, alignment = taRightJustify, True, ord(taRightJustify));
1925     FTextAlignButton[taRightJustify].Wrap:=true;
1926 
1927     AddToolbarCheckButton(FTextToolbar, 'Bold', 34, @TextStyleClick, fsBold in FTextFontStyle, false, ord(fsBold));
1928     AddToolbarCheckButton(FTextToolbar, 'Italic', 35, @TextStyleClick, fsItalic in FTextFontStyle, false, ord(fsItalic));
1929     AddToolbarCheckButton(FTextToolbar, 'Underline', 36, @TextStyleClick, fsUnderline in FTextFontStyle, false, ord(fsUnderline));
1930     AddToolbarCheckButton(FTextToolbar, 'Strike-out', 37, @TextStyleClick, fsStrikeOut in FTextFontStyle, false, ord(fsStrikeOut));
1931     AddToolbarLabel(FTextToolbar, 'Height', self);
1932     fh := AddToolbarUpdown(FTextToolbar, 'Font height', 1, 900, round(FTextFontHeight), @OnTextFontHeightChange);
1933     fh.BarExponent:= 3;
1934     AddToolbarCheckButton(FTextToolbar, 'Phong lighting', 15, @TextPenPhongClick, FTextPenPhong, false);
1935     fh := AddToolbarUpdown(FTextToolbar, 'Altitude', 1, 100, round(FTextAltitudePercent), @OnTextAltitudePercentChange);
1936     fh.BarExponent:= 3;
1937 
1938     PanelExtendedStyle.InsertControl(FTextToolbar);
1939     with GetToolbarSize(FTextToolbar,0) do
1940     begin
1941       FTextToolbar.Width := cx+1;
1942       FTextToolbar.Height := cy+1;
1943     end;
1944 
1945     nextControlPos.X := FTextToolbar.Left + FTextToolbar.Width;
1946   end;
1947 
1948   PanelExtendedStyle.Width := nextControlPos.X+1;
1949 
1950   AdjustToolbarTop;
1951 end;
1952 
1953 procedure TForm1.UpdateTitleBar;
1954 var
1955   modifStr: string;
1956 begin
1957   if Assigned(FDiffList) and (FDiffListPos <> FDiffListSavePos) then
1958     modifStr := '*' else modifStr := '';
1959   if filename = '' then
1960     Caption := baseCaption + ' - New image'+modifStr+' - ' + inttostr(img.Width)+'x'+inttostr(img.Height)
1961   else
1962     Caption := baseCaption + ' - ' + filename + modifStr+' - ' + inttostr(img.Width)+'x'+inttostr(img.Height);
1963 end;
1964 
1965 procedure TForm1.ImageChangesCompletely;
1966 begin
1967   FreeAndNil(FFlattened);
1968   BGRAVirtualScreen1.DiscardBitmap;
1969 end;
1970 
TForm1.CreateShapenull1971 function TForm1.CreateShape(const APoint1,APoint2: TPointF): TVectorShape;
1972 var
1973   vectorFill: TVectorialFill;
1974 begin
1975   if not IsCreateShapeTool(currentTool) then
1976     raise exception.Create('No shape type selected');
1977   result := PaintToolClass[currentTool].Create(vectorOriginal);
1978   if (result is TCustomPolypointShape) and (BackFillControl.FillType = vftGradient) then BackFillControl.FillType := vftSolid;
1979   if (result is TCustomPolypointShape) and (PenFillControl.FillType = vftGradient) then PenFillControl.FillType := vftSolid;
1980   if (result is TCustomPolypointShape) and (OutlineFillControl.FillType = vftGradient) then OutlineFillControl.FillType := vftSolid;
1981   result.PenWidth := penWidth;
1982   result.PenStyle := penStyle;
1983   if vsfJoinStyle in result.Fields then result.JoinStyle := joinStyle;
1984   if currentTool in[ptClosedCurve,ptPolygon] then
1985     TCustomPolypointShape(result).Closed := true;
1986   if result is TCurveShape then TCurveShape(result).SplineStyle:= splineStyle;
1987   if result is TPhongShape then
1988   begin
1989     with TPhongShape(result) do
1990     begin
1991       ShapeKind:= FPhongShapeKind;
1992       ShapeAltitudePercent:= FPhongShapeAltitude;
1993       BorderSizePercent:= FPhongBorderSize;
1994     end;
1995   end;
1996   if result is TTextShape then
1997   begin
1998     TTextShape(result).FontName:= FTextFontName;
1999     TTextShape(result).FontStyle:= FTextFontStyle;
2000     TTextShape(result).FontEmHeight:= FTextFontHeight;
2001     TTextShape(result).FontBidiMode:= FTextDirection;
2002     TTextShape(result).UserMode := vsuEditText;
2003   end;
2004   result.QuickDefine(APoint1,APoint2);
2005   if vsfBackFill in result.Fields then
2006   begin
2007     vectorFill := BackFillControl.CreateShapeFill(result);
2008     result.BackFill := vectorFill;
2009     vectorFill.Free;
2010   end;
2011   if vsfPenFill in result.Fields then
2012   begin
2013     vectorFill := PenFillControl.CreateShapeFill(result);
2014     result.PenFill := vectorFill;
2015     vectorFill.Free;
2016   end;
2017   if vsfOutlineFill in result.Fields then
2018   begin
2019     vectorFill := OutlineFillControl.CreateShapeFill(result);
2020     result.OutlineFill := vectorFill;
2021     vectorFill.Free;
2022     result.OutlineWidth:= outlineWidth;
2023   end;
2024 end;
2025 
2026 procedure TForm1.RemoveExtendedStyleControls;
2027 var
2028   a: TAlignment;
2029 begin
2030   if Assigned(FSplineToolbar) then
2031   begin
2032     PanelExtendedStyle.RemoveControl(FSplineToolbar);
2033     FreeAndNil(FSplineToolbar);
2034     FComboboxSplineStyle := nil;
2035   end;
2036   if Assigned(FPhongShapeKindToolbar) then
2037   begin
2038     PanelExtendedStyle.RemoveControl(FPhongShapeKindToolbar);
2039     FreeAndNil(FPhongShapeKindToolbar);
2040     FUpDownPhongBorderSize := nil;
2041   end;
2042   if Assigned(FTextToolbar) then
2043   begin
2044     PanelExtendedStyle.RemoveControl(FTextToolbar);
2045     FreeAndNil(FTextToolbar);
2046     FTextDirectionButton := nil;
2047     for a := low(TAlignment) to high(TAlignment) do
2048       FTextAlignButton[a] := nil;
2049   end;
2050 end;
2051 
2052 procedure TForm1.UpdateBackToolFillPoints;
2053 var
2054   canEdit: Boolean;
2055 begin
2056   canEdit := (BackFillControl.FillType in[vftGradient,vftTexture]) and
2057     Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape);
2058   ButtonMoveBackFillPoints.Enabled := canEdit;
2059   if (currentTool = ptMoveBackFillPoint) and not canEdit then currentTool:= ptHand;
2060 end;
2061 
2062 procedure TForm1.UpdatePenToolFillPoints;
2063 var
2064   canEdit: Boolean;
2065 begin
2066   canEdit := (PenFillControl.FillType in[vftGradient,vftTexture]) and
2067     Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape);
2068   ButtonMovePenFillPoints.Enabled := canEdit;
2069   if (currentTool = ptMovePenFillPoint) and not canEdit then currentTool:= ptHand;
2070 end;
2071 
2072 procedure TForm1.UpdateOutlineToolFillPoints;
2073 var
2074   canEdit: Boolean;
2075 begin
2076   canEdit := (OutlineFillControl.FillType in[vftGradient,vftTexture]) and
2077     Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape);
2078   ButtonMoveOutlineFillPoints.Enabled := canEdit;
2079   if (currentTool = ptMoveOutlineFillPoint) and not canEdit then currentTool:= ptHand;
2080 end;
2081 
2082 procedure TForm1.UpdateShapeBackFill;
2083 begin
2084   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
2085     (vsfBackFill in vectorOriginal.SelectedShape.MultiFields) then
2086     BackFillControl.UpdateShapeFill(vectorOriginal.SelectedShape, ftBack);
2087 end;
2088 
2089 procedure TForm1.UpdateShapePenFill;
2090 begin
2091   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
2092     (vsfPenFill in vectorOriginal.SelectedShape.MultiFields) then
2093     PenFillControl.UpdateShapeFill(vectorOriginal.SelectedShape, ftPen);
2094 end;
2095 
2096 procedure TForm1.UpdateShapeOutlineFill;
2097 begin
2098   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
2099     (vsfOutlineFill in vectorOriginal.SelectedShape.MultiFields) then
2100     OutlineFillControl.UpdateShapeFill(vectorOriginal.SelectedShape, ftOutline);
2101 end;
2102 
2103 procedure TForm1.UpdateShapeUserMode;
2104 begin
2105   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
2106   begin
2107     if (currentTool = ptMoveBackFillPoint) and
2108        (vsfBackFill in vectorOriginal.SelectedShape.MultiFields) and
2109        vectorOriginal.SelectedShape.BackFill.IsEditable then
2110     begin
2111       if vectorOriginal.SelectedShape.Usermode <> vsuEditBackFill then
2112         vectorOriginal.SelectedShape.Usermode := vsuEditBackFill;
2113     end else
2114     if (currentTool = ptMovePenFillPoint) and
2115        (vsfPenFill in vectorOriginal.SelectedShape.MultiFields) and
2116        vectorOriginal.SelectedShape.PenFill.IsEditable then
2117     begin
2118       if vectorOriginal.SelectedShape.Usermode <> vsuEditPenFill then
2119         vectorOriginal.SelectedShape.Usermode := vsuEditPenFill;
2120     end else
2121     if (currentTool = ptMoveOutlineFillPoint) and
2122        (vsfOutlineFill in vectorOriginal.SelectedShape.MultiFields) and
2123        vectorOriginal.SelectedShape.OutlineFill.IsEditable then
2124     begin
2125       if vectorOriginal.SelectedShape.Usermode <> vsuEditOutlineFill then
2126         vectorOriginal.SelectedShape.Usermode := vsuEditOutlineFill;
2127     end else
2128     begin
2129       if vectorOriginal.SelectedShape.Usermode in[vsuEditPenFill,vsuEditBackFill,vsuEditOutlineFill] then
2130         vectorOriginal.SelectedShape.Usermode := vsuEdit;
2131     end;
2132   end;
2133 end;
2134 
2135 procedure TForm1.UpdateShapeActions(AShape: TVectorShape);
2136 begin
2137   ShapeBringToFront.Enabled := (AShape <> nil) and not AShape.IsFront;
2138   ShapeSendToBack.Enabled := (AShape <> nil) and not AShape.IsBack;
2139   ShapeMoveUp.Enabled := (AShape <> nil) and not AShape.IsFront;
2140   ShapeMoveDown.Enabled := (AShape <> nil) and not ASHape.IsBack;
2141   EditCopy.Enabled := AShape <> nil;
2142   EditCut.Enabled := AShape <> nil;
2143   EditDelete.Enabled := AShape <> nil;
2144   BackFillControl.CanAdjustToShape := AShape <> nil;
2145   PenFillControl.CanAdjustToShape := AShape <> nil;
2146   OutlineFillControl.CanAdjustToShape := AShape <> nil;
2147 end;
2148 
2149 procedure TForm1.RemoveShapeIfEmpty(AShape: TVectorShape);
2150 var
2151   rF: TRectF;
2152 begin
2153   if FInRemoveShapeIfEmpty then exit;
2154   FInRemoveShapeIfEmpty := true;
2155   if (AShape <> nil) and not AShape.IsRemoving and
2156      (AShape.GetAsMultishape = nil) then
2157   begin
2158     rF := AShape.GetRenderBounds(InfiniteRect, vectorTransform);
2159     if IsEmptyRectF(rF) then
2160     begin
2161       vectorOriginal.RemoveShape(AShape);
2162       ShowMessage('Shape is empty and has been deleted');
2163     end else
2164     if not rF.IntersectsWith(RectF(0,0,img.Width,img.Height)) then
2165     begin
2166       vectorOriginal.RemoveShape(AShape);
2167       ShowMessage('Shape is outside of picture and has been deleted');
2168     end;
2169   end;
2170   FInRemoveShapeIfEmpty := false;
2171 end;
2172 
TForm1.VirtualScreenToImgCoordnull2173 function TForm1.VirtualScreenToImgCoord(X, Y: Integer): TPointF;
2174 begin
2175   result := AffineMatrixTranslation(-0.5,-0.5)*AffineMatrixInverse(zoom)*AffineMatrixTranslation(0.5,0.5)*PointF(X,Y);
2176 end;
2177 
2178 procedure TForm1.SetEditorGrid(AActive: boolean);
2179 var pixelCentered: boolean;
2180 begin
2181   if Assigned(img) and Assigned(img.OriginalEditor) then
2182   begin
2183     if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
2184       pixelCentered:= vectorOriginal.SelectedShape.PreferPixelCentered
2185     else if PaintToolClass[currentTool]<>nil then
2186       pixelCentered:= PaintToolClass[currentTool].PreferPixelCentered;
2187 
2188     if zoomFactor >= 2.1 then
2189       img.OriginalEditor.GridMatrix := AffineMatrixTranslation(-0.5,-0.5)*
2190                                        vectorTransform*AffineMatrixTranslation(0.5,0.5)*
2191                                        AffineMatrixScale(0.5,0.5)
2192     else
2193     if pixelCentered then
2194       img.OriginalEditor.GridMatrix := AffineMatrixTranslation(-0.5,-0.5)*
2195                                        vectorTransform*AffineMatrixTranslation(0.5,0.5)
2196     else
2197       img.OriginalEditor.GridMatrix := AffineMatrixTranslation(-0.5,-0.5)*vectorTransform;
2198 
2199     img.OriginalEditor.GridActive := AActive or (zoomFactor < 2.1);
2200   end;
2201 end;
2202 
2203 procedure TForm1.RequestBackFillAdjustToShape(Sender: TObject);
2204 var
2205   vectorFill: TVectorialFill;
2206 begin
2207   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
2208      (vsfBackFill in vectorOriginal.SelectedShape.MultiFields) then
2209   begin
2210     vectorFill := BackFillControl.CreateShapeFill(vectorOriginal.SelectedShape);
2211     vectorOriginal.SelectedShape.BackFill := vectorFill;
2212     vectorFill.Free;
2213   end;
2214 end;
2215 
2216 procedure TForm1.PenFillControlResize(Sender: TObject);
2217 begin
2218   PanelPenFill.ClientWidth := PanelPenFillHead.Width+PenFillControl.Width+2;
2219 end;
2220 
2221 procedure TForm1.RequestPenFillAdjustToShape(Sender: TObject);
2222 var
2223   vectorFill: TVectorialFill;
2224 begin
2225   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
2226      (vsfPenFill in vectorOriginal.SelectedShape.MultiFields) then
2227   begin
2228     vectorFill := PenFillControl.CreateShapeFill(vectorOriginal.SelectedShape);
2229     vectorOriginal.SelectedShape.PenFill := vectorFill;
2230     vectorFill.Free;
2231   end;
2232 end;
2233 
2234 procedure TForm1.RequestPenFillUpdate(Sender: TObject);
2235 begin
2236   if not FUpdatingFromShape then
2237   begin
2238     UpdateShapePenFill;
2239     UpdatePenToolFillPoints;
2240   end;
2241 end;
2242 
2243 procedure TForm1.RequestOutlineFillAdjustToShape(Sender: TObject);
2244 var
2245   vectorFill: TVectorialFill;
2246 begin
2247   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) and
2248      (vsfOutlineFill in vectorOriginal.SelectedShape.MultiFields) then
2249   begin
2250     vectorFill := OutlineFillControl.CreateShapeFill(vectorOriginal.SelectedShape);
2251     vectorOriginal.SelectedShape.OutlineFill := vectorFill;
2252     vectorFill.Free;
2253   end;
2254 end;
2255 
2256 procedure TForm1.AdjustToolbarTop;
2257 begin
2258   ReorderToolbarContent(ToolbarTop);
2259 
2260   ToolBarTop.Height := GetToolbarSize(ToolBarTop,0).cy;
2261   BCPanelToolbar.Height := ToolBarTop.Height;
2262 end;
2263 
2264 procedure TForm1.UpdateSplineToolbar;
2265 var
2266   i: Integer;
2267 begin
2268   for i := 0 to FSplineToolbar.ButtonCount-1 do
2269   begin
2270     if FSplineStyle = ssEasyBezier then
2271     begin
2272       FSplineToolbar.Buttons[i].Enabled:= true;
2273     end else
2274     begin
2275       if FSplineToolbar.Buttons[i].Tag = ord(vsuEdit) then
2276       begin
2277         if not FSplineToolbar.Buttons[i].Down then
2278         begin
2279           FSplineToolbar.Buttons[i].Down := true;
2280           FSplineToolbar.Buttons[i].OnClick(FSplineToolbar.Buttons[i]);
2281         end;
2282       end
2283       else
2284         FSplineToolbar.Buttons[i].Enabled:= false;
2285     end;
2286   end;
2287 end;
2288 
TForm1.SnapToGridnull2289 function TForm1.SnapToGrid(APoint: TPointF): TPointF;
2290 begin
2291   if Assigned(img) and Assigned(img.OriginalEditor) and img.OriginalEditor.GridActive then
2292     result := img.OriginalEditor.SnapToGrid(APoint, false)
2293   else
2294     result := APoint;
2295 end;
2296 
TForm1.ImgCoordToOriginalCoordnull2297 function TForm1.ImgCoordToOriginalCoord(APoint: TPointF): TPointF;
2298 begin
2299   if Assigned(img) and Assigned(img.OriginalEditor) and img.OriginalEditor.GridActive then
2300     result := SnapToGrid(AffineMatrixInverse(vectorTransform)*APoint)
2301   else
2302     result := SnapToGrid(AffineMatrixInverse(AffineMatrixTranslation(-0.5,-0.5)*vectorTransform*AffineMatrixTranslation(0.5,0.5))*APoint);
2303 end;
2304 
2305 procedure TForm1.DoCopy;
2306 begin
2307   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
2308     CopyShapesToClipboard([vectorOriginal.SelectedShape], vectorTransform);
2309 end;
2310 
2311 procedure TForm1.DoCut;
2312 begin
2313   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
2314   begin
2315     if CopyShapesToClipboard([vectorOriginal.SelectedShape], vectorTransform) then
2316       vectorOriginal.SelectedShape.Remove;
2317   end;
2318 end;
2319 
2320 procedure TForm1.DoPaste;
2321 begin
2322   if Assigned(vectorOriginal) then
2323     PasteShapesFromClipboard(vectorOriginal, vectorTransform, rectF(0,0,img.Width,img.Height));
2324 end;
2325 
2326 procedure TForm1.DoDelete;
2327 begin
2328   if Assigned(vectorOriginal) and Assigned(vectorOriginal.SelectedShape) then
2329     vectorOriginal.SelectedShape.Remove;
2330 end;
2331 
2332 procedure TForm1.DoUndo;
2333 var
2334   diff: TBGRAOriginalDiff;
2335 begin
2336   if FDiffListPos <= 0 then exit;
2337   dec(FDiffListPos);
2338   diff := FDiffList[FDiffListPos];
2339   diff.Unapply(vectorOriginal);
2340   UpdateTitleBar;
2341 end;
2342 
2343 procedure TForm1.DoRedo;
2344 var
2345   diff: TBGRAOriginalDiff;
2346 begin
2347   diff := FDiffList[FDiffListPos];
2348   diff.Apply(vectorOriginal);
2349   inc(FDiffListPos);
2350   UpdateTitleBar;
2351 end;
2352 
2353 end.
2354 
2355