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


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678