文档章节

写一个可拖动的 TShape - 回复 "韦韦" 的问题

涂孟超
 涂孟超
发布于 2014/09/26 15:32
字数 210
阅读 5
收藏 0

问题来源: 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

涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
私信 提问
战斗游戏--Battle for Wesnoth

韦诺之战是一款主要基于 C++ 的回合制SLG游戏, 使用SDL作为图形引擎, 目前已经移植到了Windows、Linux、FreeBSD和Mac OS X等多种操作系统上, 有16种不同部族, 可以进行单机战役、多人游戏. 与...

匿名
2009/03/19
21.1K
0
马云:与雅虎达成支付宝协议很复杂 但很乐观

马云和卡拉·斯韦什尔(右为马云) 北京时间6月2日上午消息,阿里巴巴CEO马云今天在D9大会与《华尔街日报》专栏作家卡拉·斯韦什尔(Kara Swisher)进行了对话,双方谈论的焦点在于支付宝的股权转...

红薯
2011/06/02
782
7
90后英国中学生建立黑客社交网 涉案金额达1.8亿元

著名社交网站Facebook在全球受到广范的欢迎,它的成功模式也启发了不少人。比如,日前,在英国就有一名90后中学生建立了类似于Facebook的黑客社交网,供全球黑客交流和切磋“技艺”,盗用他人...

疯语者
2011/04/04
1K
9
你会允许雇主在你体内植入跟踪装置吗?

如果你在这件事上有选择的话,你会允许你的雇主在你体内植入芯片吗?也就是说,植入一个追踪装置,这样你的公司就可以密切监视你了。 如果你拒绝的话,毫无疑问,你和大多数人一样。但实际上...

uw63zqpkxwlrl1
2018/05/02
0
0
从无边界组织到无边界信息流

  【IT168 评论】现在越来越多的企业家意识到信息在企业管理中所起到的重要作用。如何有效消除企业管理的信息不对称,许多伟大的企业家和管理组织都进行了积极的管理与实践的探索。杰克·韦...

覃里
2009/12/08
0
0

没有更多内容

加载失败,请刷新页面

加载更多

Linus 本尊来了!为什么 KubeCon 越来越火?

阿里妹导读: 从200人的小会议到3500 多位云原生和开源领域工程师齐聚一堂的大会,KubeCon 只用了四年,昨天,在KubeCon China 2019 上阿里巴巴宣布开源 OpenKruise,今天,Linus 本尊竟然现...

阿里云云栖社区
17分钟前
0
0
五小时构建云原生电商平台 | KubeCon SOFAStack Workshop 详解

本文根据 KubeCon China 2019 同场活动 SOFAStack Cloud Native Workshop 内容整理, 文末包含文档、PPT 地址,欢迎试用和提出建议。 2019 年 6 月 25 日,在 KubeCon China 2019,全球知名开...

SOFAStack
18分钟前
0
0
跨平台开发框架DevExtreme v19.1.4正式发布|附下载

DevExtreme Complete Subscription是性能最优的 HTML5,CSS 和 JavaScript 移动、Web开发框架,可以直接在Visual Studio集成开发环境,构建iOS,Android,Tizen和Windows Phone 8应用程序。D...

FILA6666
19分钟前
0
0
数据库链接断开 Cause: com.mysql.jdbc.exceptions.jdbc4.CommunicationsException: Communications link failure

报错信息如下: Cause: com.mysql.jdbc.exceptions.jdbc4.CommunicationsException: Communications link failureThe last packet successfully received from the server was 97,130 mill......

为了美好的明天
25分钟前
1
0
Flutter for Web 详细预研

背景 Google在最新的Google I/O上推出了Flutter for Web,旨在进一步解决一次代码,多端运行的问题。Flutter for Web还处于早期试验版,官方不建议在生产环境上使用。那么到底它的实际情况怎...

阿里云官方博客
28分钟前
0
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部