在Delphi中如何在运行时像设计模式一样移动控件

5

大家好,

我想在运行时用鼠标移动自己的组件,就像在设计模式下一样。

直到鼠标按钮释放并且此期间显示一个空框架和提示来显示左上角的位置,才会移动该组件。

我已经尝试了很多次,但迄今为止没有成功。

需要帮助。

4个回答

10
好的,我会在这里发布。下面的代码使用未记录的WM_SYSCOMMAND常量$F012并与TWinControl后代一起使用。
注意,这是未记录的,可能在未来的Windows版本中无法使用(如果他们决定这样做),但它可以工作(在多个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;

4
请注意,此方法仅适用于 TWinControl 派生类! - iamjoosy
3
你神奇的 SC_DRAGSIZE 实际上是 SC_SIZE + WMSZ_BOTTOMRIGHT。例如,要从左上方进行调整大小,可以使用 SC_SIZE + WMSZ_TOPLEFT - Sertac Akyuz
@Sertac - 比我想象的更神奇 :) 但我仍然不明白为什么微软不对其进行文档化。在我看来,这将使它在未来的Windows版本中保持活力,因为他们肯定会在某些产品中使用它。 - user532231
1
这是用于移动和调整顶级窗口大小的相同消息。在Windows内部,这些东西都只是同一件事情(一个窗口),因此WM_SYSCOMMAND支持SC_DRAGMOVE与顶级窗口类(TForm实际上就是这样)以及任何其他具有win32窗口句柄的Delphi控件并不奇怪。 - Warren P

9
在我的网站上(http://neftali.clubdelphi.com/?p=269),您可以找到一个名为TSelectOnRuntime的组件。您可以查看源代码并进行学习。这是一种简单的方法,在运行时选择、调整大小和移动组件。

enter image description here

下载演示并进行评估,如果对您有效(包括组件源代码、演示源代码和编译的演示)。


这些组件是免费的,源代码也可用(我是作者)。 这是在Github上更新的链接:https://github.com/NeftaliDelphi/GLib 这是许可证文件的链接:https://github.com/NeftaliDelphi/GLib/blob/main/leeme_en.txt - Germán Estévez -Neftalí-
注意:该控件适用于Delphi 6,但也可在Delphi 11.2上使用。语言为西班牙语。存在警告(未初始化变量)。除此之外,它的表现还不错。我给它加1分。 - Gabriel

6

如果你想在运行时移动控件,那么下面的代码可能会对你有帮助(你可能需要稍微修改一下):

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;

扩展此功能可能需要将其对齐到网格。这段代码可能需要稍作修改。


1
ReleaseCapture; 在我的测试中表现最佳。但是我会失去鼠标消息。例如,将无法收到鼠标弹起消息。 - gogoloi

4

有一个名为TSizeCtrl的组件,可以在运行时移动控件。你可以在这里找到源代码或者在Torry's下载该组件。

使用方法如下:

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

这将使你能够拖动MyControl并调整它的大小。在拖动时,它会绘制一个框架并提供调整大小的手柄。

1
两个链接都已损坏。 - Gabriel
这是一个很好的链接,适用于需要它的人:https://github.com/BakasuraRCE/TSizeCtrl - Tom

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接