delphi Image32 变形控制

1.delphi Image32 之快速入门2024-06-01 2.delphi 图形图像处理 Image322024-05-31 3.delphi Image 32 动画演示12024-06-11 4.delphi Image32 动画演示22024-06-11 5.delphi Image32 路径2024-06-13 6.delphi Image32 图形处理图层2024-06-13 7.delphi Image32 SVG图形查看器2024-06-13 8.delphi Image32 图片转换成SVG2024-06-13 9.delphi Image32 图像采样2024-07-01
10.delphi Image32 变形控制2024-07-01
先看动画：
代码：
  1 unit uFrmTransform;
  2 
  3 interface
  4 
  5 uses
  6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  7   System.Types, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
  8   Vcl.Dialogs, Vcl.Menus, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Buttons, Vcl.StdCtrls, //
  9   Img32, Img32.Layers, uLayerDefines;
 10 
 11 type
 12   TfrmTransform = class(TForm)
 13     StatusBar1: TStatusBar;
 14     OpenDialog1: TOpenDialog;
 15     SaveDialog1: TSaveDialog;
 16     pnlTop: TPanel;
 17     btnOpen: TSpeedButton;
 18     btnSaveAs: TSpeedButton;
 19     btnCopy: TSpeedButton;
 20     btnPaste: TSpeedButton;
 21     btnReset: TSpeedButton;
 22     cbType: TComboBox;
 23     btnAddControlPoint: TSpeedButton;
 24     PaintBox1: TPaintBox;
 25     btnHideDesigners: TSpeedButton;
 26     procedure FormCreate(Sender: TObject);
 27     procedure FormResize(Sender: TObject);
 28     procedure PaintBox1Paint(Sender: TObject);
 29     procedure FormDestroy(Sender: TObject);
 30     procedure btnAddControlPointClick(Sender: TObject);
 31     procedure PaintBox1DblClick(Sender: TObject);
 32     procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 33     procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 34     procedure btnOpenClick(Sender: TObject);
 35     procedure btnPasteClick(Sender: TObject);
 36     procedure btnSaveAsClick(Sender: TObject);
 37     procedure btnCopyClick(Sender: TObject);
 38     procedure btnResetClick(Sender: TObject);
 39     procedure cbTypeChange(Sender: TObject);
 40   private
 41     layeredImage: TLayeredImage32;
 42     buttonGroup: TButtonGroupLayer32;
 43     rotateGroup: TRotatingGroupLayer32;
 44     transformLayer: TTransformLayer32;
 45     clickedLayer: TLayer32;
 46 
 47     popupPoint: TPoint;
 48     clickPoint: TPoint;
 49     ctrlPoints: TPathD;
 50     transformType: TTransformType;
 51     doTransformOnIdle: Boolean;
 52     allowRotatePivotMove: Boolean;
 53     procedure ResetSpline(vert: Boolean);
 54     procedure ResetVertProjective;
 55     procedure ResetSkew(isVerticalSkew: Boolean);
 56     procedure ResetRotate;
 57     procedure DoTransform;
 58     procedure AppIdle(Sender: TObject; var Done: Boolean);
 59   public
 60     procedure ExcuteTransform();
 61     procedure WMERASEBKGND(var message: TMessage); message WM_ERASEBKGND;
 62   end;
 63 
 64 var
 65   frmTransform: TfrmTransform;
 66 
 67 implementation
 68 
 69 {$R *.dfm}
 70 
 71 uses
 72   Img32.Fmt.BMP, Img32.Fmt.PNG, Img32.Fmt.JPG, Img32.Draw, Img32.Vector,
 73   Img32.Extra, Img32.Resamplers, Img32.Transform;
 74 
 75 procedure TfrmTransform.AppIdle(Sender: TObject; var Done: Boolean);
 76 begin
 77   if doTransformOnIdle then
 78   begin
 79     doTransformOnIdle := false;
 80     DoTransform;
 81   end;
 82   btnPaste.Enabled := TImage32.CanPasteFromClipboard;   //是否允许粘贴(会检查剪切板中是否有内容)
 83 end;
 84 
 85 procedure TfrmTransform.btnAddControlPointClick(Sender: TObject);
 86 var
 87   len: Integer;
 88 begin
 89   // add an extra spline control point
 90   if not Assigned(buttonGroup) then
 91     Exit;
 92   if Sender <> nil then
 93   begin
 94     popupPoint := Point(transformLayer.MidPoint);
 95   end;
 96 
 97   len := Length(ctrlPoints);
 98   SetLength(ctrlPoints, len + 1);
 99   ctrlPoints[len] := PointD(popupPoint);
100   with buttonGroup.AddButton(PointD(popupPoint)) do
101     CursorId := crSizeAll;
102   DoTransform;
103 end;
104 
105 procedure TfrmTransform.btnCopyClick(Sender: TObject);
106 begin
107   transformLayer.Image.CopyToClipBoard;
108 end;
109 
110 procedure TfrmTransform.ExcuteTransform;
111 begin   //根据类别执行不同的变换
112   case transformType of
113     ttAffineSkewV:    //垂直倾斜
114       ResetSkew(True);
115     ttAffineSkewH:    //水平倾斜
116       ResetSkew(False);
117     ttProjective:    //垂直投影
118       ResetVertProjective;
119     ttSplineV:       //垂直样条线
120       ResetSpline(true);
121     ttSplineH:   //水平样条线
122       ResetSpline(false);
123     ttAffineRotate:
124       ResetRotate;  //仿射旋转
125   end;
126   btnAddControlPoint.Enabled := (transformType = ttSplineV) or (transformType = ttSplineH);
127 end;
128 
129 procedure TfrmTransform.btnOpenClick(Sender: TObject);
130 begin   //打开图片
131   if not OpenDialog1.Execute then
132     Exit;
133   transformLayer.Image.LoadFromFile(OpenDialog1.FileName);
134   transformLayer.Image.CropTransparentPixels;
135   ExcuteTransform;
136 end;
137 
138 procedure TfrmTransform.btnPasteClick(Sender: TObject);
139 begin   //从系统剪切板粘贴图片
140   if TImage32.CanPasteFromClipboard and transformLayer.Image.PasteFromClipboard then
141   begin
142     transformLayer.Image.CropTransparentPixels;
143     ExcuteTransform;
144   end;
145 end;
146 
147 procedure TfrmTransform.btnResetClick(Sender: TObject);
148 begin  //重置
149   transformLayer.Image.LoadFromResource('beetle', 'PNG');
150   transformLayer.ImageBak.Assign(transformLayer.Image);
151   transformLayer.UpdateHitTestMask;
152   transformLayer.AutoPivot := true;
153   transformLayer.PositionCenteredAt(PointD(ClientWidth / 2, ClientHeight / 2));
154   cbType.ItemIndex := 0;
155   cbTypeChange(nil);
156 end;
157 
158 procedure TfrmTransform.btnSaveAsClick(Sender: TObject);
159 begin  //另存为
160   if SaveDialog1.Execute then
161     transformLayer.Image.SaveToFile(SaveDialog1.FileName);
162 end;
163 
164 procedure TfrmTransform.cbTypeChange(Sender: TObject);
165 var
166   pt: TPointD;
167 begin  //转换类型发生变化
168   // make each transform additive
169 
170   case cbType.ItemIndex of
171     0:
172       transformType := ttAffineSkewV;   //1.Vertical Skew
173     1:
174       transformType := ttAffineSkewH;   //2.Horizontal Skew
175     2:
176       transformType := ttProjective;   //3.Vertical Projective
177     3:
178       transformType := ttSplineV;      //4.Vertical Spline
179     4:
180       transformType := ttSplineH;      //5.Horizontal Spline
181     5:
182       transformType := ttAffineRotate;      //6.Rotate
183   end;
184 
185   with transformLayer do
186   begin
187     pt := MidPoint;
188     Image.CropTransparentPixels;
189     PositionCenteredAt(pt);
190     ImageBak.Assign(Image);
191   end;
192   ExcuteTransform;
193 end;
194 
195 procedure TfrmTransform.DoTransform;
196 var
197   pt: TPoint;
198   mat: TMatrixD;
199   delta: double;
200 begin
201   // except for rotation, use ctrlPoints to update the 'transformed' layer
202   with transformLayer do
203   begin
204     if (Image.Width = 0) or (Image.Height = 0) then
205       Exit;
206     case transformType of
207       ttAffineSkewV, ttAffineSkewH:
208         begin
209           Image.Assign(ImageBak);
210           mat := IdentityMatrix;
211           if transformType = ttAffineSkewV then
212           begin
213             delta := (ctrlPoints[1].Y - Image.Height) - ctrlPoints[0].Y;
214             mat[0][1] := delta / Image.Width;
215           end
216           else
217           begin
218             delta := (ctrlPoints[1].X - Image.Width) - ctrlPoints[0].X;
219             mat[1][0] := delta / Image.Height;
220           end;
221           // the returned pt states the offset of the new (transformed) image
222           pt := AffineTransformImage(Image, mat);
223           with Point(ctrlPoints[0]) do
224             PositionAt(X + pt.X, Y + pt.Y);
225         end;
226       ttAffineRotate:
227         begin
228           transformLayer.Angle := UpdateRotatingButtonGroup(rotateGroup);
229           StatusBar1.SimpleText := Format(' ROTATE TRANSFORM - angle:%1.0n', [transformLayer.Angle * 180 / PI]);
230         end;
231       ttProjective:
232         begin
233           Image.Assign(ImageBak);
234           if not ProjectiveTransform(Image, Rectangle(Image.Bounds), ctrlPoints, NullRect) then
235             Exit;
236           pt := GetBounds(ctrlPoints).TopLeft;
237           PositionAt(pt.X, pt.Y);
238         end;
239       ttSplineV:
240         begin
241           Image.Assign(ImageBak);
242           if not SplineVertTransform(Image, ctrlPoints, stQuadratic, clRed32, pt) then
243             Exit;
244           PositionAt(pt.X, pt.Y);
245         end;
246       ttSplineH:
247         begin
248           Image.Assign(ImageBak);
249           if not SplineHorzTransform(Image, ctrlPoints, stQuadratic, clRed32, pt) then
250             Exit;
251           PositionAt(pt.X, pt.Y);
252         end;
253     end;
254     UpdateHitTestMask;
255   end;
256   PaintBox1.Invalidate;
257 
258 end;
259 
260 procedure TfrmTransform.FormCreate(Sender: TObject);
261 begin
262   self.BorderStyle := bsNone;
263 
264   // DefaultResampler := rNearestResampler;
265   // DefaultResampler := rBilinearResampler;
266   DefaultResampler := rBicubicResampler;    //设置默认采样方式
267 
268   // SETUP THE LAYERED IMAGE
269   DefaultButtonSize := DPIAware(10);     //设置默认按钮大小(控制点吗？？？)
270   allowRotatePivotMove := true; // false;//
271 
272   Application.OnIdle := AppIdle;
273 
274   layeredImage := TLayeredImage32.Create;
275   layeredImage.BackgroundColor := Color32(clBtnFace);
276 
277   // Layer 0: bottom 'hatched' design layer
278   layeredImage.AddLayer(TLayer32, nil, 'hatched');
279 
280   // Layer 1: for the transformed image
281   transformLayer := TTransformLayer32(layeredImage.AddLayer(TTransformLayer32));
282   // transformLayer.MasterImage.LoadFromResource('GRADIENT', 'PNG');
283 
284   transformLayer.Image.LoadFromResource('beetle', 'PNG');
285   transformLayer.ImageBak.Assign(transformLayer.Image);
286 
287   transformLayer.CursorId := crHandPoint;
288   transformLayer.AutoPivot := true;
289   transformLayer.UpdateHitTestMask;
290 
291   cbType.ItemIndex := 0;
292   cbTypeChange(nil);
293 end;
294 
295 procedure TfrmTransform.FormDestroy(Sender: TObject);
296 begin
297   layeredImage.Free;
298   Application.OnIdle := nil;
299 end;
300 
301 procedure TfrmTransform.FormResize(Sender: TObject);
302 var
303   w, h: Integer;
304   mp: TPointD;
305   dx, dy: double;
306 begin    //尺寸变化时
307   if csDestroying in ComponentState then
308     Exit;
309   if not Assigned(layeredImage) then
310     Exit;
311 
312   w := PaintBox1.ClientWidth; //  ClientWidth;
313   h := PaintBox1.ClientHeight; // ClientHeight;
314 
315   // resize layeredImage and the background hatch layer  //背景重绘
316   layeredImage.SetSize(w, h);
317   with layeredImage[0] do
318   begin
319     SetSize(w, h);
320     HatchBackground(Image, clWhite32, $FFE0E0E0);
321   end;
322   // and center transformlayer
323   mp := transformLayer.MidPoint;
324   transformLayer.PositionCenteredAt(PointD(w / 2, h / 2));
325 
326   // and offset everything else
327   with transformLayer.MidPoint do
328   begin
329     dx := X - mp.X;
330     dy := Y - mp.Y;
331   end;
332   if Assigned(buttonGroup) then      //尺寸控制
333     buttonGroup.Offset(Round(dx), Round(dy))
334   else if Assigned(rotateGroup) then  //旋转控制
335     rotateGroup.Offset(Round(dx), Round(dy));
336   ctrlPoints := TranslatePath(ctrlPoints, dx, dy);
337   PaintBox1.Invalidate;
338 end;
339 
340 procedure TfrmTransform.PaintBox1DblClick(Sender: TObject);
341 begin    //双击，添加控制点
342   if (transformType <> ttSplineV) and (transformType <> ttSplineH) then
343     Exit;
344   GetCursorPos(popupPoint);
345   popupPoint := PaintBox1.ScreenToClient(popupPoint);
346   btnAddControlPointClick(nil);
347 end;
348 
349 procedure TfrmTransform.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
350 begin
351   if (ssRight in Shift) then
352     Exit; // popup menu
353 
354   clickPoint := System.Types.Point(X, Y);
355   clickedLayer := layeredImage.GetLayerAt(clickPoint);
356 end;
357 
358 procedure TfrmTransform.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
359 var
360   dx, dy, idx, altIdx: Integer;
361   pt: TPoint;
362   layer: TLayer32;
363 begin
364   pt := System.Types.Point(X, Y);
365 
366   // if not clicked-moving a layer, then update the cursor and exit.
367   if not (ssLeft in Shift) then
368   begin
369     // get the top-most 'clickable' layer under the mouse cursor
370     layer := layeredImage.GetLayerAt(pt);
371     if Assigned(layer) then
372       Cursor := layer.CursorId
373     else
374       Cursor := crDefault;
375     Exit;
376   end;
377   if not Assigned(clickedLayer) then
378     Exit;
379 
380   if clickedLayer = transformLayer then
381   begin
382     dx := pt.X - clickPoint.X;
383     dy := pt.Y - clickPoint.Y;
384     clickPoint := pt;
385     ctrlPoints := TranslatePath(ctrlPoints, dx, dy);
386     clickedLayer.Offset(dx, dy);
387     if Assigned(buttonGroup) then
388       buttonGroup.Offset(dx, dy);
389     if Assigned(rotateGroup) and not allowRotatePivotMove then
390       rotateGroup.Offset(dx, dy);
391     PaintBox1.Invalidate;
392   end
393   else if clickedLayer.parent = rotateGroup then
394   begin
395     if clickedLayer = rotateGroup.PivotButton then
396     begin
397       // moving the pivot button in the rotation group
398       dx := pt.X - clickPoint.X;
399       dy := pt.Y - clickPoint.Y;
400       clickPoint := pt;
401       rotateGroup.Offset(dx, dy);
402       transformLayer.PivotPt := rotateGroup.PivotButton.MidPoint;
403     end
404     else
405     begin
406       // moving the angle button in the rotation group
407       clickedLayer.PositionCenteredAt(pt.X, pt.Y);
408       // we could do the rotation here, but it's
409       // much smoother when done via the AppIdle event.
410       doTransformOnIdle := true;
411     end;
412     PaintBox1.Invalidate;
413   end
414   else if clickedLayer.parent = buttonGroup then
415   begin
416     // clicking a general purpose button (layer)
417 
418     // if skewing, keep the buttons axis aligned
419     if transformType = ttAffineSkewV then
420       pt.X := Round(clickedLayer.MidPoint.X);
421     if transformType = ttAffineSkewH then
422       pt.Y := Round(clickedLayer.MidPoint.Y);
423 
424     idx := clickedLayer.Index;
425     if transformType = ttProjective then
426     begin
427       // get the index of the moving button's vertical partner
428       // noting that there are 4 buttons in the group ...
429       altIdx := 3 - idx;
430       ctrlPoints[altIdx].X := pt.X;
431       buttonGroup[altIdx].PositionCenteredAt(ctrlPoints[altIdx]);
432     end;
433     clickedLayer.PositionCenteredAt(pt.X, pt.Y);
434     ctrlPoints[idx] := PointD(pt);
435     doTransformOnIdle := true;
436   end;
437 
438 end;
439 
440 procedure TfrmTransform.PaintBox1Paint(Sender: TObject);
441 var
442   updateRect: TRect;
443 begin
444   // nb: layeredImage32.GetMergedImage returns the rectangular region of the
445   // image that has changed since the last GetMergedImage call.
446   // This accommodates updating just the region that's changed. This is
447   // generally a lot faster than updating the whole merged image).
448   with layeredImage.GetMergedImage(btnHideDesigners.Down, updateRect) do
449   begin
450     // now we just refresh the 'updateRect' region
451     CopyToDc(updateRect, updateRect, PaintBox1.Canvas.Handle, false);
452   end;
453 end;
454 
455 procedure TfrmTransform.ResetRotate;
456 begin   //仿射旋转
457   FreeAndNil(buttonGroup);     //移出尺寸控制点
458   FreeAndNil(rotateGroup);     //移出旋转控制点
459 
460   transformLayer.UpdateHitTestMask;
461   transformLayer.ResetAngle;
462 
463   transformLayer.AutoPivot := not allowRotatePivotMove;
464   if allowRotatePivotMove then
465     transformLayer.PivotPt := transformLayer.MidPoint;
466 
467   // create rotate button group while also disabling pivot button moves
468   rotateGroup := CreateRotatingButtonGroup(transformLayer, DefaultButtonSize, clWhite32, clAqua32, 0, -Angle90);
469   rotateGroup.AngleButton.CursorId := crSizeWE;
470 
471   PaintBox1.Invalidate;
472   StatusBar1.SimpleText := ' ROTATE TRANSFORM';
473 end;
474 
475 procedure TfrmTransform.ResetSkew(isVerticalSkew: Boolean);
476 begin
477   FreeAndNil(buttonGroup);
478   FreeAndNil(rotateGroup);
479 
480   SetLength(ctrlPoints, 2);
481   with transformLayer.InnerRect do
482   begin
483     ctrlPoints[0] := TopLeft;
484     ctrlPoints[1] := BottomRight;
485   end;
486   // now make fPts relative to the canvas surface
487   with transformLayer do
488     ctrlPoints := TranslatePath(ctrlPoints, Left, Top);
489 
490   buttonGroup := CreateButtonGroup(layeredImage.Root, ctrlPoints, bsRound, DefaultButtonSize, clGreen32);
491 
492   PaintBox1.Invalidate;
493   if isVerticalSkew then
494     StatusBar1.SimpleText := ' VERTICAL SKEW'
495   else
496     StatusBar1.SimpleText := ' HORIZONTAL SKEW';
497 end;
498 
499 procedure TfrmTransform.ResetSpline(vert: Boolean);
500 begin
501   FreeAndNil(buttonGroup);
502   FreeAndNil(rotateGroup);
503 
504   if vert then
505   begin
506     with transformLayer.Image do
507       ctrlPoints := MakePath([0, 0, Width div 2, 0, Width, 0]);
508     StatusBar1.SimpleText := ' VERT SPLINE TRANSFORM: Right click to add control points';
509   end
510   else
511   begin
512     with transformLayer.Image do
513       ctrlPoints := MakePath([0, 0, 0, Height div 2, 0, Height]);
514     StatusBar1.SimpleText := ' HORZ SPLINE TRANSFORM: Right click to add control points';
515   end;
516 
517   // now make fPts relative to the canvas surface
518   with transformLayer do
519     ctrlPoints := TranslatePath(ctrlPoints, Left, Top);
520   buttonGroup := CreateButtonGroup(layeredImage.Root, ctrlPoints, bsRound, DefaultButtonSize, clGreen32);
521 
522   PaintBox1.Invalidate;
523 end;
524 
525 procedure TfrmTransform.ResetVertProjective;
526 begin
527   FreeAndNil(buttonGroup);
528   FreeAndNil(rotateGroup);
529 
530   ctrlPoints := Rectangle(transformLayer.InnerRect);
531   // now make fPts relative to the canvas surface
532   with transformLayer do
533     ctrlPoints := TranslatePath(ctrlPoints, Left, Top);
534 
535   buttonGroup := CreateButtonGroup(layeredImage.Root, ctrlPoints, bsRound, DefaultButtonSize, clGreen32);
536 
537   PaintBox1.Invalidate;
538   StatusBar1.SimpleText := ' PROJECTIVE TRANSFORM';
539 end;
540 
541 procedure TfrmTransform.WMERASEBKGND(var message: TMessage);
542 begin
543   // Since we want full control of painting (see FormPaint below),
544   // we'll stops Windows unhelpfully erasing the form's canvas.
545   message.Result := 1;
546 end;
547 
548 end.