德尔福 - 在设计模式下移动运行时控制

Question

Hy guys，

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

组件不移动，直到没有释放鼠标按钮，此时将显示一个空框架，并提示显示左上角位置。

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

任何帮助

Answer 1

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

Download the demo和评估，如果它是有效的，你（包括组件，演示来源和编制演示的来源）。

问候。

Answer 2

有一个名为TSizeCtrl在那里一个组件，它可以让你在运行时移动控件。您可以在Torry's找到源代码here或下载的组件。

它可以像这样使用：

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

这将让你拖MyControl周围，调整其大小。它在拖动时绘制一个框架并提供调整大小的手柄。

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; 

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

Answer 4

嗯，我会在这里发布。以下代码使用未记录的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;