The Unofficial Newsletter of Delphi Users - by Robert Vivrette

Highlighting Edit Boxes

by Eamonn Mulvihill - ucs@cableinet.co.uk

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.