Componentes - criar borda de foco ao redor do selecionado

// Comentario do Junior - é bom e funciona. O problema é o foco em tela com

// RadioGroup e TabSheet, fica meio feio

Herbert J. Beemster's article Give Your Editbox Some Attention! derived an edit box that display an extra border when it has

focus. Great idea, but a real pain in the #!$e deriving a new control every time you wanted to add that functionality. 

That set me thinking about an idea i had ages ago - to trap delphi's Cn_FocusChanged message, and draw a border around any

control that has just received the focus. 

Attached is the control TucsFocus (delphi 3) - basically it waits for a control to send out a Cn_FocusChanged message, and

then resizes itself and positions inself *under* the focused control to produce a border effect. 

To place the TucsFocus under and control on a form, it is necessary to change it's parent - this caused a problem because when

the message handler is active, the parent is looping through it's controls list to notify all it's children, so changing the parent in the

message handler resulted in an index out of bounds exception.  To handle this i had to post a WM_USER message to the

control which would then be processed after all of the parent's children had been notified.  It is the WM_USER message

handler that does all the work. 

I've added two properties: Color (naturally) and BorderSize (the width of the border). 

I dare say it could be improved - for instance not using the WM_USER message - but i hope some of you find a use for it. 

Eamonn Mulvihill 

Consultancy and programing services 

     unit ucsFocus; 

     { 

     TucsFocus by Eamonn Mulvihill of Update Computer Services. 

     This control uses delphi's notification message cm_FocusChanged 

     to follow the focus around the form.  When a control receives 

     focus, it paints a bold border around it, basically by resixing 

     itself and placing itself behind the focused control. 

     This source is free for any use, but i would appreciate a mention 

     in any controls that are derived from it. 

     } 

     interface 

     uses 

       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 

     type 

       TucsFocus = class(TCustomControl) 

       private 

         fBorderSize : integer; 

       protected 

         procedure CMFocusChanged(var msg:TCMFocusChanged); message Cm_FocusChanged; 

         procedure MSGAfterFocus(var msg:TCMFocusChanged); message WM_USER; 

         procedure Paint; override; 

       public 

         constructor Create(AOwner:TComponent); override; 

       published 

         property Color; 

         property BorderSize:integer read fBorderSize write fBorderSize; 

       end; 

     procedure Register; 

     implementation 

     //set property defaults 

     constructor TucsFocus.Create(AOwner:TComponent); 

     begin; 

     inherited create(AOwner); 

     width  := 20; 

     height := 20; 

     color  := clBtnShadow; 

     BorderSize := 3; 

     end; 

     //paint the control 

     procedure TucsFocus.Paint; 

     begin; 

     inherited; 

     with canvas do 

       begin; 

       //draw filled rectangle 

       brush.color := color; 

       FillRect(ClientRect); 

       //a little extra in design mode 

       if csDesigning in ComponentState then 

         begin; 

         pen.color := clBlack; 

         rectangle(0,0,width,height); 

         font.name := 'Arial'; 

         font.size := 11; 

         font.style := [fsBold]; 

         TextOut(6,1,'F'); 

         end; 

       end; 

     end; 

     //Delphi is currently looping throught the parent's controls list. 

     //Canging the parent here will cause an exception, so post a USER 

     //message, which will be processed after all controls have been 

     //processed. 

     procedure TucsFocus.CMFocusChanged(var msg:TCMFocusChanged); 

     var UserMsg:TMessage; 

     begin; 

     UserMsg := TMessage(msg); 

     UserMsg.msg := WM_USER; 

     PostMessage(handle,WM_USER,UserMsg.wParam,UserMsg.lParam); 

     end; 

     //OK, now we can move the TucsFocus, size it and change the parent too! 

     procedure TucsFocus.MSGAfterFocus(var msg:TCMFocusChanged); 

     var rect :TRect; 

     begin; 

     try 

       //calculate size and position 

       rect := msg.Sender.BoundsRect; 

       rect.left   := rect.left   - BorderSize; 

       rect.top    := rect.top    - BorderSize; 

       rect.right  := rect.right  + BorderSize; 

       rect.bottom := rect.bottom + BorderSize; 

       BoundsRect := rect; 

       //and change parents 

       parent := msg.Sender.parent; 

       SendToBack; 

       finally 

         inherited; 

       end; 

     end; 

     procedure Register; 

     begin 

       RegisterComponents('U.C.S', [TucsFocus]); 

     end; 

     end.