Delphi - 在运行时移动控制在设计模式上

Question

Hy guys，

我尝试在设计模式下使用类似鼠标在运行时模式下移动我自己的组件。

组件未移动，直到鼠标按钮未释放为止，此时显示空框架，并显示提示左侧角落。

我做了很多尝试，但现在还没有成功。

任何帮助

Answer 1

好吧，我会在这里发布。以下代码使用未记录的WM_SYSCOMMAND常量$F012，并与TWinControl后代一起使用。

请注意，它没有文档，可能无法在Windows的未来版本上运行（如果他们决定使用Windows API中的任何其他内容），但它可以正常运行（在多个Windows版本上测试），这是最简单的方法组件在运行时。

procedure TForm.YourComponentMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  ReleaseCapture;
  YourComponent.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;

类似的魔法也适用于大小调整，即命令$F008。

procedure TForm.YourComponentMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGSIZE = $F008;
begin
  ReleaseCapture;
  YourComponent.Perform(WM_SYSCOMMAND, SC_DRAGSIZE, 0);
end;

Answer 2

在我的网站（http://neftali.clubdelphi.com/?p=269），您可以找到名为 TSelectOnRuntime 的组件。您可以查看源代码并进行研究。这是一种在运行时选择，调整大小和移动组件的简单方法。

Download the demo并评估，如果它对您有效（包括组件来源，演示源和已编译的演示）。

问候。

Answer 3

有一个名为TSizeCtrl的组件允许您在运行时移动控件。您可以在here找到源代码Torry's或要下载的组件。

可以像这样使用：

SizeCtrl1 := TSizeCtrl.Create(MyForm);
SizeCtrl1.GridSize := 20;
SizeCtrl1.Enabled := True;
SizeCtrl1.RegisterControl(MyControl);
SizeCtrl1.AddTarget(MyControl);

这样您就可以拖动MyControl并调整其大小。它在拖动时绘制一个框架，并提供调整大小的句柄。

Answer 4

如果我认为你想要做的是在运行时移动控件，那么这里有一些你可能会使用的代码（可能稍微修改一下）来满足你的需求：

var
MouseDownPos, LastPosition : TPoint;
DragEnabled,Resizing : Boolean;


procedure TForm1.ControlMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
     MouseDownPos.X := X;
     MouseDownPos.Y := Y;
     DragEnabled := True;
end;

//handle dragging of controls
procedure TForm1.ControlMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
     if DragEnabled then
     begin
          if Sender is TControl then
          begin
                TControl(Sender).Left := TControl(Sender).Left + (X - MouseDownPos.X);
                TControl(Sender).Top := TControl(Sender).Top + (Y - MouseDownPos.Y);
          end;
     end;
end;

要调整控件大小，您可以使用以下内容：

procedure TForm1.ControlMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var cntrl : TControl;
begin
    cntrl := Sender as TControl;
if ((cntrl.Width - X) < 15) and ((cntrl.Height - Y) < 15) then
       cntrl.Cursor := crSizeNWSE
    else cntrl.Cursor := crDefault;
    if Resizing then
    begin
        cntrl.Width := cntrl.Width + (X - LastPosition.X);
        LastPosition.X := X;
        cntrl.Height := cntrl.Height + (Y - LastPosition.Y);
        LastPosition.Y := Y;
    end;
end;

procedure TForm1.ControlMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var cntrl : TControl;
begin
    if ((cntrl.Width - X) < 15) and ((cntrl.Height - Y) < 15) then
    begin
        LastPosition.X := X;
        LastPosition.Y := Y;
        Resizing := True;
    end;
end;

对此的扩展可能会捕捉到网格。此代码可能需要稍微修改。