Delphi VCL转FMX：Image控件拖动超出窗体边界的代码适配

我正在将Delphi VCL应用程序迁移至FireMonkey（FMX）平台，当前卡在一段代码的适配环节：原本在VCL中能够拖动Image1控件超出窗体边界的代码，在FMX窗体中无法实现相同效果。尝试直接沿用VCL中的代码，但Image1无法像之前的应用那样移出窗体范围。

原VCL代码 #

procedure Tfrmmain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if ssLeft in Shift then
  begin
    CanDragging:= True;
    StartDragPos:= ClientToScreen(PointF(X, Y));
  end;
end;

procedure Tfrmmain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
begin
  if CanDragging then
  begin
    Image1.Position.Point:= ScreenToClient(ClientToScreen(
    Image1.Position.Point + ClientToScreen(PointF(X, Y)) - StartDragPos));
  end;
end;

procedure Tfrmmain.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  CanDragging:= False;
end;

procedure Tfrmmain.MouseUpEvent(X, Y: Integer);
begin
  CanDragging:= False;
  StartDragPos:= Point(0, 0);
end;

适配FMX的解决方案 #

修改要点 #

• FMX中Position.Point是控件相对于父容器的坐标，无需嵌套多次屏幕坐标转换，直接计算偏移量即可
• 必须将窗体的ClipChildren属性设为False，否则控件超出父边界会被自动裁剪
• 简化坐标计算逻辑，避免冗余转换导致的坐标错误

修改后的完整代码 #

首先在窗体类的私有部分补充变量声明：

private
  CanDragging: Boolean;
  StartDragPos: TPointF;
  DragOffset: TPointF; // 记录鼠标在Image内的初始相对位置

然后替换三个鼠标事件的实现：

procedure Tfrmmain.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if ssLeft in Shift then
  begin
    CanDragging := True;
    // 保存鼠标在Image控件内的点击位置偏移
    DragOffset := PointF(X, Y);
  end;
end;

procedure Tfrmmain.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
var
  NewPos: TPointF;
begin
  if CanDragging then
  begin
    // 计算新位置：鼠标的屏幕坐标转换为窗体相对坐标，减去鼠标在Image内的偏移
    NewPos := ScreenToClient(Mouse.Position) - DragOffset;
    Image1.Position.Point := NewPos;
  end;
end;

procedure Tfrmmain.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  CanDragging := False;
end;

procedure Tfrmmain.MouseUpEvent(X, Y: Integer);
begin
  CanDragging := False;
  StartDragPos := PointF(0, 0);
end;

关键配置 #

• 选中窗体，在Object Inspector中找到ClipChildren属性，设置为False，确保Image超出窗体时不会被裁剪
• 确认Image控件的HitTest属性为True（默认值），保证能正常接收鼠标事件

内容的提问来源于stack exchange，提问作者Caitano Oliveira