在firemonkey中使用鼠标移动标签

Question

我必须用鼠标移动 FMX 对象，为了简单起见，我在这里使用

1. TLabel（Label1）属于TRectangle（矩形1），属于TPaintBox
2. 属于 PaintBox1 的 TLabel (Label2)。

结果是鼠标从 Label1 和 Label2 中“逃逸”，结果是一个闪烁的对象前往某处。

我做错了什么？

这是代码。

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;

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

感谢您的帮助或建议。

Answer 1

除非您设置

TLabel

（可以在对象检查器中完成），否则您将无法拖动

HitTest:=True;

。 只要

Label1

未设置为

Align

，您也将无法拖动

None

（在其矩形内）。

但这不是主要问题。 首先，在您的表格中做出以下声明：

    DragX,
    DragY:          Single;
    Dragging:       Boolean;
    DragControl:    TControl;

您可以使用

DragX

字段代替

DragY

和

DragXY: TPointF;

字段，并对方法进行适当的更改。

您可以删除您的

TMouseRecorder

声明。 不需要。

方法如下：

procedure TForm1.Label1MouseDown(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Single);
begin
  if Button=TMouseButton.mbLeft then begin
    DragControl:=Sender as TControl;
    Dragging:=True;
    DragX:=X;
    DragY:=Y;
  end;
end;

procedure TForm1.Label1MouseMove(Sender:TObject; Shift:TShiftState; X,Y:Single);
begin
  if Dragging then begin
    X:=X-DragX;
    Y:=Y-DragY;
    DragControl.Position.X:=DragControl.Position.X+X;
    DragControl.Position.Y:=DragControl.Position.Y+Y;
  end;
end;

procedure TForm1.Label1MouseUp(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y:Single);
begin
  if Dragging then begin
    Dragging:=False;
    DragControl.Root.Captured:=nil;
  end;
end;