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