在Delphi中缩放画布区域

发布时间：2020-12-15 04:01:05 所属栏目：大数据来源：网络整理

导读：我在德尔福做了一些看起来像Paint的东西.我找到了如何制作缩放功能： procedure SetCanvasZoomFactor(Canvas: TCanvas; AZoomFactor: Integer);var i: Integer;begin if AZoomFactor = 100 then SetMapMode(Canvas.Handle,MM_TEXT) else begin SetMapMode(Ca

我在德尔福做了一些看起来像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,nil);
    SetViewportExtEx(Canvas.Handle,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;

但是,问题是 – 它仅缩放图像的左上区域.

例
缩放前：

放大后：

我希望能够在缩放后移动所有图片区域.我该怎么做？

解决方法

每个DC可以使用 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);
end;

您可以在绘画前为所需的画布定义“缩放”,“X Y Offest”和“旋转”.
在您的情况下,您将选择缩放,绘制到画布以及滚动/减小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,Image1.Picture.Graphic);
    C.Brush.Style := bsClear;
    C.TextOut(50,Format('Hi this is an example %d',[i]));
  end;
end;

用于显示以下结果：

作为对您的评论的回应,如何将其与轨道栏一起使用,您可以实现类似的功能

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,- TrackBarHorz.Position,- TrackBarVert.Position);
  C.Draw(0,Image1.Picture.Graphic);
end;

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

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

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!