2013-02-15 3 views
1

У меня есть устройство под названием MachineShapes с типом TShape. Я пытаюсь получить это, когда пользователь нажимает на фигуру, которую он может переместить. Я думаю, что я близко, но немного запутался. Спасибо за любую помощьПользовательская форма перемещения во время выполнения

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; 
+0

Также подумайте об этом вручную, без средств управления: http://stackoverflow.com/a/7224075/282848 –

ответ

2

Фигура нет 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. 
+0

Так что я должен был art over .. lol –

+0

Я нашел http://stackoverflow.com/questions/2382981/how-to-move-circle-with-mouse-in-delphi, но не уверен, как добавить его в машинные формы, поэтому каждый раз будет создана форма, она будет иметь это свойство –

+0

Отлично работает! идеально! –

Смежные вопросы