1 {
2 For a recent project, I wished to use a checkbox without a caption. Using the
3 standard TCheckBox control was not suitable as this places the focus round the
4 caption, so I created the TSimpleCheckBox class below. This may be used as-is
5 or as a basis for a something more sophisticated.
6
7 Follow the instructions in the Creating Custom Components help file to install
8 this. Specify the class TSimpleCheckBox as a descendent of TCustomControl and
9 choose the unit file name according to your standards. You can add this to an
10 existing custom package or create a new one. To change the palette page where
11 the component is added, change the Register procedure at the end of the code.
12
13 This code was written and tested with Delphi 7, but it is not specific to this
14 release, and so should work with other releases.
15 }
16
17 // Simple checkbox with no caption.
18
19 interface
20
21 uses Classes, Controls;
22
23 // Simple checkbox with no caption.
24 type TSimpleCheckBox = class (TCustomControl)
25 private
26 iChange : TNotifyEvent; // Value change event.
27 iChecked : boolean; // Checkbox state.
28 iEventM : boolean; // Set if mouse event in progress.
29 iEventK : boolean; // Set if keyboard event in progress.
30 procedure mhSetChecked (const pChecked : boolean);
31 function mhGetSizeHW () : integer;
32 protected
33 procedure Paint (); override;
34 procedure DoEnter (); override;
35 procedure DoExit (); override;
36 procedure KeyDown (var pKey : word;
37 pShift : TShiftState); override;
38 procedure KeyUp (var pKey : word;
39 pShift : TShiftState); override;
40 procedure MouseDown ( pButton : TMouseButton;
41 pShift : TShiftState;
42 pX : integer;
43 pY : integer); override;
44 procedure MouseUp ( pButton : TMouseButton;
45 pShift : TShiftState;
46 pX : integer;
47 pY : integer); override;
48 public
49 constructor Create (pOwner : TComponent); override;
50 published
51 property Checked : boolean
52 read iChecked
53 write mhSetChecked;
54 property OnChange : TNotifyEvent
55 read iChange
56 write iChange;
57 // Publish inherited properties. The Height and Width properties are
58 // only intended to be read.
59 property Action;
60 property Anchors;
61 property Color;
62 property Cursor;
63 property DragCursor;
64 property DragKind;
65 property DragMode;
66 property Enabled;
67 property Height
68 read mhGetSizeHW;
69 property HelpContext;
70 property HelpKeyword;
71 property HelpType;
72 property Hint;
73 property Left;
74 property Name;
75 property ParentColor;
76 property ParentShowHint;
77 property PopupMenu;
78 property ShowHint;
79 property TabOrder;
80 property TabStop default true;
81 property Top;
82 property Visible;
83 property Width
84 read mhGetSizeHW;
85 property Tag;
86 // Publish inherited event properties.
87 property OnClick;
88 property OnContextPopup;
89 property OnDragDrop;
90 property OnDragOver;
91 property OnEndDock;
92 property OnEndDrag;
93 property OnEnter;
94 property OnExit;
95 property OnKeyDown;
96 property OnKeyPress;
97 property OnKeyUp;
98 property OnMouseDown;
99 property OnMouseMove;
100 property OnMouseUp;
101 property OnStartDock;
102 property OnStartDrag;
103 end;
104
105 // Component registration procedure.
106 procedure register;
107
108 implementation
109
110 uses ExtCtrls, Graphics, Types, Windows;
111
112 // Constants.
113 const
114 kSizeHW = 19; // Only supported size of the control.
115
116 // Rectangles for drawing routines.
117 kRectCtl : TRect = ( // Coordinates of the control.
118 Left : 0;
119 Top : 0;
120 Right : kSizeHW;
121 Bottom : kSizeHW);
122
123 kRectBG : TRect = ( // Coordinates of checkbox (background) area.
124 Left : 5;
125 Top : 5;
126 Right : kSizeHW - 5;
127 Bottom : kSizeHW - 5);
128
129 kRectFrI : TRect = ( // Coordinates of inner frame.
130 Left : 4;
131 Top : 4;
132 Right : kSizeHW - 4;
133 Bottom : kSizeHW - 4);
134
135 kRectFrO : TRect = ( // Coordinates of outer frame.
136 Left : 3;
137 Top : 3;
138 Right : kSizeHW - 3;
139 Bottom : kSizeHW - 3);
140
141 // Polylines for drawing routines.
142 kLines : array [0 .. 2] of array [0 .. 2] of TPoint = (
143 ((X : 6; Y : 8), (X : 8; Y : 10), (X : 13; Y : 5)),
144 ((X : 6; Y : 9), (X : 8; Y : 11), (X : 13; Y : 6)),
145 ((X : 6; Y : 10), (X : 8; Y : 12), (X : 13; Y : 7)));
146
147 // Constructor.
148 constructor TSimpleCheckBox.Create (pOwner : TComponent);
149 begin
150 // Initialise the base control.
151 inherited Create (pOwner);
152 // Set up required properties.
153 Height := kSizeHW;
154 Width := kSizeHW;
155 TabStop := true
156 end;
157
158 // Write access method for Checked property.
159 procedure TSimpleCheckBox.mhSetChecked (const pChecked : boolean);
160 begin
161 // If the state is changing, then:
162 if (pChecked <> iChecked) then
163 begin
164 // - Set the new value.
165 iChecked := pChecked;
166 // - Call the change event, if required.
167 if Assigned (iChange) then
168 iChange (Self);
169 // - Force the control to be repainted.
170 Invalidate ()
171 end
172 end;
173
174 // Read access method for Height and Width properties.
175 function TSimpleCheckBox.mhGetSizeHW () : integer;
176 begin
177 // Return the constant value.
178 Result := kSizeHW
179 end;
180
181 // Repaint the control.
182 procedure TSimpleCheckBox.Paint ();
183 var
184 wRect : TRect;
185 Ix : integer;
186 begin
187 with Canvas do
188 begin
189 // Fill the entire control with the background colour.
190 Brush.Color := Color;
191 FillRect (kRectCtl);
192 // Paint the inner rectangle using the default window colour (unless the
193 // user is currently clicking the mouse or pressing the space bar).
194 if not (iEventM or iEventK) then
195 begin
196 Brush.Color := clWindow;
197 FillRect (kRectBG)
198 end;
199 // If the checkbox should be checked, then draw the tick mark (this is
200 // drawn using lines, rather than a bitmap).
201 if iChecked then
202 begin
203 Pen.Color := clWindowText;
204 for Ix := Low (kLines) to High (kLines) do
205 Polyline (kLines [Ix]);
206 end;
207 // The three-dimensional frame is two pixels wide, and is drawn in two
208 // stages. First draw the inner square in the appropriate colours.
209 wRect := kRectFrI;
210 Frame3D (Canvas,
211 wRect,
212 clBtnShadow,
213 cl3DLight,
214 1);
215 // Secondly, draw the outer square with the other colours.
216 wRect := kRectFrO;
217 Frame3D (Canvas,
218 wRect,
219 cl3DDkShadow,
220 clBtnHighlight,
221 1);
222 // Finally, draw the focus indicator, if the control has focus.
223 if Focused () then
224 DrawFocusRect (kRectCtl)
225 end
226 end;
227
228 // Control enter event.
229 procedure TSimpleCheckBox.DoEnter ();
230 begin
231 // Force the control to be repainted (which will add the focus rectangle).
232 Invalidate ();
233 // Call the ancestor method and any event handler.
234 inherited DoEnter ()
235 end;
236
237 // Control exit event.
238 procedure TSimpleCheckBox.DoExit ();
239 begin
240 // Force the control to be repainted (to remove the focus rectangle).
241 Invalidate ();
242 // Call the ancestor method and any event handler.
243 inherited DoExit ()
244 end;
245
246 // Key down event.
247 procedure TSimpleCheckBox.KeyDown (var pKey : word;
248 pShift : TShiftState);
249 begin
250 // Respond to the space key (with any other button).
251 iEventK := pKey = VK_SPACE;
252 // If this is the key, then force the control to be repainted (which will
253 // be done in the background colour).
254 if iEventK then
255 Invalidate ();
256 // Call the ancestor method and any event handler.
257 inherited KeyDown (pKey,
258 pShift)
259 end;
260
261 // Key up event.
262 procedure TSimpleCheckBox.KeyUp (var pKey : word;
263 pShift : TShiftState);
264 begin
265 // If a space key was detected ...
266 if iEventK then
267 begin
268 // ... then toggle the state.
269 iChecked := not iChecked;
270 // Call the change event, if required.
271 if Assigned (iChange) then
272 iChange (Self);
273 // Reset the indicator ...
274 iEventK := false;
275 // ... and force the control to be repainted.
276 Invalidate ()
277 end;
278 // Call the ancestor method and any event handler.
279 inherited KeyUp (pKey,
280 pShift)
281 end;
282
283 // Mouse button down event.
284 procedure TSimpleCheckBox.MouseDown (pButton : TMouseButton;
285 pShift : TShiftState;
286 pX : integer;
287 pY : integer);
288 begin
289 // Only left mouse button events are processed.
290 if pButton = mbLeft then
291 begin
292 // Set focus to the control.
293 SetFocus ();
294 // Note whether the click is within the inner rectangle.
295 iEventM := PtInRect (kRectBg, Point (pX, pY));
296 // Force the control to be repainted.
297 Invalidate ()
298 end;
299 // Call the ancestor method and any event handler.
300 inherited MouseDown (pButton,
301 pShift,
302 pX,
303 pY)
304 end;
305
306 // Mouse button up event.
307 procedure TSimpleCheckBox.MouseUp (pButton : TMouseButton;
308 pShift : TShiftState;
309 pX : integer;
310 pY : integer);
311 begin
312 // If the left mouse button was clicked within the checkbox:
313 if iEventM then
314 begin
315 // - Reset the flag.
316 iEventM := false;
317 // - If the pointer is still (or again) within the checkbox then toggle
318 // the state ...
319 if (pButton = mbLeft) and PtInRect (kRectBg, Point (pX, pY)) then
320 begin
321 iChecked := not iChecked;
322 // ... and call the change event.
323 if Assigned (iChange) then
324 iChange (Self)
325 end;
326 // - Force the control to be repainted.
327 Invalidate ()
328 end;
329 // Call the ancestor method and any event handler.
330 inherited MouseUp (pButton,
331 pShift,
332 pX,
333 pY)
334 end;
335
336 // Component registration procedure.
337 procedure register;
338 begin
339 RegisterComponents ('AS',
340 [TSimpleCheckBox]);
341 end;
342
343 end.
344
345 {
346 The most noticeable difference between this class and the standard checkbox is
347 in the events. For this class, changes to the check status are notified using
348 the OnChange event, rather than OnClick.
349
350 Another difference is the absence of the AllowGrayed property. This should be
351 fairly easy to add, but there was no requirement in this particular project.
352 }
|
