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;//ifend;//检查移动控件位置是否重叠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;//forend;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;//ifend;//鼠标按下事件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;//ifend;//鼠标移动事件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;//ifend;//鼠标放开事件procedure TMoveClass.OnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin  if GLock = False then  begin    GIsMove := False;    CheckPos(TControl(Sender));  end;//ifend;

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

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

声明move : TMoveClass;

实例move := TMoveClass.Create;

将Panel放入move.SetMoveEventToControl(Panel1);

调用锁定move.Lock;

调用解锁move.UnLock;

效果图

解锁，拖拽