用戶在運行時移動形狀

Question

我有一個稱爲MachineShapes的單元，其上有一個TShape類型。我試圖獲得它，所以當用戶點擊形狀時，他們可以移動它。我想iam接近但有點困惑。感謝您的幫助

MachineShapes

unit MachineShape; 


interface 

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 
    Vcl.Controls, extctrls,myDataModule,Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; 

type 

TMachine = class(TShape) 
    private 
    { Private declarations } 
    FOnMouseDown : TNotifyEvent; 
    FOnMouseUp: TNotifyEvent; 
    FonMouseMove: TNotifyEvent; 
    procedure ControlMouseDown(Sender: TObject; 
          Button: TMouseButton; 
          Shift: TShiftState; 
          X, Y: Integer); 
    procedure ControlMouseMove(Sender: TObject; 
          Shift: TShiftState; 
          X, Y: Integer); 
    procedure ControlMouseUp(Sender: TObject; 
          Button: TMouseButton; 
          Shift: TShiftState; 
          X, Y: Integer); 

    private 
    inReposition : boolean; 
    oldPos : TPoint; 
    Protected 
     procedure DoMouseDown; virtual; 
     procedure DoMouseUp; Virtual; 
     procedure DoMouseMove; virtual; 
    Published 
     property OnMouseDown: TNotifyEvent Read FOnMouseDown Write fOnMouseDown; 
     property OnMouseMove: TNotifyEvent Read FOnMouseMove write fOnMouseMove; 
     Property onMouseUp : TNotifyEvent Read FOnMouseUp write FOnMouseUp; 
    public 
    { Public declarations } 

    end; 
implementation 

uses 
    deptlayout; 


    procedure TMachine.ControlMouseMove(Sender: TObject; Shift: TShiftState; X: Integer; Y: Integer); 
    const 
     minWidth = 20; 
     minHeight = 20; 
    var 
     newPos: TPoint; 
     frmPoint : TPoint; 
    begin 
     if inReposition then 
     begin 
     with TWinControl(Sender) do 
     begin 
      GetCursorPos(newPos); 
      Screen.Cursor := crSize; 
      Left := Left - oldPos.X + newPos.X; 
      Top := Top - oldPos.Y + newPos.Y; 
      oldPos := newPos; 
     end; 
     end; 
    end; 

    procedure TMachine.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); 
    begin 
     if inReposition then 
     begin 
      Screen.Cursor := crDefault; 
      ReleaseCapture; 
      inReposition := False; 
     end; 

    end; 


    procedure TMachine.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); 
    begin 
     inReposition:=True; 
     SetCapture(TWinControl(Sender).Handle); 
     GetCursorPos(oldPos); 
    end; 


    procedure tmachine.DoMouseDown; 
    begin 
     if assigned(fonmousedown) then 
      fonmousedown(self); 
    end; 

    procedure tmachine.DoMouseUp; 
    begin 
     if assigned(fonmouseup) then 
      fonmouseup(self); 
    end; 

    procedure tmachine.domousemove; 
    begin 
     if assigned(fonmousemove) then 
      fonmousemove(self); 
    end; 

end. 

我該如何稱呼它..

procedure TFGetZoneDept.CreateShape(Sender: TObject); 
var 
    machine : TMachine; 
begin 

    //creates the shape 
     machine := MachineShape.TMachine.Create(fdeptlayout); //form to create shape on 
     machine.Parent := fdeptlayout; //form to add shape to 
     machine.OnMouseDown := machinemouseDown; 
     machine.OnMouseUp := machinemouseUp; 
     machine.OnMouseMove:= machinemouseMove; 
end; 


procedure TFGetZoneDept.MachineMouseDown(Sender: TObject); 
var 
    machine: TMachine; 
begin 
    machine := Sender as TMachine; 
end; 

procedure TFGetZoneDept.MachineMouseUp(Sender: TObject); 
var 
    machine: TMachine; 
begin 
    machine := Sender as TMachine; 
end; 

procedure TFGetZoneDept.machineMouseMove(Sender: TObject); 
var 
    machine: TMachine; 
begin 
    machine := sender as Tmachine; 
end; 

Answer 1

形狀沒有WINCONTROL，沒有手柄，你可以做一些題刻的是....

unit Unit1; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, ExtCtrls; 

type 

    TMachine=Class(TShape) 
    private 
    FX,FY:Integer; 
    Procedure MyMouseDown(var msg:TWMLButtonDown);message WM_LButtonDown; 
    Procedure MyMouseMove(var msg:TWMMouseMove);message WM_MouseMove; 
    End; 

    TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    private 
    { Private-Deklarationen } 
    public 
    { Public-Deklarationen } 
    FX,FY:Integer; 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 
{ TMachine } 

procedure TMachine.MyMouseDown(var msg: TWMLButtonDown); 
begin 
    inherited; 
    FX := msg.XPos; 
    FY := msg.YPos; 
end; 

procedure TMachine.MyMouseMove(var msg: TWMMouseMove); 
begin 
    inherited; 
    if ssLeft in KeysToShiftState(msg.Keys) then 
    begin 
     Left := Left+ msg.XPos -FX; 
     Top := Top + msg.YPos -FY; 
    end; 

end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    With TMachine.Create(self) do 
    begin 
     Parent := Self; 
     Width := 200; 
     Height := 200; 
    end; 
end; 

end.