Delphi6 控件运行期移动类

由于工作的需要，还要帮助用户维护一套旧系统，系统中包括仓库货架的布局设置，为了用户可直观的在系统中设置货架位置，就想让运行期的控件可移动，于是写了以下类

IDE：Delphi6

控件移动类代码：

type
  TMoveClass = class(TObject)
  private
    GIsMove : Boolean;     //是否允许移动
    GPosX, GPosY : Integer;  //记录控件在屏幕上的位置
    GOldX, GoldY : Integer;  //控件在容器中的位置
    GParent : TWinControl;  //容器
    GLock : Boolean;       //是否锁定
    procedure MoveEventToControl(aControl : TControl);  //设置控件移动事件
    function CheckPos(aControl: TControl) : Boolean;     //检查移动控件位置是否重叠
  public
    constructor Create;
    procedure Lock; //锁定控件
    procedure UnLock; //解锁控件
    procedure SetMoveEventToControl(aParent : TWinControl); //将容器内所有控件设置移动
    procedure OnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //鼠标按下事件
    procedure OnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);                    //鼠标移动事件
    procedure OnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);   //鼠标放开事件
  end;

{ TMoveClass }
constructor TMoveClass.Create;
begin
  GLock := True; //默认为锁住
end;

//设置控件移动事件
procedure TMoveClass.MoveEventToControl(aControl: TControl);
begin
  if aControl is TButton then //这里可以修改为有相关事件的控件
  begin
    TButton(aControl).OnMouseDown := OnMouseDown;
    TButton(aControl).OnMouseMove := OnMouseMove;
    TButton(aControl).OnMouseUp := OnMouseUp;
  end;//if
end;

//检查移动控件位置是否重叠
function TMoveClass.CheckPos(aControl: TControl): Boolean;
var
  i : integer;
begin
  Result := True;

  for i := 0 to GParent.ControlCount - 1 do
  begin
    if aControl.Name <> GParent.Controls[i].Name then
      if(aControl.Left = GParent.Controls[i].Left) and (aControl.Top = GParent.Controls[i].Top) then
      begin 
         //如果控件名字不同但位置相同，就让控件回复到移动前的位置
         aControl.Left := GOldX;
         aControl.Top := GoldY;
         Break;
      end;//if
  end;//for
end;

procedure TMoveClass.Lock;
begin
  GLock := True;
  GIsMove := False;
end;

procedure TMoveClass.UnLock;
begin
  GLock := False;
end;

//将容器内所有控件设置移动
procedure TMoveClass.SetMoveEventToControl(aParent: TWinControl);
var
  i : Integer;
begin
  if not (aParent = nil) and (Assigned(aParent)) then
  begin
    GParent := aParent;

    for i := 0 to GParent.ControlCount - 1 do
      MoveEventToControl(GParent.Controls[i]);
  end;//if
end;

//鼠标按下事件
procedure TMoveClass.OnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if GLock = False then
  begin
    GIsMove := True;
    GposX := Mouse.CursorPos.X - TWinControl(Sender).Left;  //得到按钮在屏幕上的位置
    GposY := Mouse.CursorPos.Y - TWinControl(Sender).Top;
    TWinControl(Sender).BringToFront;

    GOldX := TControl(Sender).Left;
    GoldY := TControl(Sender).Top;
  end;//if
end;

//鼠标移动事件
procedure TMoveClass.OnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if GIsMove then
  begin
    if (Mouse.CursorPos.X > (GposX + TControl(Sender).Left + TControl(Sender).Width))then
      TControl(Sender).Left := TControl(Sender).Left + TControl(Sender).Width
    else if (Mouse.CursorPos.X < (GposX + TControl(Sender).Left -  TControl(Sender).Width)) then
      TControl(Sender).Left := TControl(Sender).Left - TControl(Sender).Width
    else if (Mouse.CursorPos.y > (GposY + TControl(Sender).Top + TControl(Sender).Height)) then
       TControl(Sender).Top := TControl(Sender).Top + TControl(Sender).Height
    else if (Mouse.CursorPos.y < (GposY + TControl(Sender).Top -  TControl(Sender).Height)) then
       TControl(Sender).Top := TControl(Sender).Top - TControl(Sender).Height;
  end;//if
end;

//鼠标放开事件
procedure TMoveClass.OnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if GLock = False then
  begin
    GIsMove := False;
    CheckPos(TControl(Sender));
  end;//if
end;

移动类完成后，可以在一个窗体中放上一个Panel，再放N个Button在Panel中并靠整齐。

再加入以下代码，运行即可

声明move : TMoveClass;

实例move := TMoveClass.Create;

将Panel放入move.SetMoveEventToControl(Panel1);

调用锁定move.Lock;

调用解锁move.UnLock;

效果图

解锁，拖拽