缩小问题。不缩小以放大图像

Question

我在Graphics32: Pan with mouse-drag, zoom to mouse cursor with mouse wheel上看到了这个很棒的示例代码

我在win 10操作系统上使用Delphi社区。我运行这个程序，缩放会放大，但当我缩小时，它会变成正常大小的图像，并且不会放大图像。

procedure TForm3.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  Image.Picture.LoadFromFile('C:\PASCHEMATIC.TIFF');
  Image.Stretch := True;
  Image.Height := Round(Image.Width * Image.Picture.Height / 
    Image.Picture.Width);
  FOrgImgBounds := Image.BoundsRect;
end;

procedure TForm3.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    if FDragging then
    Image.SetBounds(X - FFrom.X, Y - FFrom.Y, Image.Width, Image.Height);
end;

procedure TForm3.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image.Enabled := True;
  FDragging := False;
end;

procedure TForm3.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
  ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
  R: TRect;
begin
  MousePos := Image.ScreenToClient(MousePos);
  with Image, MousePos do
  if PtInRect(ClientRect, MousePos) and ((WheelDelta > 0) and
  (Height < Self.ClientHeight) and (Width < Self.ClientWidth)) or
  ((WheelDelta < 0) and (Height > 20) and (Width > 20)) then
  begin
    R := BoundsRect;
    R.Left := Left + X - Round(ZoomFactor[WheelDelta > 0] * X);
    R.Top := Top + Y - Round(ZoomFactor[WheelDelta > 0] * Y);
    R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * Width);
    R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * Height);
    BoundsRect := R;
    Handled := True;
  end;
end;

procedure TForm3.ImageDblClick(Sender: TObject);
begin
  Image.BoundsRect := FOrgImgBounds;
end;

procedure TForm3.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not (ssDouble in Shift) then
  begin
    FDragging := True;
    Image.Enabled := False;
    FFrom := Point(X, Y);
    MouseCapture := True;
  end;
end;

问题是如何让图像进一步缩小以放大图像？

我已经使用了ZoomFactor的值。看起来我得先放大它才能缩小。

Answer 1

首先，定义：zoom in。所以，你的问题可能是如何放大，以便放大图像？或者，为什么图像不放大？

答案在FormMouseWheel过程中：

with Image, MousePos do
  if PtInRect(ClientRect, MousePos) and ((WheelDelta > 0) and
  (Height < Self.ClientHeight) and (Width < Self.ClientWidth)) or
  ((WheelDelta < 0) and (Height > 20) and (Width > 20)) then
  begin
    ...

这也揭示了使用with ...的陷阱:很难看到代码中实际引用了哪些对象：

(Height < Self.ClientHeight) 
// Height refers to Image.Height, because it is closer in
// scope (because of the with clause,) than e.g. the form,
// which also has an Height property
// Self.ClientHeight refers to Form.ClientHeight because
// Self refers to the object who's method is running

同样的道理

(Width < Self.ClientWidth)
// Width refers to Image.Width and Self.ClientWidth refers to Form.ClientWidth

因此，您的问题的答案是，由于代码中应用的约束，图像不能变得比表单的任何一个范围都大。

要删除该约束，请删除

and (Height < Self.ClientHeight) and (Width < Self.ClientWidth)

从FormMouseWheel()过程中。

删除这些条件将允许Image变得比表单更大，从而使它包含的图像也变大。在某种程度上，还会有其他条件，比如内存限制，发挥作用。