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

Question

Hy伙计们,

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

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

我做了很多尝试,但现在还没有成功.

任何帮助

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的组件.您可以查看源代码并进行研究.这是一种在运行时选择,调整大小和移动组件的简单方法.

下载演示并评估,如果它对您有效(包括组件的来源,演示源和编译的演示).

问候.

Answer 3

如果我认为您想要做的是在运行时移动控件，那么这里是一些您可以根据您的需要使用（并可能稍微修改）的代码：

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;

对此的扩展可能是对齐到网格。这段代码可能需要稍微修改一下。