Delphi 10.4 VCL MDI中TImage鼠标滚轮缩放偏移问题求助

我使用Delphi 10.4开发了一个VCL MDI应用，其中包含基于模态窗体的图片浏览器。近期为该窗体实现鼠标滚轮触发、以光标为中心的缩放功能，采用了示例代码：

procedure TfrmVisualizaImagem.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;
  Postion: TPoint;
begin
  Position := ImgRecibo.ScreenToClient(MousePos);
  if PtInRect(imgRecibo.ClientRect, Position) and ((WheelDelta > 0) or
      ((WheelDelta < 0) and (imgRecibo.Height > 20) and (imgRecibo.Width > 20))) then
    begin
    R := imgRecibo.BoundsRect;
    R.Left := imgRecibo.Left + Position.X - Round(ZoomFactor[WheelDelta > 0] * Position.X);
    R.Top := imgRecibo.Top + Position.Y - Round(ZoomFactor[WheelDelta > 0] * Position.Y);
    R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * imgRecibo.Width);
    R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * imgRecibo.Height);
    imgRecibo.BoundsRect := R;
    Handled := True;
    end;
end;

初次使用功能正常，但多次缩放后图片会向右上方偏移。日志显示即使鼠标位置固定，缩放几次后Position值仍会变化：

MousePos: 851,439
Position: 215,175
Rect: -22,-18,690,989
Imagem: 712,1007

MousePos: 851,439
Position: 237,193
Rect: -46,-37,737,1071
Imagem: 783,1108

MousePos: 851,439
Position: 261,212
Rect: -72,-58,789,1161
Imagem: 861,1219

MousePos: 851,439
Position: 287,233
Rect: -101,-81,846,1260
Imagem: 947,1341

MousePos: 851,439
Position: 316,256
Rect: -133,-107,909,1368
Imagem: 1042,1475

MousePos: 984,546
Position: 481,389
Rect: -181,-146,965,1477
Imagem: 1146,1623*

问题原因 #

1. 整数取整误差累积：每次缩放时对ZoomFactor计算后的坐标执行Round取整，多次操作后这些微小误差会不断累加，导致图片位置逐渐偏移。
2. 依赖整数矩形的计算逻辑：代码直接基于当前imgRecibo的整数BoundsRect计算新位置，没有维护精确的浮点型缩放基准，放大了误差的累积效应。
3. 坐标转换受偏移影响：从日志可见，固定屏幕鼠标位置时，图片控件的客户端坐标Position持续变大，说明累积的Left/Top偏移已经干扰了坐标转换结果。

解决方法 #

核心思路是用浮点型变量维护精确的缩放比例和偏移量，仅在最终设置控件边界时做一次取整，避免多次取整的误差累积。

步骤1：添加私有字段维护基准值 #

在窗体类中添加三个私有字段，记录精确的缩放比例和偏移：

type
  TfrmVisualizaImagem = class(TForm)
    imgRecibo: TImage;
    // 其他控件声明
  private
    FScale: Single;      // 当前缩放比例，初始值1.0
    FOffsetX: Single;    // 图片左上角的屏幕X偏移
    FOffsetY: Single;    // 图片左上角的屏幕Y偏移
    procedure UpdateImageBounds;
  public
    constructor Create(AOwner: TComponent); override;
  end;

步骤2：初始化基准值 #

在构造函数中初始化缩放比例和偏移：

constructor TfrmVisualizaImagem.Create(AOwner: TComponent);
begin
  inherited;
  FScale := 1.0;
  FOffsetX := imgRecibo.Left;
  FOffsetY := imgRecibo.Top;
end;

步骤3：实现边界更新方法 #

封装控件边界的更新逻辑，仅在此处做一次整数取整：

procedure TfrmVisualizaImagem.UpdateImageBounds;
var
  NewWidth, NewHeight, NewLeft, NewTop: Integer;
begin
  NewWidth := Round(imgRecibo.Picture.Width * FScale);
  NewHeight := Round(imgRecibo.Picture.Height * FScale);
  NewLeft := Round(FOffsetX);
  NewTop := Round(FOffsetY);
  imgRecibo.BoundsRect := Rect(NewLeft, NewTop, NewLeft + NewWidth, NewTop + NewHeight);
end;

步骤4：修正鼠标滚轮事件逻辑 #

基于浮点基准计算缩放中心和偏移，避免累积误差：

procedure TfrmVisualizaImagem.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
  ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
  MinScale = 0.1; // 最小缩放比例，防止图片过小
var
  MouseInImg: TPoint;
  RelX, RelY: Single; // 鼠标在原始图片上的相对坐标
  OldScale: Single;
begin
  MouseInImg := imgRecibo.ScreenToClient(MousePos);
  if not PtInRect(imgRecibo.ClientRect, MouseInImg) then Exit;

  // 计算鼠标在原始图片上的相对位置（不受当前缩放影响）
  RelX := (MouseInImg.X + imgRecibo.Left - FOffsetX) / FScale;
  RelY := (MouseInImg.Y + imgRecibo.Top - FOffsetY) / FScale;

  OldScale := FScale;
  FScale := FScale * ZoomFactor[WheelDelta > 0];
  if FScale < MinScale then FScale := MinScale;

  // 调整偏移量，保证鼠标位置为缩放中心
  FOffsetX := MousePos.X - RelX * FScale;
  FOffsetY := MousePos.Y - RelY * FScale;

  UpdateImageBounds;
  Handled := True;
end;

修正后优势 #

• 用浮点变量维护缩放和偏移，避免多次取整的误差累积；
• 基于原始图片的相对位置计算缩放中心，确保每次缩放精准以鼠标位置为锚点；
• 仅在最终设置控件边界时做一次取整，最大程度降低误差。

内容的提问来源于stack exchange，提问作者Luis Enrique