您的位置:首页 > 其它

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

2016-11-03 22:13 477 查看
问题来源: 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
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐