Mega Code Archive
A slightly improved TGroupBox component
<![CDATA[
Title: A slightly improved TGroupBox component
Question: It has always frustrated me that when a TGroupBox is disabled its caption is still displayed normally - you cant tell by looking at it whether its disabled or not. The TLabel & TCheckBox components display their captions with that familiar etched look when they are disabled why cant the TGroupBox do the same? Well it can, with a little bit of subclassing and a new paint procedure.
Answer:
First of all we declare a SubClass of TCustomGroupBox which well call TExGroupBox, and add two procedures:
type
TExGroupBox = class(TCustomGroupBox)
private
procedure WMEnable(var Msg: TMessage); Message WM_Enable;
protected
procedure Paint; override;
We need to trap the Windows WM_Enable message to let our new component know if the enabled property has changed, and if it has, to then invalidate the control.
procedure TExGroupBox.WMEnable(var Msg: TMessage);
begin
Invalidate;
Inherited;
end;
We also override the Paint method of the Base Class so that our new Paint procedure is called when the control is invalidated. We put a bit of extra code into the new Paint procedure that draws the caption in the same style as a TLabel:
if not Enabled then //we should draw 3D sunken caption
begin
OffsetRect(R, 1, 1); //move right & down a bit
Font.Color := clBtnHighlight;
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
OffsetRect(R, -1, -1); //move left & up a bit
Font.Color := clBtnShadow;
Brush.Style := bsClear; //dont cover up the previous pass
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end
else //default drawing of caption
begin
Brush.Style := bsSolid; //cover up the disabled caption
OffSetRect(R,1,1);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end;
Finally we add a Register procedure so that our new component will appear on the component Palette:
procedure Register;
begin
RegisterComponents('NewComponents', [TExGroupBox]);
end;
Save the component as ExGroupBox.pas and then install it into Delphi.
There are a couple of further enhancements I am going to make to TExGroupBox at a later date, such as an Alignment property for the caption, and a method to broadcast the enabled property to all controls contained within the ExGroupBox. Ill let you know how I go.
Here's the full Source Code for TExGroupBox:
unit ExGroupBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls;
type
TExGroupBox = class(TCustomGroupBox)
private
procedure WMEnable(var Msg: TMessage); Message WM_Enable;
protected
procedure Paint; override;
public
{ Public declarations }
published
property Align;
property Anchors;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property Ctl3D;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDockDrop;
property OnDockOver;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TExGroupBox]);
end;
procedure TExGroupBox.WMEnable(var Msg: TMessage);
begin
Invalidate;
Inherited;
end;
procedure TExGroupBox.Paint;
var
H: Integer;
R: TRect;
Flags: Longint;
begin
with Canvas do
begin
Font := Self.Font;
H := TextHeight('0');
R := Rect(0, H div 2 - 1, Width, Height);
if Ctl3D then
begin
Inc(R.Left);
Inc(R.Top);
Brush.Color := clBtnHighlight;
FrameRect(R);
OffsetRect(R, -1, -1);
Brush.Color := clBtnShadow;
end else
Brush.Color := clWindowFrame;
FrameRect(R);
if Text '' then
begin
if not UseRightToLeftAlignment then
R := Rect(8, 0, 0, H)
else
R := Rect(R.Right - Canvas.TextWidth(Text) - 8, 0, 0, H);
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE);
DrawText(Handle, PChar(Text), Length(Text), R, Flags or DT_CALCRECT);
Brush.Color := Color;
if not Enabled then
begin
OffsetRect(R, 1, 1);
Font.Color := clBtnHighlight;
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
OffsetRect(R, -1, -1);
Font.Color := clBtnShadow;
Brush.Style := bsClear;
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end
else
begin
Brush.Style := bsSolid;
OffSetRect(R,1,1);
DrawText(Handle, PChar(Text), Length(Text), R, Flags);
end;
end;
end;
end;
end.
]]>