FireMonkey中鼠标移动Label时出现脱离、闪烁问题求助

我在FMX中尝试通过鼠标移动对象，用两个TLabel做演示：

• Label1嵌套在TRectangle（Rectangle1）中，Rectangle1又属于TPaintBox；
• Label2直接隶属于PaintBox1。
  实际操作时鼠标会从Label1和Label2上“脱离”，导致对象闪烁并乱跑。请问问题出在哪里？

相关代码 #

Pascal代码 #

type
  TMouseRecorder=record
    dx,dy,
    LastX,LastY: Single;
    bLButton_Down: Boolean;
  end;
Var MouseRecorder: TMouseRecorder;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
     with MouseRecorder do begin
       LastX     := x;
       LastY     := y;
       bLButton_Down := True;
     end;
end;
procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
     with MouseRecorder do begin
       if bLButton_Down then begin
         dx:=x-LastX;
         dy:=y-LastY;
         LastX:=X;
         LastY:=Y;
         if Sender=Label2 then begin
           with Label2 do begin
             BeginUpdate;
               Position.X:=Position.X+dx;
               Position.Y:=Position.Y+dy;
             EndUpdate;
           end;
         end else begin
           with (Label1.ParentControl as TRectangle) do begin
             BeginUpdate;
               Position.X:=Position.X+dx;
               Position.Y:=Position.Y+dy;
             EndUpdate;
           end;
         end;
         PaintBox1.Repaint; // because using BeginUpdate/EndUpdate;
       end;
     end;
end;
procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
     MouseRecorder.bLButton_Down := False;
end;

DFM代码 #

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object PaintBox1: TPaintBox
    Align = Client
    Size.Width = 640.000000000000000000
    Size.Height = 480.000000000000000000
    Size.PlatformDefault = False
    OnClick = PaintBox1Click
    object Rectangle1: TRectangle
      Position.X = 176.000000000000000000
      Position.Y = 160.000000000000000000
      Size.Width = 121.000000000000000000
      Size.Height = 89.000000000000000000
      Size.PlatformDefault = False
      OnMouseDown = Label1MouseDown
      OnMouseMove = Label1MouseMove
      OnMouseUp = Label1MouseUp
      object Label1: TLabel
        Align = Client
        Size.Width = 121.000000000000000000
        Size.Height = 89.000000000000000000
        Size.PlatformDefault = False
        TextSettings.HorzAlign = Center
        Text = '**** Label1 ****'
        TabOrder = 0
        OnMouseDown = Label1MouseDown
        OnMouseMove = Label1MouseMove
        OnMouseUp = Label1MouseUp
      end
    end
    object Label2: TLabel
      Position.X = 88.000000000000000000
      Position.Y = 56.000000000000000000
      Size.Width = 65.000000000000000000
      Size.Height = 41.000000000000000000
      Size.PlatformDefault = False
      Text = 'Label2'
      TabOrder = 0
    end
  end
end

问题根源 #

1. 事件绑定不完整：Label2没有绑定MouseMove和MouseUp事件，拖动时鼠标一旦离开Label2，就会失去事件响应，直接“脱离”。
2. 坐标计算逻辑错误：MouseMove中的X/Y是控件局部坐标，拖动控件时位置变化，后续的局部坐标和初始记录的LastX/LastY基准不匹配，导致偏移量计算混乱，对象乱跑。
3. 全局变量干扰：MouseRecorder是全局变量，不同控件的事件会同时修改它的值，拖动过程中切换事件源会直接打乱计算逻辑。
4. 不必要的重绘：使用BeginUpdate/EndUpdate后手动调用PaintBox1.Repaint会触发额外的界面刷新，导致闪烁。

修复方案 #

1. 统一事件绑定 #

给Label2也绑定MouseDown、MouseMove、MouseUp事件（建议把事件处理函数重命名为通用的DragMouseDown类名称，避免混淆）。

2. 改用屏幕坐标计算偏移 #

局部坐标会随控件位置变化，改用屏幕坐标作为基准，确保偏移计算一致：

• 鼠标按下时记录控件初始位置和鼠标的屏幕坐标；
• 鼠标移动时计算屏幕坐标的变化量，直接更新控件位置。

3. 优化拖动状态跟踪 #

在记录器中保存当前拖动的目标控件，避免不同控件的事件互相干扰。

修复后的代码示例 #

Pascal代码 #

type
  TMouseRecorder=record
    DragTarget: TFmxObject; // 当前拖动的目标控件
    StartCtrlPos: TPointF;  // 拖动开始时控件的位置
    StartMouseScreenPos: TPointF; // 拖动开始时鼠标的屏幕坐标
    bLButton_Down: Boolean;
  end;
Var MouseRecorder: TMouseRecorder;

procedure TForm1.DragMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  Target: TFmxObject;
begin
  if Button <> TMouseButton.mbLeft then Exit;
  
  // 确定拖动目标：Label1的拖动目标是父级Rectangle，其他控件直接用自身
  if Sender = Label1 then
    Target := Label1.ParentControl
  else
    Target := Sender as TFmxObject;
    
  with MouseRecorder do begin
    DragTarget := Target;
    StartCtrlPos := Target.Position.Point;
    StartMouseScreenPos := Screen.MousePos;
    bLButton_Down := True;
  end;
end;

procedure TForm1.DragMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
var
  Delta: TPointF;
begin
  with MouseRecorder do begin
    if bLButton_Down and Assigned(DragTarget) then begin
      // 计算鼠标屏幕坐标的变化量
      Delta := Screen.MousePos - StartMouseScreenPos;
      // 更新控件位置
      DragTarget.Position.Point := StartCtrlPos + Delta;
    end;
  end;
end;

procedure TForm1.DragMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if Button = TMouseButton.mbLeft then begin
    MouseRecorder.bLButton_Down := False;
    MouseRecorder.DragTarget := nil;
  end;
end;

DFM代码调整 #

确保Label2绑定了事件：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object PaintBox1: TPaintBox
    Align = Client
    Size.Width = 640.000000000000000000
    Size.Height = 480.000000000000000000
    Size.PlatformDefault = False
    OnClick = PaintBox1Click
    object Rectangle1: TRectangle
      Position.X = 176.000000000000000000
      Position.Y = 160.000000000000000000
      Size.Width = 121.000000000000000000
      Size.Height = 89.000000000000000000
      Size.PlatformDefault = False
      OnMouseDown = DragMouseDown
      OnMouseMove = DragMouseMove
      OnMouseUp = DragMouseUp
      object Label1: TLabel
        Align = Client
        Size.Width = 121.000000000000000000
        Size.Height = 89.000000000000000000
        Size.PlatformDefault = False
        TextSettings.HorzAlign = Center
        Text = '**** Label1 ****'
        TabOrder = 0
        OnMouseDown = DragMouseDown
        OnMouseMove = DragMouseMove
        OnMouseUp = DragMouseUp
      end
    end
    object Label2: TLabel
      Position.X = 88.000000000000000000
      Position.Y = 56.000000000000000000
      Size.Width = 65.000000000000000000
      Size.Height = 41.000000000000000000
      Size.PlatformDefault = False
      Text = 'Label2'
      TabOrder = 0
      OnMouseDown = DragMouseDown
      OnMouseMove = DragMouseMove
      OnMouseUp = DragMouseUp
    end
  end
end

额外优化建议 #

• 给拖动中的控件设置Cursor := crDrag，提升用户操作体验；
• 复杂场景下可以封装通用拖动类，或者使用FMX内置的TDragObject机制，避免全局变量的使用。

内容的提问来源于stack exchange，提问作者Giovanni Brambilla