本例效果图:
代码文件:
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.
http://www.cnblogs.com/del/archive/2008/10/23/1317926.html
时间: 2024-10-20 04:53:30