1

我有一个名为 MachineShapes 的单元，上面有一个 TShape 类型。我正在尝试获取它，因此当用户单击形状时，他们可以移动它。我认为我很接近，但有点困惑。谢谢你的帮助

机器形状

    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;
4

1 回答 1

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.
于 2013-02-15T09:25:16.720 回答