写一个可拖动的 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 := 10;
    Top := 10;
  end;
end;

end.

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

posted @ 2016-11-03 22:13  findumars  Views(615)  Comments(0Edit  收藏  举报