CONTROLS attribute and small exercise in inheriting Tshape class (using Tshape can solve many graphics issues)

The renderings of this example:

Code file:

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 = ‘The current color value of %s is: %.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.