在Delphi中缩放Zoom画布区域

9

我在Delphi中制作类似Paint的东西。我找到了如何制作缩放功能:

procedure SetCanvasZoomFactor(Canvas: TCanvas; AZoomFactor: Integer);
var
  i: Integer;
begin
  if AZoomFactor = 100 then
    SetMapMode(Canvas.Handle, MM_TEXT)
  else
  begin
    SetMapMode(Canvas.Handle, MM_ISOTROPIC);
    SetWindowExtEx(Canvas.Handle, AZoomFactor, AZoomFactor, nil);
    SetViewportExtEx(Canvas.Handle, 100, 100, nil);
  end;
end;



procedure TMainForm.btnZoomPlusClick(Sender: TObject);
var
  bitmap: TBitmap;
begin 

  bitmap := TBitmap.Create;
  if(zoomVal < 1000) then
      zoomVal:=zoomVal+zoomConst; //zoomVal = 100 by default; zoomConst = 150;
  try
    bitmap.Assign(MainForm.imgMain.Picture.Bitmap);
    SetCanvasZoomFactor(bitmap.Canvas, zoomVal);
    Canvas.Draw(MainForm.imgMain.Left,MainForm.imgMain.Top, bitmap); 
  finally
    bitmap.Free
  end;
end;

但是,问题是 - 它只缩放图像的左上角区域。

例如,在缩放之前: enter image description here 在缩放之后: enter image description here

我希望能够在缩放后通过整个图片区域移动。我该如何做到这一点?


2
这里有一个动画缩放选择器,以及如何制作动画平移 - TLama
@TLama,天哪,Delphi编程并不像我想象的那么简单!如果没有其他方法来实现这样的缩放,那我就使用这个解决方案。 - DanilGholtsman
1
不必那么复杂。有使用流畅动画的控件。使用这样的控件看起来感觉很好,但如果您不需要动画,请等待更简单的解决方案;-) - TLama
1
@TLama 嗯,是的,实际上我现在不需要流畅的动画或类似的东西。但还是谢谢你提供的链接! - DanilGholtsman
1个回答

13

您可以为所有设备上下文使用 SetWorldTransform

一个示例实现可能如下所示:

Procedure SetCanvasZoomAndRotation(ACanvas: TCanvas; Zoom: Double;
  Angle: Double; CenterpointX, CenterpointY: Double);
var
  form: tagXFORM;
  rAngle: Double;
begin
  rAngle := DegToRad(Angle);
  SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
  SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
  form.eM11 := Zoom * Cos(rAngle);
  form.eM12 := Zoom * Sin(rAngle);
  form.eM21 := Zoom * (-Sin(rAngle));
  form.eM22 := Zoom * Cos(rAngle);
  form.eDx := CenterpointX;
  form.eDy := CenterpointY;
  SetWorldTransform(ACanvas.Handle, form);
end;

Procedure ResetCanvas(ACanvas: TCanvas);
begin
  SetCanvasZoomAndRotation(ACanvas, 1, 0, 0, 0);
end;

在绘制之前,您可以为所需的画布定义缩放、X和Y偏移和旋转。在您的情况下,您可以选择一个缩放比例,将其绘制到画布上,并且在滚动时增加或减少X和/或Y的值,并使用相同的缩放比例再次调用该过程并绘制您的图形。

编辑 以下代码展示如何使用此过程。

procedure TForm2.PaintBox1Paint(Sender: TObject);
var
  i, w, h: Integer;
  C: TCanvas;
begin
  C := TPaintBox(Sender).Canvas;
  w := TPaintBox(Sender).Width;
  h := TPaintBox(Sender).Height;
  for i := 0 to 9 do
  begin
    SetCanvasZoomAndRotation(C, 1 + i / 5, i * 36, w div 2, h div 2);
    C.Draw(0, 0, Image1.Picture.Graphic);
    C.Brush.Style := bsClear;
    C.TextOut(50, 0, Format('Hi this is an example %d', [i]));
  end;
end;

用于显示以下结果:

enter image description here

作为回应您的评论,关于如何与轨迹条一起使用它,您可以实现类似以下代码:

procedure TForm2.FormCreate(Sender: TObject);
begin
  DoubleBuffered := true;
end;

procedure TForm2.PaintBox1Paint(Sender: TObject);
var             // a Paintbox aligned alClient
  C:TCanvas;
begin
  TrackBarHorz.Max := Round(Image1.Picture.Graphic.Width * SpinEditZoomInPercent.Value / 100 - TPaintBox(Sender).Width);
  TrackBarVert.Max := Round(Image1.Picture.Graphic.Height * SpinEditZoomInPercent.Value / 100 - TPaintBox(Sender).Height);
  C := TPaintBox(Sender).Canvas;
  SetCanvasZoomAndRotation(c , SpinEditZoomInPercent.Value / 100, 0
                           , - TrackBarHorz.Position
                           , - TrackBarVert.Position);
  C.Draw(0,0,Image1.Picture.Graphic);
end;

procedure TForm2.SpinEditZoomInPercentChange(Sender: TObject);
begin
   PaintBox1.Invalidate;
end;

procedure TForm2.BothTrackbarsEvent(Sender: TObject);
begin
   PaintBox1.Invalidate;
end;

哦,谢谢!我尝试像那样使用它,但是这种方式不起作用(我使用了轨迹条,因为它很容易检查更改)这是代码http://pastebin.com/X4umbmTX我做错了什么? - DanilGholtsman
哦,非常感谢!但是能否将它用于 TImage 而不是 TPaintBox? - DanilGholtsman
1
如果您使用TImage,可以将其与任何画布(甚至是打印机)一起使用。但是,请注意,如果新绘制的图形不覆盖整个图像,则必须清除包含的位图(例如通过Image1.Picture.Bitmap := nil),否则可能会发现在之前绘制的“更大”的位图上绘制了一个小位图。请随意尝试,找到最适合您需求和目的的方法。 - bummi

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接