Delphi -在运行时移动控件,类似于设计模式

agxfikkp  于 2023-01-02  发布在  其他
关注(0)|答案(4)|浏览(180)

嘿伙计们,
我试着在运行模式下用鼠标移动我自己的组件,就像在设计模式下一样。
该组件不会移动,直到鼠标按钮没有释放,在这段时间内,显示一个空帧和一个提示显示左上角位置。
我做了很多尝试,但到现在还没有成功。
有什么帮助吗

p4rjhz4m

p4rjhz4m1#

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

Download the demo并评估它是否对您有效(包括组件源代码、演示源代码和编译的演示)。

hs1rzwqc

hs1rzwqc2#

下面的代码使用了没有文档记录的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;
7y4bm7vi

7y4bm7vi3#

如果我认为你要做的是在运行时移动控件,那么这里有一些代码你可以根据需要使用(也可以稍微修改一下):

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;

这个的扩展可能会与网格对齐。这段代码可能需要稍微修改。

7qhs6swi

7qhs6swi4#

有一个名为TSizeCtrl的组件可以让你在运行时移动控件,你可以在here找到源代码或者在Torry's下载该组件。
它可以像这样使用:

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

这将允许你拖动MyControl并调整大小。它在拖动时绘制一个框架并提供调整大小的手柄。

相关问题