写一个可拖动的 TShape（简单有效：依靠VCL体系，TShape自己就能被探测到被点击了，然后只要改变Left坐标就行了）

问题来源: http://www.cnblogs.com/del/archive/2009/03/09/1234066.html#1471535

本例效果图:

自定义类(TMyShape)单元 :

unit Unit2;

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 := ;

    Top := ;

  end;

end;

end.

http://www.cnblogs.com/del/archive/2009/03/09/1406811.html

巴特西

写一个可拖动的 TShape（简单有效：依靠VCL体系，TShape自己就能被探测到被点击了，然后只要改变Left坐标就行了）

最新文章

热门文章