Mega Code Archive
How to create a simple checkbox with no caption
<![CDATA[
{
For a recent project, I wished to use a checkbox without a caption. Using the
standard TCheckBox control was not suitable as this places the focus round the
caption, so I created the TSimpleCheckBox class below. This may be used as-is
or as a basis for a something more sophisticated.
Follow the instructions in the Creating Custom Components help file to install
this. Specify the class TSimpleCheckBox as a descendent of TCustomControl and
choose the unit file name according to your standards. You can add this to an
existing custom package or create a new one. To change the palette page where
the component is added, change the Register procedure at the end of the code.
This code was written and tested with Delphi 7, but it is not specific to this
release, and so should work with other releases.
}
// Simple checkbox with no caption.
interface
uses Classes, Controls;
// Simple checkbox with no caption.
type TSimpleCheckBox = class (TCustomControl)
private
iChange : TNotifyEvent; // Value change event.
iChecked : boolean; // Checkbox state.
iEventM : boolean; // Set if mouse event in progress.
iEventK : boolean; // Set if keyboard event in progress.
procedure mhSetChecked (const pChecked : boolean);
function mhGetSizeHW () : integer;
protected
procedure Paint (); override;
procedure DoEnter (); override;
procedure DoExit (); override;
procedure KeyDown (var pKey : word;
pShift : TShiftState); override;
procedure KeyUp (var pKey : word;
pShift : TShiftState); override;
procedure MouseDown ( pButton : TMouseButton;
pShift : TShiftState;
pX : integer;
pY : integer); override;
procedure MouseUp ( pButton : TMouseButton;
pShift : TShiftState;
pX : integer;
pY : integer); override;
public
constructor Create (pOwner : TComponent); override;
published
property Checked : boolean
read iChecked
write mhSetChecked;
property OnChange : TNotifyEvent
read iChange
write iChange;
// Publish inherited properties. The Height and Width properties are
// only intended to be read.
property Action;
property Anchors;
property Color;
property Cursor;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Height
read mhGetSizeHW;
property HelpContext;
property HelpKeyword;
property HelpType;
property Hint;
property Left;
property Name;
property ParentColor;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default true;
property Top;
property Visible;
property Width
read mhGetSizeHW;
property Tag;
// Publish inherited event properties.
property OnClick;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
// Component registration procedure.
procedure register;
implementation
uses ExtCtrls, Graphics, Types, Windows;
// Constants.
const
kSizeHW = 19; // Only supported size of the control.
// Rectangles for drawing routines.
kRectCtl : TRect = ( // Coordinates of the control.
Left : 0;
Top : 0;
Right : kSizeHW;
Bottom : kSizeHW);
kRectBG : TRect = ( // Coordinates of checkbox (background) area.
Left : 5;
Top : 5;
Right : kSizeHW - 5;
Bottom : kSizeHW - 5);
kRectFrI : TRect = ( // Coordinates of inner frame.
Left : 4;
Top : 4;
Right : kSizeHW - 4;
Bottom : kSizeHW - 4);
kRectFrO : TRect = ( // Coordinates of outer frame.
Left : 3;
Top : 3;
Right : kSizeHW - 3;
Bottom : kSizeHW - 3);
// Polylines for drawing routines.
kLines : array [0 .. 2] of array [0 .. 2] of TPoint = (
((X : 6; Y : 8), (X : 8; Y : 10), (X : 13; Y : 5)),
((X : 6; Y : 9), (X : 8; Y : 11), (X : 13; Y : 6)),
((X : 6; Y : 10), (X : 8; Y : 12), (X : 13; Y : 7)));
// Constructor.
constructor TSimpleCheckBox.Create (pOwner : TComponent);
begin
// Initialise the base control.
inherited Create (pOwner);
// Set up required properties.
Height := kSizeHW;
Width := kSizeHW;
TabStop := true
end;
// Write access method for Checked property.
procedure TSimpleCheckBox.mhSetChecked (const pChecked : boolean);
begin
// If the state is changing, then:
if (pChecked <> iChecked) then
begin
// - Set the new value.
iChecked := pChecked;
// - Call the change event, if required.
if Assigned (iChange) then
iChange (Self);
// - Force the control to be repainted.
Invalidate ()
end
end;
// Read access method for Height and Width properties.
function TSimpleCheckBox.mhGetSizeHW () : integer;
begin
// Return the constant value.
Result := kSizeHW
end;
// Repaint the control.
procedure TSimpleCheckBox.Paint ();
var
wRect : TRect;
Ix : integer;
begin
with Canvas do
begin
// Fill the entire control with the background colour.
Brush.Color := Color;
FillRect (kRectCtl);
// Paint the inner rectangle using the default window colour (unless the
// user is currently clicking the mouse or pressing the space bar).
if not (iEventM or iEventK) then
begin
Brush.Color := clWindow;
FillRect (kRectBG)
end;
// If the checkbox should be checked, then draw the tick mark (this is
// drawn using lines, rather than a bitmap).
if iChecked then
begin
Pen.Color := clWindowText;
for Ix := Low (kLines) to High (kLines) do
Polyline (kLines [Ix]);
end;
// The three-dimensional frame is two pixels wide, and is drawn in two
// stages. First draw the inner square in the appropriate colours.
wRect := kRectFrI;
Frame3D (Canvas,
wRect,
clBtnShadow,
cl3DLight,
1);
// Secondly, draw the outer square with the other colours.
wRect := kRectFrO;
Frame3D (Canvas,
wRect,
cl3DDkShadow,
clBtnHighlight,
1);
// Finally, draw the focus indicator, if the control has focus.
if Focused () then
DrawFocusRect (kRectCtl)
end
end;
// Control enter event.
procedure TSimpleCheckBox.DoEnter ();
begin
// Force the control to be repainted (which will add the focus rectangle).
Invalidate ();
// Call the ancestor method and any event handler.
inherited DoEnter ()
end;
// Control exit event.
procedure TSimpleCheckBox.DoExit ();
begin
// Force the control to be repainted (to remove the focus rectangle).
Invalidate ();
// Call the ancestor method and any event handler.
inherited DoExit ()
end;
// Key down event.
procedure TSimpleCheckBox.KeyDown (var pKey : word;
pShift : TShiftState);
begin
// Respond to the space key (with any other button).
iEventK := pKey = VK_SPACE;
// If this is the key, then force the control to be repainted (which will
// be done in the background colour).
if iEventK then
Invalidate ();
// Call the ancestor method and any event handler.
inherited KeyDown (pKey,
pShift)
end;
// Key up event.
procedure TSimpleCheckBox.KeyUp (var pKey : word;
pShift : TShiftState);
begin
// If a space key was detected ...
if iEventK then
begin
// ... then toggle the state.
iChecked := not iChecked;
// Call the change event, if required.
if Assigned (iChange) then
iChange (Self);
// Reset the indicator ...
iEventK := false;
// ... and force the control to be repainted.
Invalidate ()
end;
// Call the ancestor method and any event handler.
inherited KeyUp (pKey,
pShift)
end;
// Mouse button down event.
procedure TSimpleCheckBox.MouseDown (pButton : TMouseButton;
pShift : TShiftState;
pX : integer;
pY : integer);
begin
// Only left mouse button events are processed.
if pButton = mbLeft then
begin
// Set focus to the control.
SetFocus ();
// Note whether the click is within the inner rectangle.
iEventM := PtInRect (kRectBg, Point (pX, pY));
// Force the control to be repainted.
Invalidate ()
end;
// Call the ancestor method and any event handler.
inherited MouseDown (pButton,
pShift,
pX,
pY)
end;
// Mouse button up event.
procedure TSimpleCheckBox.MouseUp (pButton : TMouseButton;
pShift : TShiftState;
pX : integer;
pY : integer);
begin
// If the left mouse button was clicked within the checkbox:
if iEventM then
begin
// - Reset the flag.
iEventM := false;
// - If the pointer is still (or again) within the checkbox then toggle
// the state ...
if (pButton = mbLeft) and PtInRect (kRectBg, Point (pX, pY)) then
begin
iChecked := not iChecked;
// ... and call the change event.
if Assigned (iChange) then
iChange (Self)
end;
// - Force the control to be repainted.
Invalidate ()
end;
// Call the ancestor method and any event handler.
inherited MouseUp (pButton,
pShift,
pX,
pY)
end;
// Component registration procedure.
procedure register;
begin
RegisterComponents ('AS',
[TSimpleCheckBox]);
end;
end.
{
The most noticeable difference between this class and the standard checkbox is
in the events. For this class, changes to the check status are notified using
the OnChange event, rather than OnClick.
Another difference is the absence of the AllowGrayed property. This should be
fairly easy to add, but there was no requirement in this particular project.
}
]]>