写一个可拖动的 TShape

interface

uses
  Classes, Controls, ExtCtrls;

type
  TMyShape = class(TShape)
  private
    fMouseFlag: Boolean;
    fx,fy: Integer;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
  end;

implementation

{ TMyShape }

procedure TMyShape.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  fx := X;
  fy := Y;
  fMouseFlag := True;
end;

procedure TMyShape.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if fMouseFlag then
  begin
    Left := Left + X - fx;
    Top := Top + Y - fy;
  end;
end;

procedure TMyShape.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  fMouseFlag := False;
end;

end.

   
   

调用测试:

---

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Unit2;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Randomize;
  with TMyShape.Create(Self) do begin
    Brush.Color := Random($FFFFFF);
    Parent := Self;
    Left := 10;
    Top := 10;
  end;
end;

end.