本文整理自网络,侵删。
本例效果图:
代码文件:
--------------------------------------------------------------------------------
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 debug模式下可以但是release模式下报错原因之一
Delphi sysutils.trim、sysutils.trimleft、sysutils.trimright - 删除空格
Delphi xe5 android 开发实现手机打电话和发短信
更多相关阅读请进入《Delphi》频道 >>