德爾福 - 在設計模式下移動運行時控制

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;