Question

怎样在delphi中实现控件的拖拽？

Answer 1

(*放一个 LABEL 到窗体上 ， 建立 mousedown mousemove mouseup 三个事件

代码如下*)

{$R *.dfm}
var
isMouseDown : boolean ; //是否拖拽
posX,posY : Integer; //拖动开始时候的坐标

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
isMouseDown := True; //告诉窗体我要拖了
posX := Mouse.CursorPos.X - Label1.Left ; //记录开始的位置
posY := Mouse.CursorPos.Y - Label1.Top ; //
end;

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if isMouseDown then //鼠标是按下状态（要拖）
begin
Label1.Left := Mouse.CursorPos.X - posX ; //新的位置
Label1.Top := Mouse.CursorPos.Y - posY ;
end;
end;

procedure TForm1.Label1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
isMouseDown := False; //告诉窗体我拖完了
end;

(*窗体代码 ALT+F12导入*)
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 282
ClientWidth = 418
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 56
Top = 40
Width = 31
Height = 13
Caption = 'Label1'
OnMouseDown = Label1MouseDown
OnMouseMove = Label1MouseMove
OnMouseUp = Label1MouseUp
end
end