1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UToolLayer;
3 
4 {$mode objfpc}{$H+}
5 
6 interface
7 
8 uses
9   Classes, SysUtils, UTool, BGRABitmap, BGRABitmapTypes,
10   BGRATransform, BGRALayers, ULayerAction, UImageDiff,
11   UImageType, UStateType;
12 
13 type
14   { TToolMoveLayer }
15 
16   TToolMoveLayer = class(TGenericTool)
17   protected
18     handMoving: boolean;
19     handOriginF: TPointF;
20     originalTransformBefore: TAffineMatrix;
21     layerOffsetBefore: TPoint;
22     FStartLayerOffset: TPoint;
23     FStartLayerMatrix: TAffineMatrix;
24     FStartLayerOffsetDefined: boolean;
25     FLayerBounds: TRect;
26     FLayerBoundsDefined: boolean;
GetIsSelectingToolnull27     function GetIsSelectingTool: boolean; override;
DoToolDownnull28     function DoToolDown({%H-}toolDest: TBGRABitmap; {%H-}pt: TPoint; ptF: TPointF;
29       {%H-}rightBtn: boolean): TRect; override;
DoToolMovenull30     function DoToolMove({%H-}toolDest: TBGRABitmap; {%H-}pt: TPoint; ptF: TPointF): TRect; override;
DoToolKeyDownnull31     function DoToolKeyDown(var key: Word): TRect; override;
UseOriginalnull32     function UseOriginal: boolean;
33     procedure NeedLayerBounds;
GetActionnull34     function GetAction: TLayerAction; override;
DoGetToolDrawingLayernull35     function DoGetToolDrawingLayer: TBGRABitmap; override;
36     procedure OnTryStop({%H-}sender: TCustomLayerAction); override;
FixLayerOffsetnull37     function FixLayerOffset: boolean; override;
DoTranslatenull38     function DoTranslate(dx,dy: single): TRect;
39     procedure SaveOffsetBefore;
40   public
41     constructor Create(AManager: TToolManager); override;
ToolUpnull42     function ToolUp: TRect; override;
GetContextualToolbarsnull43     function GetContextualToolbars: TContextualToolbars; override;
ToolCommandnull44     function ToolCommand(ACommand: TToolCommand): boolean; override;
ToolProvideCommandnull45     function ToolProvideCommand(ACommand: TToolCommand): boolean; override;
Rendernull46     function Render(VirtualScreen: TBGRABitmap; {%H-}VirtualScreenWidth,
47       {%H-}VirtualScreenHeight: integer;
48       BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect; override;
49   end;
50 
51   { TToolTransformLayer }
52 
53   TToolTransformLayer = class(TGenericTool)
54   private
GetInitialLayerBoundsnull55     function GetInitialLayerBounds: TRect;
GetTransformCenternull56     function GetTransformCenter: TPointF;
57     procedure SetTransformCenter(AValue: TPointF);
58     procedure NeedOriginal;
59   protected
60     FOriginalInit: boolean;
61     FBackupLayer: TReplaceLayerByImageOriginalDifference;
62     FInitialOriginalMatrix: TAffineMatrix;
63     FInitialLayerBounds: TRect;
64     FInitialLayerBoundsDefined: boolean;
65 
66     FTransformCenter: TPointF;
67     FTransformCenterDefined: boolean;
68     FPreviousTransformCenter: TPointF;
69     FPreviousFilter: TResampleFilter;
70     FTransforming: boolean;
71     FPreviousMousePos: TPointF;
72     FSnapDown: boolean;
73     FLastUpdateRect: TRect;
74     FLastUpdateRectDefined: boolean;
75     FOriginalBounds: TRect;
76     FOriginalBoundsDefined: boolean;
GetIsSelectingToolnull77     function GetIsSelectingTool: boolean; override;
DoToolDownnull78     function DoToolDown({%H-}toolDest: TBGRABitmap; {%H-}pt: TPoint; ptF: TPointF;
79       rightBtn: boolean): TRect; override;
DoToolMovenull80     function DoToolMove({%H-}toolDest: TBGRABitmap; {%H-}pt: TPoint; ptF: TPointF): TRect; override;
DoToolKeyDownnull81     function DoToolKeyDown(var key: Word): TRect; override;
DoToolKeyUpnull82     function DoToolKeyUp(var key: Word): TRect; override;
83     procedure CancelTransform;
84     procedure ValidateTransform;
TransformOknull85     function TransformOk: boolean; virtual; abstract;
UpdateTransformnull86     function UpdateTransform: TRect; virtual; abstract;
87     procedure TransformCenterChanged; virtual; abstract;
MouseChangesTransformnull88     function MouseChangesTransform(APrevPos, ANewPos: TPointF): boolean; virtual; abstract;
CtrlChangesTransformnull89     function CtrlChangesTransform: boolean; virtual; abstract;
90     property TransformCenter: TPointF read GetTransformCenter write SetTransformCenter;
GetActionnull91     function GetAction: TLayerAction; override;
DoGetToolDrawingLayernull92     function DoGetToolDrawingLayer: TBGRABitmap; override;
93     procedure OnTryStop({%H-}sender: TCustomLayerAction); override;
94   public
95     constructor Create(AManager: TToolManager); override;
96     destructor Destroy; override;
GetContextualToolbarsnull97     function GetContextualToolbars: TContextualToolbars; override;
ToolCommandnull98     function ToolCommand(ACommand: TToolCommand): boolean; override;
ToolProvideCommandnull99     function ToolProvideCommand(ACommand: TToolCommand): boolean; override;
ToolUpnull100     function ToolUp: TRect; override;
Rendernull101     function Render(VirtualScreen: TBGRABitmap; {%H-}VirtualScreenWidth,
102       {%H-}VirtualScreenHeight: integer;
103       BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect; override;
104   end;
105 
106   { TToolZoomLayer }
107 
108   TToolZoomLayer = class(TToolTransformLayer)
109   private
110     FZoom,FActualZoom,FPreviousActualZoom: single;
GetActualZoomnull111     function GetActualZoom: single;
112   protected
TransformOknull113     function TransformOk: boolean; override;
UpdateTransformnull114     function UpdateTransform: TRect; override;
115     procedure TransformCenterChanged; override;
MouseChangesTransformnull116     function MouseChangesTransform(APrevPos, ANewPos: TPointF): boolean; override;
CtrlChangesTransformnull117     function CtrlChangesTransform: boolean; override;
118   public
119     constructor Create(AManager: TToolManager); override;
120   end;
121 
122   { TToolRotateLayer }
123 
124   TToolRotateLayer = class(TToolTransformLayer)
125   private
126     FAngle,FActualAngle,FPreviousActualAngle: single;
GetActualAnglenull127     function GetActualAngle: single;
128   protected
TransformOknull129     function TransformOk: boolean; override;
UpdateTransformnull130     function UpdateTransform: TRect; override;
131     procedure TransformCenterChanged; override;
MouseChangesTransformnull132     function MouseChangesTransform(APrevPos, ANewPos: TPointF): boolean; override;
CtrlChangesTransformnull133     function CtrlChangesTransform: boolean; override;
134   public
135     constructor Create(AManager: TToolManager); override;
136   end;
137 
138 implementation
139 
140 uses LazPaintType, ugraph, LCLType, Types, BGRALayerOriginal, math, LCVectorOriginal;
141 
142 const
143   VeryBigValue = maxLongInt div 2;
144 
145 { TToolMoveLayer }
146 
TToolMoveLayer.GetIsSelectingToolnull147 function TToolMoveLayer.GetIsSelectingTool: boolean;
148 begin
149   result := false;
150 end;
151 
TToolMoveLayer.DoToolDownnull152 function TToolMoveLayer.DoToolDown(toolDest: TBGRABitmap; pt: TPoint;
153   ptF: TPointF; rightBtn: boolean): TRect;
154 begin
155   result := EmptyRect;
156   if not handMoving then
157   begin
158     GetAction;
159     handMoving := true;
160     handOriginF := ptF;
161     if UseOriginal then Manager.Image.DraftOriginal := true;
162     SaveOffsetBefore;
163   end;
164 end;
165 
DoToolMovenull166 function TToolMoveLayer.DoToolMove(toolDest: TBGRABitmap; pt: TPoint;
167   ptF: TPointF): TRect;
168 var
169   dx, dy: Single;
170 begin
171   result := EmptyRect;
172   if handMoving then
173   begin
174     dx := ptF.X-HandOriginF.X;
175     dy := ptF.Y-HandOriginF.Y;
176     if ssSnap in ShiftState then
177     begin
178       dx := round(dx);
179       dy := round(dy);
180     end;
181     result := DoTranslate(dx,dy);
182   end;
183 end;
184 
UseOriginalnull185 function TToolMoveLayer.UseOriginal: boolean;
186 begin
187   with Manager.Image do
188     result := LayerOriginalDefined[CurrentLayerIndex] and
189               LayerOriginalKnown[CurrentLayerIndex];
190 end;
191 
192 procedure TToolMoveLayer.NeedLayerBounds;
193 var
194   idx: Integer;
195 begin
196   idx := Manager.Image.CurrentLayerIndex;
197   if not FLayerBoundsDefined then
198   begin
199     if UseOriginal then
200     begin
201       if Manager.Image.LayerOriginal[idx] is TVectorOriginal then
202         FLayerBounds := TVectorOriginal(Manager.Image.LayerOriginal[idx]).GetAlignBounds(
203                           Rect(-VeryBigValue,-VeryBigValue,VeryBigValue,VeryBigValue),
204                           AffineMatrixIdentity)
205       else
206         FLayerBounds := Manager.Image.LayerOriginal[idx].GetRenderBounds(
207                           Rect(-VeryBigValue,-VeryBigValue,VeryBigValue,VeryBigValue),
208                           AffineMatrixIdentity);
209       if FLayerBounds.Left = -VeryBigValue then FLayerBounds.Left := 0;
210       if FLayerBounds.Top = -VeryBigValue then FLayerBounds.Top := 0;
211       if FLayerBounds.Right = VeryBigValue then FLayerBounds.Right := Manager.Image.Width;
212       if FLayerBounds.Bottom = VeryBigValue then FLayerBounds.Bottom := Manager.Image.Height;
213     end
214     else
215       FLayerBounds := Manager.Image.LayerBitmap[idx].GetImageBounds;
216     FLayerBoundsDefined := true;
217   end;
218 end;
219 
GetActionnull220 function TToolMoveLayer.GetAction: TLayerAction;
221 begin
222   result := GetIdleAction;
223 end;
224 
TToolMoveLayer.DoGetToolDrawingLayernull225 function TToolMoveLayer.DoGetToolDrawingLayer: TBGRABitmap;
226 begin
227   Result:= Manager.Image.CurrentLayerReadOnly;   //do not modify layer data directly and ignore selection
228 end;
229 
230 procedure TToolMoveLayer.OnTryStop(sender: TCustomLayerAction);
231 begin
232   //nothing
233 end;
234 
TToolMoveLayer.FixLayerOffsetnull235 function TToolMoveLayer.FixLayerOffset: boolean;
236 begin
237   Result:= false;
238 end;
239 
TToolMoveLayer.DoTranslatenull240 function TToolMoveLayer.DoTranslate(dx, dy: single): TRect;
241 var
242   idx: integer;
243   newTransform: TAffineMatrix;
244   newOfs: TPoint;
245 begin
246   idx := Manager.Image.CurrentLayerIndex;
247   if not FStartLayerOffsetDefined then
248   begin
249     FStartLayerOffsetDefined := true;
250     NeedLayerBounds;
251     FStartLayerOffset := Manager.Image.LayerOffset[idx];
252     FStartLayerMatrix := Manager.Image.LayerOriginalMatrix[idx];
253   end;
254 
255   if UseOriginal then
256   begin
257     newTransform := AffineMatrixTranslation(dx,dy)*originalTransformBefore;
258     if Manager.Image.LayerOriginalMatrix[idx] <> newTransform then
259     begin
260       Manager.Image.LayerOriginalMatrix[idx] := newTransform;
261       result := OnlyRenderChange;
262     end;
263   end else
264   begin
265     newOfs := Point(layerOffsetBefore.X+round(dx),
266                     layerOffsetBefore.Y+round(dy));
267     if Manager.Image.LayerOffset[idx]<>newOfs then
268     begin
269       Manager.Image.SetLayerOffset(idx, newOfs, FLayerBounds);
270       result := OnlyRenderChange;
271     end;
272   end;
273 end;
274 
275 procedure TToolMoveLayer.SaveOffsetBefore;
276 var
277   idx: Integer;
278 begin
279   idx := Manager.Image.CurrentLayerIndex;
280   if UseOriginal then
281     originalTransformBefore := Manager.Image.LayerOriginalMatrix[idx]
282   else
283     originalTransformBefore := AffineMatrixIdentity;
284   layerOffsetBefore := Manager.Image.LayerOffset[idx];
285 end;
286 
287 constructor TToolMoveLayer.Create(AManager: TToolManager);
288 begin
289   inherited Create(AManager);
290   handMoving := false;
291   FStartLayerOffsetDefined:= false;
292 end;
293 
TToolMoveLayer.ToolUpnull294 function TToolMoveLayer.ToolUp: TRect;
295 begin
296   handMoving := false;
297   result := EmptyRect;
298   if UseOriginal then Manager.Image.DraftOriginal := false;
299 end;
300 
TToolMoveLayer.DoToolKeyDownnull301 function TToolMoveLayer.DoToolKeyDown(var key: Word): TRect;
Translatenull302   function Translate(dx,dy: integer): TRect;
303   begin
304     if handMoving or (ssAlt in ShiftState) then exit(EmptyRect);
305     key := 0;
306     GetAction;
307     SaveOffsetBefore;
308     if ssSnap in ShiftState then
309     begin
310       dx := dx*max(Manager.Image.Width div 20, 2);
311       dy := dy*max(Manager.Image.Height div 20, 2);
312     end;
313     result := DoTranslate(dx,dy);
314   end;
315 
316 var idx: integer;
317 begin
318   if key = VK_RETURN then
319   begin
320     Manager.QueryExitTool;
321     result := EmptyRect;
322     Key := 0;
323   end
324   else if key = VK_ESCAPE then
325   begin
326     if FStartLayerOffsetDefined then
327     begin
328       idx := Manager.Image.CurrentLayerIndex;
329       if UseOriginal then
330         Manager.Image.LayerOriginalMatrix[idx] := FStartLayerMatrix
331       else
332         Manager.Image.SetLayerOffset(idx, FStartLayerOffset, FLayerBounds);
333       result := OnlyRenderChange;
334     end else
335       result := EmptyRect;
336     Manager.QueryExitTool;
337     Key := 0;
338   end
339   else if key = VK_LEFT then result := Translate(-1, 0)
340   else if key = VK_RIGHT then result := Translate(1, 0)
341   else if key = VK_UP then result := Translate(0,-1)
342   else if key = VK_DOWN then result := Translate(0,1)
343   else
344     Result:=inherited DoToolKeyDown(key);
345 end;
346 
GetContextualToolbarsnull347 function TToolMoveLayer.GetContextualToolbars: TContextualToolbars;
348 begin
349   Result:= [];
350 end;
351 
TToolMoveLayer.ToolCommandnull352 function TToolMoveLayer.ToolCommand(ACommand: TToolCommand): boolean;
353 var
354   actualBounds: TRect;
355   idx: Integer;
356   orig: TBGRALayerCustomOriginal;
357 begin
358   if not ToolProvideCommand(ACommand) then exit(false);
359   idx := Manager.Image.CurrentLayerIndex;
360   case ACommand of
361   tcAlignLeft,tcAlignRight,tcAlignTop,tcAlignBottom,tcCenterHorizontally,tcCenterVertically:
362       if handMoving then exit(false) else
363       begin
364         NeedLayerBounds;
365         if UseOriginal then
366         begin
367           orig := Manager.Image.LayerOriginal[idx];
368           if orig is TVectorOriginal then
369             actualBounds := TVectorOriginal(orig).GetAlignBounds(
370                           Rect(-VeryBigValue,-VeryBigValue,VeryBigValue,VeryBigValue),
371                           Manager.Image.LayerOriginalMatrix[idx])
372           else
373             actualBounds := orig.GetRenderBounds(
374                           Rect(-VeryBigValue,-VeryBigValue,VeryBigValue,VeryBigValue),
375                           Manager.Image.LayerOriginalMatrix[idx]);
376         end
377         else
378         begin
379           actualBounds := FLayerBounds;
380           actualBounds.Offset(Manager.Image.LayerOffset[idx]);
381         end;
382         GetAction;
383         SaveOffsetBefore;
384         case ACommand of
385           tcAlignLeft: DoTranslate(-actualBounds.Left, 0);
386           tcAlignRight: DoTranslate(Manager.Image.Width-actualBounds.Right, 0);
387           tcAlignTop: DoTranslate(0, -actualBounds.Top);
388           tcAlignBottom: DoTranslate(0, Manager.Image.Height-actualBounds.Bottom);
389           tcCenterHorizontally: DoTranslate((Manager.Image.Width-(actualBounds.Left+actualBounds.Right)) div 2, 0);
390           tcCenterVertically: DoTranslate(0, (Manager.Image.Height-(actualBounds.Top+actualBounds.Bottom)) div 2);
391         end;
392       end;
393   tcMoveDown: Manager.Image.MoveLayer(idx, idx-1);
394   tcMoveToBack: Manager.Image.MoveLayer(idx, 0);
395   tcMoveUp: Manager.Image.MoveLayer(idx, idx+1);
396   tcMoveToFront: Manager.Image.MoveLayer(idx, Manager.Image.NbLayers-1);
397   end;
398   result := true;
399 end;
400 
TToolMoveLayer.ToolProvideCommandnull401 function TToolMoveLayer.ToolProvideCommand(ACommand: TToolCommand): boolean;
402 begin
403   case ACommand of
404   tcAlignLeft,tcAlignRight,tcAlignTop,tcAlignBottom,tcCenterHorizontally,tcCenterVertically:
405     result := not handMoving;
406   tcMoveDown,tcMoveToBack: result := Manager.Image.CurrentLayerIndex > 0;
407   tcMoveUp,tcMoveToFront: result := Manager.Image.CurrentLayerIndex < Manager.Image.NbLayers-1;
408   else result := false;
409   end;
410 end;
411 
TToolMoveLayer.Rendernull412 function TToolMoveLayer.Render(VirtualScreen: TBGRABitmap; VirtualScreenWidth,
413   VirtualScreenHeight: integer;
414   BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect;
415 var
416   idx, i: integer;
417   m: TAffineMatrix;
418   ab: TAffineBox;
419   ptsF: ArrayOfTPointF;
420   pts: array of TPoint;
421 begin
422   NeedLayerBounds;
423 
424   if UseOriginal then
425   begin
426     idx := Manager.Image.CurrentLayerIndex;
427     m := Manager.Image.LayerOriginalMatrix[idx];
428     with Manager.Image.LayerOffset[idx] do
429       m := AffineMatrixTranslation(-x,-y)*m;
430   end else m := AffineMatrixIdentity;
431 
432   m := AffineMatrixTranslation(-0.5,-0.5)*m;
433   ab := TAffineBox.AffineBox(BitmapToVirtualScreen(m*PointF(FLayerBounds.Left+0.001,FLayerBounds.Top+0.001)),
434             BitmapToVirtualScreen(m*PointF(FLayerBounds.Right-0.001,FLayerBounds.Top+0.001)),
435             BitmapToVirtualScreen(m*PointF(FLayerBounds.Left+0.001,FLayerBounds.Bottom-0.001)));
436   ptsF := ab.AsPolygon;
437   setlength(pts, length(ptsF));
438   for i := 0 to high(pts) do
439     pts[i] := ptsF[i].Round;
440 
441   result := TRect.Union(pts);
442   result.Inflate(1,1);
443 
444   if Assigned(VirtualScreen) then
445     virtualScreen.DrawpolygonAntialias(pts,BGRA(230,255,230,255),BGRA(0,0,0,255),
446       FrameDashLength*Manager.CanvasScale);
447 end;
448 
449 { TToolTransformLayer }
450 
GetInitialLayerBoundsnull451 function TToolTransformLayer.GetInitialLayerBounds: TRect;
452 begin
453   if not FInitialLayerBoundsDefined then
454   begin
455     FInitialLayerBounds := GetToolDrawingLayer.GetImageBounds;
456     with Manager.Image.LayerOffset[Manager.Image.CurrentLayerIndex] do
457       FInitialLayerBounds.Offset(X,Y);
458     FInitialLayerBoundsDefined := true;
459   end;
460   result := FInitialLayerBounds;
461 end;
462 
TToolTransformLayer.GetTransformCenternull463 function TToolTransformLayer.GetTransformCenter: TPointF;
464 var bounds: TRect;
465 begin
466   if not FTransformCenterDefined then
467   begin
468     bounds := GetInitialLayerBounds;
469     if IsRectEmpty(bounds) then
470       FTransformCenter := PointF(Manager.Image.Width/2 - 0.5,Manager.Image.Height/2 - 0.5)
471     else
472     begin
473       with bounds do
474         FTransformCenter := PointF((Left+Right)/2 - 0.5, (Top+Bottom)/2 - 0.5);
475     end;
476     FTransformCenterDefined := true;
477   end;
478   result := FTransformCenter;
479 end;
480 
481 procedure TToolTransformLayer.SetTransformCenter(AValue: TPointF);
482 begin
483   FTransformCenter := AValue;
484 end;
485 
486 procedure TToolTransformLayer.NeedOriginal;
487 var
488   layered: TBGRALayeredBitmap;
489   layerIdx: Integer;
490 begin
491   if FOriginalInit then exit;
492   GetAction;
493   layerIdx := Manager.Image.CurrentLayerIndex;
494   layered := Manager.Image.CurrentState.LayeredBitmap;
495   if not (Manager.Image.LayerOriginalDefined[layerIdx] and
496      Manager.Image.LayerOriginalKnown[layerIdx]) then
497   begin
498     if Assigned(FBackupLayer) then raise exception.Create('Backup layer already assigned');
499     FBackupLayer:= TReplaceLayerByImageOriginalDifference.Create(Manager.Image.CurrentState, layerIdx, true);
500   end;
501   FInitialOriginalMatrix := layered.LayerOriginalMatrix[layerIdx];
502   FOriginalInit := true;
503 end;
504 
DoToolDownnull505 function TToolTransformLayer.DoToolDown(toolDest: TBGRABitmap; pt: TPoint;
506   ptF: TPointF; rightBtn: boolean): TRect;
507 begin
508   with Manager.Image.LayerOffset[Manager.Image.CurrentLayerIndex] do
509     ptF += PointF(X,Y);
510 
511   if not FTransforming and not rightBtn then
512   begin
513     FTransforming := true;
514     FPreviousMousePos := ptF;
515     if FSnapDown then
516     begin
517       result := UpdateTransform;
518       if IsRectEmpty(result) then result := OnlyRenderChange;
519     end else result := EmptyRect;
520     Manager.Image.DraftOriginal := true;
521   end else
522   if rightBtn then
523   begin
524     if FSnapDown then
525     begin
526       if Manager.Image.ZoomFactor > 4 then
527       begin
528         ptF.X := round(ptF.X*2)/2;
529         ptF.Y := round(ptF.Y*2)/2;
530       end else
531       begin
532         ptF.X := round(ptF.X);
533         ptF.Y := round(ptF.Y);
534       end;
535     end;
536     FTransformCenter := ptF;
537     TransformCenterChanged;
538     result := UpdateTransform;
539     if IsRectEmpty(result) then result := OnlyRenderChange;
540   end else
541     result := EmptyRect;
542 end;
543 
DoToolMovenull544 function TToolTransformLayer.DoToolMove(toolDest: TBGRABitmap; pt: TPoint;
545   ptF: TPointF): TRect;
546 begin
547   with Manager.Image.LayerOffset[Manager.Image.CurrentLayerIndex] do
548     ptF += PointF(X,Y);
549   if FTransforming then
550   begin
551     If MouseChangesTransform(FPreviousMousePos, ptF) then
552     begin
553       result := UpdateTransform;
554       if result.IsEmpty then result := OnlyRenderChange;
555     end
556     else result := EmptyRect;
557     FPreviousMousePos := ptF;
558   end else
559     result := EmptyRect;
560 end;
561 
562 procedure TToolTransformLayer.CancelTransform;
563 begin
564   if FOriginalInit then
565   begin
566     Manager.Image.LayerOriginalMatrix[Manager.Image.CurrentLayerIndex] := FInitialOriginalMatrix;
567     if Assigned(FBackupLayer) then
568     begin
569       FBackupLayer.UnapplyTo(Manager.Image.CurrentState);
570       FreeAndNil(FBackupLayer);
571     end;
572     FOriginalInit := false;
573   end;
574   Manager.QueryExitTool;
575 end;
576 
577 procedure TToolTransformLayer.ValidateTransform;
578 var
579   transform: TAffineMatrix;
580   layerIdx: Integer;
581   invTransformDiff: TCustomImageDifference;
582   r: TRect;
583 begin
584   if FOriginalInit then
585   begin
586     if Assigned(FBackupLayer) then
587     begin
588       layerIdx := Manager.Image.CurrentLayerIndex;
589       transform := Manager.Image.LayerOriginalMatrix[layerIdx];
590       invTransformDiff := Manager.Image.CurrentState.ComputeLayerMatrixDifference(layerIdx,
591                           transform, FInitialOriginalMatrix);
592       FBackupLayer.nextMatrix := transform;
593       Manager.Image.AddUndo(invTransformDiff);
594       Manager.Image.AddUndo(FBackupLayer);
595       r := EmptyRect;
596       Manager.Image.CurrentState.LayeredBitmap.RenderLayerFromOriginalIfNecessary(layerIdx, false, r);
597       FBackupLayer := nil;
598     end;
599     FOriginalInit := false;
600   end;
601   Manager.QueryExitTool;
602 end;
603 
GetActionnull604 function TToolTransformLayer.GetAction: TLayerAction;
605 begin
606   result := GetIdleAction;
607 end;
608 
TToolTransformLayer.DoGetToolDrawingLayernull609 function TToolTransformLayer.DoGetToolDrawingLayer: TBGRABitmap;
610 begin
611   Result:= Manager.Image.CurrentLayerReadOnly   //do not modify layer data directly and ignore selection
612 end;
613 
614 procedure TToolTransformLayer.OnTryStop(sender: TCustomLayerAction);
615 begin
616   //nothing
617 end;
618 
619 constructor TToolTransformLayer.Create(AManager: TToolManager);
620 begin
621   inherited Create(AManager);
622   FSnapDown:= false;
623   FTransformCenterDefined := false;
624   FLastUpdateRectDefined:= false;
625 end;
626 
627 destructor TToolTransformLayer.Destroy;
628 begin
629   if TransformOk then ValidateTransform
630   else CancelTransform;
631   inherited Destroy;
632 end;
633 
GetContextualToolbarsnull634 function TToolTransformLayer.GetContextualToolbars: TContextualToolbars;
635 begin
636   Result:= [];
637 end;
638 
TToolTransformLayer.ToolCommandnull639 function TToolTransformLayer.ToolCommand(ACommand: TToolCommand): boolean;
640 begin
641   if not ToolProvideCommand(ACommand) then exit(false);
642   case ACommand of
643   tcMoveDown: Manager.Image.MoveLayer(Manager.Image.CurrentLayerIndex, Manager.Image.CurrentLayerIndex-1);
644   tcMoveToBack: Manager.Image.MoveLayer(Manager.Image.CurrentLayerIndex, 0);
645   tcMoveUp: Manager.Image.MoveLayer(Manager.Image.CurrentLayerIndex, Manager.Image.CurrentLayerIndex+1);
646   tcMoveToFront: Manager.Image.MoveLayer(Manager.Image.CurrentLayerIndex, Manager.Image.NbLayers-1);
647   end;
648   result := true;
649 end;
650 
TToolTransformLayer.ToolProvideCommandnull651 function TToolTransformLayer.ToolProvideCommand(ACommand: TToolCommand): boolean;
652 begin
653   case ACommand of
654   tcMoveDown,tcMoveToBack: result := Manager.Image.CurrentLayerIndex > 0;
655   tcMoveUp,tcMoveToFront: result := Manager.Image.CurrentLayerIndex < Manager.Image.NbLayers-1;
656   else result := false;
657   end;
658 end;
659 
DoToolKeyDownnull660 function TToolTransformLayer.DoToolKeyDown(var key: Word): TRect;
661 begin
662   if key = VK_CONTROL then
663   begin
664     FSnapDown:= true;
665     if FTransforming and CtrlChangesTransform then
666     begin
667       result := UpdateTransform;
668       if result.IsEmpty then result := OnlyRenderChange;
669     end
670       else result := EmptyRect;
671     Key := 0;
672   end else
673   if Key = VK_RETURN then
674   begin
675     if TransformOk then ValidateTransform
676     else CancelTransform;
677     result := OnlyRenderChange;
678     key := 0;
679   end else
680   if Key = VK_ESCAPE then
681   begin
682     CancelTransform;
683     result := OnlyRenderChange;
684     key := 0;
685   end else
686     result := EmptyRect;
687 end;
688 
DoToolKeyUpnull689 function TToolTransformLayer.DoToolKeyUp(var key: Word): TRect;
690 begin
691   if key = VK_CONTROL then
692   begin
693     FSnapDown := false;
694     if FTransforming and CtrlChangesTransform then
695     begin
696       result := UpdateTransform;
697       if result.IsEmpty then result := OnlyRenderChange;
698     end
699       else result := EmptyRect;
700     Key := 0;
701   end else
702     result := EmptyRect;
703 end;
704 
ToolUpnull705 function TToolTransformLayer.ToolUp: TRect;
706 begin
707   if FTransforming then
708   begin
709     FTransforming := false;
710     result := UpdateTransform;
711     if result.IsEmpty then result := OnlyRenderChange;
712     Manager.Image.DraftOriginal := false;
713   end else
714     Result:=EmptyRect;
715 end;
716 
Rendernull717 function TToolTransformLayer.Render(VirtualScreen: TBGRABitmap;
718   VirtualScreenWidth, VirtualScreenHeight: integer;
719   BitmapToVirtualScreen: TBitmapToVirtualScreenFunction): TRect;
720 var
721   idx, i: integer;
722   m: TAffineMatrix;
723   ab: TAffineBox;
724   ptsF: ArrayOfTPointF;
725   pts: array of TPoint;
726   ptsRect: TRect;
727 begin
728   idx := Manager.Image.CurrentLayerIndex;
729   if not FOriginalBoundsDefined then
730   begin
731     if Manager.Image.LayerOriginalDefined[idx] then
732     begin
733       if Manager.Image.LayerOriginal[idx] is TVectorOriginal then
734         FOriginalBounds := TVectorOriginal(Manager.Image.LayerOriginal[idx]).GetAlignBounds(
735                           Rect(-VeryBigValue,-VeryBigValue,VeryBigValue,VeryBigValue),
736                           AffineMatrixIdentity)
737       else
738         FOriginalBounds := Manager.Image.LayerOriginal[idx].GetRenderBounds(
739                           Rect(-VeryBigValue,-VeryBigValue,VeryBigValue,VeryBigValue),
740                           AffineMatrixIdentity);
741       if FOriginalBounds.Left = -VeryBigValue then FOriginalBounds.Left := 0;
742       if FOriginalBounds.Top = -VeryBigValue then FOriginalBounds.Top := 0;
743       if FOriginalBounds.Right = VeryBigValue then FOriginalBounds.Right := Manager.Image.Width;
744       if FOriginalBounds.Bottom = VeryBigValue then FOriginalBounds.Bottom := Manager.Image.Height;
745     end
746     else
747       FOriginalBounds := GetInitialLayerBounds;
748   end;
749   m := Manager.Image.LayerOriginalMatrix[idx];
750   with Manager.Image.LayerOffset[idx] do
751     m := AffineMatrixTranslation(-x,-y)*m;
752   m := AffineMatrixTranslation(-0.5,-0.5)*m;
753 
754   with Manager.Image.LayerOffset[idx] do
755     Result:= NicePoint(VirtualScreen,BitmapToVirtualScreen(TransformCenter-PointF(X,Y)));
756 
757   ab := TAffineBox.AffineBox(BitmapToVirtualScreen(m*PointF(FOriginalBounds.Left+0.001,FOriginalBounds.Top+0.001)),
758             BitmapToVirtualScreen(m*PointF(FOriginalBounds.Right-0.001,FOriginalBounds.Top+0.001)),
759             BitmapToVirtualScreen(m*PointF(FOriginalBounds.Left+0.001,FOriginalBounds.Bottom-0.001)));
760   ptsF := ab.AsPolygon;
761   setlength(pts, length(ptsF));
762   for i := 0 to high(pts) do
763     pts[i] := ptsF[i].Round;
764 
765   ptsRect := TRect.Union(pts);
766   ptsRect.Inflate(1,1);
767   Result.Union(ptsRect);
768 
769   if Assigned(VirtualScreen) then
770     virtualScreen.DrawpolygonAntialias(pts,BGRA(230,255,230,255),BGRA(0,0,0,255),
771       FrameDashLength*Manager.CanvasScale);
772 end;
773 
TToolTransformLayer.GetIsSelectingToolnull774 function TToolTransformLayer.GetIsSelectingTool: boolean;
775 begin
776   result := false;
777 end;
778 
779 { TToolZoomLayer }
780 
TToolZoomLayer.GetActualZoomnull781 function TToolZoomLayer.GetActualZoom: single;
782 const log125 = 0.321928095;
783       log15 = 0.584962501;
784 var
785   logZoom, fracZoom: single;
786   baseZoom: single;
787   invZoom: boolean;
788 begin
789   if FSnapDown then
790   begin
791     logZoom := ln(FZoom)/ln(2);
792     if logZoom < 0 then
793     begin
794       invZoom := true;
795       logZoom := -logZoom;
796     end else invZoom := false;
797     fracZoom := frac(logZoom);
798     baseZoom := 1 shl trunc(logZoom);
799 
800     if fracZoom < log125/2 then result := baseZoom else
801     if fracZoom < (log125+log15)/2 then result := baseZoom*1.25 else
802     if fracZoom < (log15+1)/2 then result := baseZoom*1.5 else
803       result := baseZoom*2;
804 
805     if invZoom then result := 1/result;
806   end
807   else
808     result := FZoom;
809 end;
810 
TransformOknull811 function TToolZoomLayer.TransformOk: boolean;
812 begin
813   result := FActualZoom <> 0;
814 end;
815 
UpdateTransformnull816 function TToolZoomLayer.UpdateTransform: TRect;
817 begin
818   if (FActualZoom = FPreviousActualZoom) and ((FActualZoom = 1) or (TransformCenter = FPreviousTransformCenter)) then
819   begin
820     result := EmptyRect;
821     exit;
822   end;
823   FPreviousActualZoom := FActualZoom;
824   FPreviousTransformCenter := TransformCenter;
825   result := EmptyRect;
826   NeedOriginal;
827   Manager.Image.LayerOriginalMatrix[Manager.Image.CurrentLayerIndex] :=
828     AffineMatrixTranslation(TransformCenter.X+0.5,TransformCenter.Y+0.5)*
829     AffineMatrixScale(FActualZoom,FActualZoom)*
830     AffineMatrixTranslation(-TransformCenter.X-0.5,-TransformCenter.Y-0.5)*
831     FInitialOriginalMatrix;
832 end;
833 
834 procedure TToolZoomLayer.TransformCenterChanged;
835 begin
836   FZoom := 1;
837   FActualZoom:= GetActualZoom;
838 end;
839 
MouseChangesTransformnull840 function TToolZoomLayer.MouseChangesTransform(APrevPos, ANewPos: TPointF): boolean;
841 var
842   dist, prevDist: Single;
843 begin
844   dist := VectLen(ANewPos-TransformCenter);
845   prevDist := VectLen(APrevPos-TransformCenter);
846   if (prevDist <> 0) and (dist <> 0) then
847   begin
848     FZoom *= dist/prevDist;
849     FActualZoom:= GetActualZoom;
850     result := true;
851   end
852   else result := false;
853 end;
854 
TToolZoomLayer.CtrlChangesTransformnull855 function TToolZoomLayer.CtrlChangesTransform: boolean;
856 var
857   newActualZoom: Single;
858 begin
859   newActualZoom := GetActualZoom;
860   if FActualZoom<>newActualZoom then
861   begin
862     FActualZoom := newActualZoom;
863     result := true;
864   end else
865     result := false;
866 end;
867 
868 constructor TToolZoomLayer.Create(AManager: TToolManager);
869 begin
870   inherited Create(AManager);
871   FZoom:= 1;
872   FPreviousActualZoom := 1;
873 end;
874 
875 { TToolRotateLayer }
876 
GetActualAnglenull877 function TToolRotateLayer.GetActualAngle: single;
878 begin
879   if FSnapDown then
880     result := round(FAngle/15)*15
881   else
882     result := FAngle;
883 end;
884 
TransformOknull885 function TToolRotateLayer.TransformOk: boolean;
886 begin
887   result := true;
888 end;
889 
890 procedure TToolRotateLayer.TransformCenterChanged;
891 begin
892   FAngle := 0;
893   FActualAngle:= GetActualAngle;
894 end;
895 
TToolRotateLayer.MouseChangesTransformnull896 function TToolRotateLayer.MouseChangesTransform(APrevPos, ANewPos: TPointF): boolean;
897 var
898   angleDiff, newActualAngle: Single;
899 begin
900   angleDiff := ComputeAngle(ANewPos.X-TransformCenter.X,ANewPos.Y-TransformCenter.Y)-
901              ComputeAngle(APrevPos.X-TransformCenter.X,APrevPos.Y-TransformCenter.Y);
902   FAngle += angleDiff;
903   newActualAngle := GetActualAngle;
904   if newActualAngle <> FActualAngle then
905   begin
906     FActualAngle:= newActualAngle;
907     result := true;
908   end
909   else result := false;
910 end;
911 
TToolRotateLayer.CtrlChangesTransformnull912 function TToolRotateLayer.CtrlChangesTransform: boolean;
913 var
914   newActualAngle: Single;
915 begin
916   newActualAngle := GetActualAngle;
917   if newActualAngle<>FActualAngle then
918   begin
919     FActualAngle := newActualAngle;
920     result := true;
921   end else
922     result := false;
923 end;
924 
TToolRotateLayer.UpdateTransformnull925 function TToolRotateLayer.UpdateTransform: TRect;
926 begin
927   if (FActualAngle = FPreviousActualAngle) and ((FActualAngle = 0) or (TransformCenter = FPreviousTransformCenter)) then
928   begin
929     result := EmptyRect;
930     exit;
931   end;
932   FPreviousActualAngle := FActualAngle;
933   FPreviousTransformCenter := TransformCenter;
934   result := EmptyRect;
935   NeedOriginal;
936   Manager.Image.LayerOriginalMatrix[Manager.Image.CurrentLayerIndex] :=
937     AffineMatrixTranslation(TransformCenter.X+0.5,TransformCenter.Y+0.5)*
938     AffineMatrixRotationDeg(FActualAngle)*
939     AffineMatrixTranslation(-TransformCenter.X-0.5,-TransformCenter.Y-0.5)*
940     FInitialOriginalMatrix;
941 end;
942 
943 constructor TToolRotateLayer.Create(AManager: TToolManager);
944 begin
945   inherited Create(AManager);
946   FAngle:= 0;
947   FPreviousActualAngle := 0;
948 end;
949 
950 initialization
951 
952   RegisterTool(ptMoveLayer,TToolMoveLayer);
953   RegisterTool(ptRotateLayer,TToolRotateLayer);
954   RegisterTool(ptZoomLayer,TToolZoomLayer);
955 
956 end.
957 
958