通过实现控件的
OnMouseDown
、
OnMouseMove
和
OnMouseUp
事件,您可以允许用户像这样移动它:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
FTableButton : TButton;
FTableButtonDragging : boolean;
FMouseDownLocation : TPoint;
FButtonStartingLocation : TPoint;
procedure TableButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TableButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure TableButtonMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(FTableButton) then begin
FTableButton := TButton.Create(self);
FTableButton.Parent := self;
FTableButton.Caption := 'I am New';
FTableButton.OnMouseDown := TableButtonMouseDown;
FTableButton.OnMouseMove := TableButtonMouseMove;
FTableButton.OnMouseUp := TableButtonMouseUp;
end;
end;
procedure TForm1.TableButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FTableButtonDragging := true;
FMouseDownLocation := Mouse.CursorPos;
FButtonStartingLocation := TPoint.Create(FTableButton.Left, FTableButton.Top);
end;
procedure TForm1.TableButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FTableButtonDragging then begin
FTableButton.Left := FButtonStartingLocation.X + (Mouse.CursorPos.X - FMouseDownLocation.X);
FTableButton.Top := FButtonStartingLocation.Y + (Mouse.CursorPos.Y - FMouseDownLocation.Y);
FTableButton.Invalidate;
end;
end;
procedure TForm1.TableButtonMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FTableButtonDragging := false;
end;
end.
这里我们向表单中添加了三个新程序:
procedure TableButtonMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TableButtonMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure TableButtonMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
我们已将这些过程指定为新的
FTableButton
事件的处理程序:
FTableButton.OnMouseDown := TableButtonMouseDown;
FTableButton.OnMouseMove := TableButtonMouseMove;
FTableButton.OnMouseUp := TableButtonMouseUp;
单击按钮时,您需要存储控件的位置和鼠标放置单击时的鼠标位置,以及鼠标当前是否按下。为此,使用三个新字段:
FTableButtonDragging : boolean;
FMouseDownLocation : TPoint;
FButtonStartingLocation : TPoint;
当移动鼠标时,您可以根据控件的原始位置和当前鼠标位置与单击时的鼠标位置之间的差异来更新控件的位置。