delphi Controls 属性与继承 TShape 类的小练习


本文整理自网络,侵删。

 

本例效果图:


代码文件:
--------------------------------------------------------------------------------

unit Unit1;

interface

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

type
TMyShape = class(TShape)
protected
procedure CMMouseenter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
end;

TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
W = 50;
H = 50;
var
shape: TMyShape;
begin
shape := TMyShape.Create(Self);
shape.Parent := Panel1;
shape.Width := W;
shape.Height := H;
Randomize;
shape.Left := Random(Panel1.ClientWidth - W);
shape.Top := Random(Panel1.ClientHeight - H);
shape.Brush.Color := Random($FFFFFF);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i: Integer;
begin
if Panel1.ControlCount = 0 then Exit;
Randomize;
i := Random(Panel1.ControlCount - 1);
Panel1.Controls[i].Free;
end;


{ TMyShape }

procedure TMyShape.CMMouseenter(var Message: TMessage);
const
s = '当前 %s 的颜色值是: %.6x';
var
WCtrl: TWinControl;
begin
WCtrl := Parent;
while WCtrl.HasParent do WCtrl := WCtrl.Parent;
if WCtrl is TForm then TForm(WCtrl).Caption := Format(s, [ClassName,Brush.Color]);
inherited;
end;

procedure TMyShape.CMMouseleave(var Message: TMessage);
const
s = 'Form1';
var
WCtrl: TWinControl;
begin
WCtrl := Parent;
while WCtrl.HasParent do WCtrl := WCtrl.Parent;
if WCtrl is TForm then TForm(WCtrl).Caption := s;
inherited;
end;

end.
--------------------------------------------------------------------------------
窗体文件:
--------------------------------------------------------------------------------

object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 212
ClientWidth = 395
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 8
Top = 8
Width = 297
Height = 193
Caption = 'Panel1'
TabOrder = 0
end
object Button1: TButton
Left = 311
Top = 40
Width = 75
Height = 25
Caption = #28155#21152
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 311
Top = 85
Width = 75
Height = 25
Caption = #38543#26426#21024#38500
TabOrder = 2
OnClick = Button2Click
end
end

相关阅读 >>

Delphi tstringlist stringlist的特殊用法

Delphi 上传文件到七牛,纯原生

Delphi sendmessage这个函数有很多奇妙的用途

Delphi firdac 对 sqlite 数字, int64也会被截断,会出现负数情况处理

Delphi程序版本信息设置说明

Delphi取得桌面工作区域的大小

Delphi动态创建一个鼠标指针图案

Delphi 自带大小写转换

如何在 Delphi 中静态链接 sqlite

Delphi实现全局鼠标钩子

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...