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