我有一个名为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 :(得分: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.