Author: Jonas Bilinkevicius
How to draw buttons on the title bar of a TForm
Answer:
Solve 1:
Place an icon-sized TImage on a form and add the following code:
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls;
8
9 type
10 TForm1 = class(TForm)
11 Image1: TImage;
12 procedure FormCreate(Sender: TObject);
13 private
14 {Private declarations}
15 TitleBarCanvas: TCanvas;
16 procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
17 procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
18 procedure DrawExtraStuff;
19 public
20 {Public declarations}
21 end;
22
23 var
24 Form1: TForm1;
25
26 implementation
27
28 {$R *.DFM}
29
30 procedure TForm1.FormCreate(Sender: TObject);
31 var
32 NonClientMetrics: TNonClientMetrics;
33 begin
34 TitleBarCanvas := TCanvas.Create;
35 TitleBarCanvas.Handle := GetWindowDC(Handle);
36 NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
37 SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0);
38 TitleBarCanvas.Font.Handle := CreateFontIndirect(NonClientMetrics.lfCaptionFont);
39 TitleBarCanvas.Brush.Style := bsClear;
40 Caption := '';
41 end;
42
43 procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
44 begin
45 inherited;
46 DrawExtraStuff;
47 end;
48
49 procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
50 begin
51 inherited;
52 if Msg.Active then
53 TitleBarCanvas.Font.Color := clCaptionText
54 else
55 TitleBarCanvas.Font.Color := clInactiveCaptionText;
56 DrawExtraStuff;
57 end;
58
59 procedure TForm1.DrawExtraStuff;
60 var
61 X, Y, TransColor: Integer;
62 begin
63 {set the transparent color to bottom left pixel}
64 TransColor := Image1.Canvas.Pixels[0, Image1.Picture.Height - 1];
65 with Image1 do
66 for x := 0 to Picture.Width - 1 do
67 for y := 0 to Picture.Height - 1 do
68 if Canvas.Pixels[x, y] <> TransColor then
69 TitleBarCanvas.Pixels[22 + x, 5 + y] := Canvas.Pixels[x, y];
70 TitleBarCanvas.TextOut(40, 6, '<- Here is the other icon');
71 end;
72
73 end.
Solve 2:
I got my first clue into solving this problem when I wrote a previous tip that
covered rolling up the client area of forms so that only the caption bar showed. In
my research for that tip, I came across the WMSetText message that is used for
drawing on a form's canvas. I wrote a little sample application to test drawing in
the caption area. The only problem with my original code was that the button would
disappear when I resized or moved the form.
I turned to well-known Delphi/Pascal guru, Neil Rubenking, for help. He pointed me
in the direction of his book, "Delphi Programming Problem Solver," which had an
example of doing this exact thing. The code you'll see below is an adaptation of
the example in his book. The most fundamental difference between our examples is
that I wanted to make a speedbutton with a bitmap glyph, and Neil actually drew a
shape directly on the canvas. Neil also placed the button created in 16-bit Delphi
on the left-hand side of the frame, and Win32 button placement was on the right. I
wanted my buttons to be placed on the right for both versions, so I wrote
appropriate code to handle that. The deficiency in my code was the lack of handlers
for activation and painting in the non-client area of the form.
One thing that I'm continually discovering is that there is a very definitive
structure in Windows - a definite hierarchy of functions. I've realized that the
thing that makes Windows programming at the API level difficult is the sheer number
of functions in the API set. For those who are reluctant to dive into the WinAPI,
think in terms of categories first, then narrow your search. You'll find that doing
it this way will make your life much easier.
What makes all of this work is Windows messages. The messages that we are
interested in here are not the usual Windows messages handled by vanilla Windows
apps, but are specific to an area of a window called the non-client area. The
client area of a window is the part inside the border which is where most
applications present information. The non-client area of a window consists of its
borders, caption bar, system menu, and sizing buttons. The Windows messages that
pertain to this area have the naming convention of WM_NCMessageType. Taking the
name apart, 'WM' stands for Windows Message, 'NC' stands for Non-client area, and
MessageType is the message type being trapped. For example, WM_NCPaint is the paint
message for the non-client area. Taking into account the hierarchical and
categorical nature of the Windows API, nomenclature is a very big part of it;
especially with Windows messages. If you look in the help file under messages,
peruse through the list of messages and you will see that the order that is
followed.
Let's look at a list of things that we need to consider to add a button to the
title bar of a form:
We need to have a function to draw the button
We'll have to trap drawing and painting events so that our button stays visible
when the form activates, resizes, or moves
Since we're dropping a button on the title bar, we have to have some way of
trapping for a mouse click on the button.
I'll now discuss these topics, in the above order.
Drawing a TRect as a Button
As I mentioned above, you can't drop VCL objects onto a non-client area of a
window, but you can draw on it and essentially simulate the appearance of a button.
In order to perform drawing in the title bar of a window, you have to do three very
important things in order:
You have to get the current measurements of the window and the size of the frame
bitmaps so you know what area to draw in and how big to draw the rectangle. 2.Then,
you have to define a TRect structure with the proper size and position within the
title bar. 3.Finally, you have to draw the TRect to appear as a button, then add
any glyphs or text you might want to draw to the buttonface.
All this is accomplished in a single call. For this program we make a call to a
procedure called DrawTitleButton, which is listed below:
74 procedure TTitleBtnForm.DrawTitleButton;
75 var
76 bmap: TBitmap; {Bitmap to be drawn - 16 x 16 : 16 Colors}
77 XFrame, {X and Y size of Sizeable area of Frame}
78 YFrame,
79 XTtlBit, {X and Y size of Bitmaps in caption}
80 YTtlBit: Integer;
81 begin
82 {Get size of form frame and bitmaps in title bar}
83 XFrame := GetSystemMetrics(SM_CXFRAME);
84 YFrame := GetSystemMetrics(SM_CYFRAME);
85 XTtlBit := GetSystemMetrics(SM_CXSIZE);
86 YTtlBit := GetSystemMetrics(SM_CYSIZE);
87 {$IFNDEF WIN32}
88 TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
89 XTtlBit + 2, YTtlBit + 2);
90 {$ELSE} {Delphi 2.0 positioning}
91 if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
92 TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
93 XTtlBit + 2, YTtlBit + 2)
94 else
95 TitleButton := Bounds(Width - XFrame - 4 * XTtlBit + 2, XFrame + 2, XTtlBit + 2,
96 YTtlBit + 2);
97 {$ENDIF}
98 Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
99 try
100 {Draw a button face on the TRect}
101 DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
102 bmap := TBitmap.Create;
103 bmap.LoadFromFile('help.bmp');
104 with TitleButton do
105 {$IFNDEF WIN32}
106 Canvas.Draw(Left + 2, Top + 2, bmap);
107 {$ELSE}
108 if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
109 Canvas.Draw(Left + 2, Top + 2, bmap)
110 else
111 Canvas.StretchDraw(TitleButton, bmap);
112 {$ENDIF}
113 finally
114 ReleaseDC(Self.Handle, Canvas.Handle);
115 bmap.Free;
116 Canvas.Handle := 0;
117 end;
118 end;
Step 1 above is accomplished by making four calls to the WinAPI function,
GetSystemMetrics, asking the system for the width and height of the window that can
be sized (SM_CXFRAME and SM_CYFRAME), and the size of the bitmaps contained on the
title bar (SM_CXSIZE and SM_CYSIZE).
Step 2 is performed with the Bounds function which returns a TRect defined by the
size and position parameters which are supplied to it. Notice that I used some
conditional compiler directives here. This is because the size of the title bar
buttons in Windows 95 and Windows 3.1 are different, so they have to be sized
differently. And since I wanted to be able to compile this in either version of
Windows, I used a test for the predefined symbol, WIN32, to see what version of
Windows the program is compiled under. However, since the Windows NT UI is the same
as Windows 3.1, it's necessary to grab further version information under the Win32
conditional to see if the Windows version is Windows NT. If it is, then we define
the TRect to be just like the Windows 3.1 TRect.
To perform Step 3, we make a call to the Buttons unit's DrawButtonFace to draw
button features within the TRect that we defined. As added treat, I included code
to draw a bitmap in the button. Again, you'll see that I used a conditional
compiler directive to draw the bitmap under different versions of Windows. I did
this purely for personal reasons because the bitmap that I used was 16 X 16 pixels
in dimension, which might be too big for Win95 buttons. So I used StretchDraw under
Win32 to stretch the bitmap to the size of the button.
Trapping the Drawing and Painting Events
You have to make sure that the button will stay visible every time the form
repaints itself. Painting occurs in response to activation and resizing, which fire
off paint and text setting messages that will redraw the form. If you don't have a
facility to redraw your button, you'll lose it every time a repaint occurs. So what
we have to do is write event handlers which will perform their default actions, but
also redraw our button when they fire off. The following four procedures handle the
paint triggering and painting events:
119 {Paint triggering events}
120
121 procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
122 begin
123 inherited;
124 DrawTitleButton;
125 end;
126
127 procedure TForm1.FormResize(Sender: TObject);
128 begin
129 Perform(WM_NCACTIVATE, Word(Active), 0);
130 end;
131
132 {Painting events}
133
134 procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
135 begin
136 inherited;
137 DrawTitleButton;
138 end;
139
140 procedure TForm1.WMSetText(var Msg: TWMSetText);
141 begin
142 inherited;
143 DrawTitleButton;
144 end;
Every time one of these events fires off, it makes a call to the DrawTitleButton
procedure. This will ensure that our button is always visible on the title bar.
Notice that we use the default handler OnResize on the form to force it to perform
a WM_NCACTIVATE.
Handling Mouse Clicks
Now that we've got code that draws our button and ensures that it's always visible,
we have to handle mouse-clicks on the button. The way we do this is with two
procedures. The first procedure tests to see if the mouse-click was in the area of
our button, then the second procedure actually performs the code execution
associated with our button. Let's look at the code below:
145 {Mouse-related procedures}
146
147 procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
148 begin
149 inherited;
150 {Check to see if the mouse was clicked in the area of the button}
151 with Msg do
152 if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
153 Result := htTitleBtn;
154 end;
155
156 procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
157 begin
158 inherited;
159 if (Msg.HitTest = htTitleBtn) then
160 ShowMessage('You pressed the new button');
161
162 end;
The first procedure WMNCHitTest(var Msg : TWMNCHitTest) is a hit tester message to
determine where the mouse was clicked in the non-client area. In this procedure we
test if the point defined by the message was within the bounds of our TRect by
using the PtInRect function. If the mouse click was performed in the TRect, then
the result of our message is set to htTitleBtn, which is a constant that was
declared as htSizeLast + 1. htSizeLast is a hit test constant generated by hit test
events to test where the last hit occurred.
The second procedure is a custom handler for a left mouse-click on a button in the
non-client area. Here we test if the hit test result was equal to htTitleBtn. If it
is, we show a message. This was purely for simplicity's sake, but you can make any
call you choose to at this point.
Putting it All Together
Let's look at the entire code in the form to see how it all works together:
163 unit Capbtn;
164
165 interface
166
167 uses
168 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
169 Dialogs,
170 Buttons;
171
172 type
173 TTitleBtnForm = class(TForm)
174 procedure FormResize(Sender: TObject);
175 private
176 TitleButton: TRect;
177 procedure DrawTitleButton;
178 {Paint-related messages}
179 procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
180 procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
181 procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
182 {Mouse down-related messages}
183 procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
184 procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);
185 message WM_NCLBUTTONDOWN;
186 function GetVerInfo: DWORD;
187 end;
188
189 var
190 TitleBtnForm: TTitleBtnForm;
191
192 const
193 htTitleBtn = htSizeLast + 1;
194
195 implementation
196
197 {$R *.DFM}
198
199 procedure TTitleBtnForm.DrawTitleButton;
200 var
201 bmap: TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
202 XFrame, {X and Y size of Sizeable area of Frame}
203 YFrame,
204 XTtlBit, {X and Y size of Bitmaps in caption}
205 YTtlBit: Integer;
206 begin
207 {Get size of form frame and bitmaps in title bar}
208 XFrame := GetSystemMetrics(SM_CXFRAME);
209 YFrame := GetSystemMetrics(SM_CYFRAME);
210 XTtlBit := GetSystemMetrics(SM_CXSIZE);
211 YTtlBit := GetSystemMetrics(SM_CYSIZE);
212 {$IFNDEF WIN32}
213 TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
214 XTtlBit + 2, YTtlBit + 2);
215 {$ELSE} {Delphi 2.0 positioning}
216 if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
217 TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
218 XTtlBit + 2, YTtlBit + 2)
219 else
220 TitleButton := Bounds(Width - XFrame - 4 * XTtlBit + 2, XFrame + 2, XTtlBit + 2,
221 YTtlBit + 2);
222 {$ENDIF}
223 Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
224 try
225 {Draw a button face on the TRect}
226 DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
227 bmap := TBitmap.Create;
228 bmap.LoadFromFile('help.bmp');
229 with TitleButton do
230 {$IFNDEF WIN32}
231 Canvas.Draw(Left + 2, Top + 2, bmap);
232 {$ELSE}
233 if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
234 Canvas.Draw(Left + 2, Top + 2, bmap)
235 else
236 Canvas.StretchDraw(TitleButton, bmap);
237 {$ENDIF}
238 finally
239 ReleaseDC(Self.Handle, Canvas.Handle);
240 bmap.Free;
241 Canvas.Handle := 0;
242 end;
243 end;
244
245 {Paint triggering events}
246
247 procedure TTitleBtnForm.WMNCActivate(var Msg: TWMNCActivate);
248 begin
249 inherited;
250 DrawTitleButton;
251 end;
252
253 procedure TTitleBtnForm.FormResize(Sender: TObject);
254 begin
255 Perform(WM_NCACTIVATE, Word(Active), 0);
256 end;
257
258 {Painting events}
259
260 procedure TTitleBtnForm.WMNCPaint(var Msg: TWMNCPaint);
261 begin
262 inherited;
263 DrawTitleButton;
264 end;
265
266 procedure TTitleBtnForm.WMSetText(var Msg: TWMSetText);
267 begin
268 inherited;
269 DrawTitleButton;
270 end;
271
272 {Mouse-related procedures}
273
274 procedure TTitleBtnForm.WMNCHitTest(var Msg: TWMNCHitTest);
275 begin
276 inherited;
277 {Check to see if the mouse was clicked in the area of the button}
278 with Msg do
279 if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
280 Result := htTitleBtn;
281 end;
282
283 procedure TTitleBtnForm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
284 begin
285 inherited;
286 if (Msg.HitTest = htTitleBtn) then
287 ShowMessage('You pressed the new button');
288 end;
289
290 function TTitleBtnForm.GetVerInfo: DWORD;
291 var
292 verInfo: TOSVERSIONINFO;
293 begin
294 verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
295 if GetVersionEx(verInfo) then
296 Result := verInfo.dwPlatformID;
297 {Returns:
298 VER_PLATFORM_WIN32s -- Win32s on Windows 3.1
299 VER_PLATFORM_WIN32_WINDOWS -- Win32 on Windows 95
300 VER_PLATFORM_WIN32_NT -- Windows NT }
301 end;
302
303 end.
You might want to play around with this code a bit to customize it to your own
needs. For instance, if you want to add a bigger button, add pixels to the XTtlBit
var. You might also want to mess around with creating a floating toolbar that is
purely on the title bar. Also, now that you have a means of interrogating what's
going on in the non-client area of the form, you might want to play around with the
default actions taken with the other buttons like the System Menu button to perhaps
display your own custom menu. Take heed though, playing around with Windows
messages can be dangerous. Save your work constantly, and be prepared for some
system crashes while you mess around with them.
Solve 3:
304 unit TitleBtn;
305
306 interface
307
308 uses
309 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Forms, Dialogs,
310 Buttons, Controls, StdCtrls, ExtCtrls;
311
312 type
313 TTitleBtnForm = class(TForm)
314 procedure FormResize(Sender: TObject);
315 procedure FormCreate(Sender: TObject);
316 function GetSystemTitleBtnCount: integer;
317 procedure KillHint;
318 private
319 TitleButton: TRect;
320 FActive: boolean;
321 FHint: THintWindow;
322 Timer2: TTimer;
323 procedure DrawTitleButton(i: integer);
324 {Paint-related messages}
325 procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
326 procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
327 procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
328 {Mouse-related messages}
329 procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
330 procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);
331 message WM_NCLBUTTONDOWN;
332 procedure WMNCLButtonUp(var Msg: TWMNCLButtonUp); message WM_NCLBUTTONUP;
333 procedure WMNCMouseMove(var Msg: TWMNCMouseMove); message WM_NCMouseMove;
334 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
335 {-}
336 function GetVerInfo: DWORD;
337 {-}
338 procedure ShowHint;
339 procedure Timer2Timer(Sender: TObject);
340 public
341 end;
342
343 const
344 htTitleBtn = htSizeLast + 1;
345
346 implementation
347
348 uses
349 PauLitaData, About, SpoolMessages;
350
351 procedure TTitleBtnForm.FormResize(Sender: TObject);
352 begin
353 Perform(WM_NCACTIVATE, Word(Active), 0);
354 end;
355
356 procedure TTitleBtnForm.DrawTitleButton(i: integer);
357 var
358 bmap: TBitmap; {Bitmap to be drawn - 16x16: 16 Colors}
359 XFrame, {X and Y size of Sizeable area of Frame}
360 YFrame,
361 XTtlBit, {X and Y size of Bitmaps in caption}
362 YTtlBit: integer;
363 n: integer;
364 begin
365 {Get size of form frame and bitmaps in title bar}
366 XFrame := GetSystemMetrics(SM_CXFRAME);
367 YFrame := GetSystemMetrics(SM_CYFRAME);
368 XTtlBit := GetSystemMetrics(SM_CXSIZE);
369 YTtlBit := GetSystemMetrics(SM_CYSIZE);
370 n := GetSystemTitleBtnCount;
371 if GetVerInfo = VER_PLATFORM_WIN32_NT then
372 TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1 - 3, YFrame + 1 -
373 3,
374 XTtlBit - 2, YTtlBit - 4)
375 else
376 TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1, YFrame + 1,
377 XTtlBit
378 - 2, YTtlBit - 4);
379 Canvas.Handle := GetWindowDC(Self.Handle);
380 try
381 {Draw a button face on the TRect}
382 DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, FALSE, FALSE, FALSE);
383 bmap := TBitmap.Create;
384 DataModule1.ImageList1.GetBitmap(i, bmap);
385 with TitleButton do
386 if GetVerInfo = VER_PLATFORM_WIN32_NT then
387 Canvas.Draw(Left + 2, Top + 2, bmap)
388 else
389 Canvas.StretchDraw(TitleButton, bmap);
390 finally
391 ReleaseDC(Self.Handle, Canvas.Handle);
392 bmap.Free;
393 Canvas.Handle := 0;
394 end;
395 end;
396
397 procedure TTitleBtnForm.WMSetText(var Msg: TWMSetText);
398 begin
399 inherited;
400 DrawTitleButton(0);
401 end;
402
403 procedure TTitleBtnForm.WMNCPaint(var Msg: TWMNCPaint);
404 begin
405 inherited;
406 DrawTitleButton(0);
407 end;
408
409 procedure TTitleBtnForm.WMNCActivate(var Msg: TWMNCActivate);
410 begin
411 inherited;
412 DrawTitleButton(0);
413 end;
414
415 procedure TTitleBtnForm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
416 begin
417 inherited;
418 if (Msg.HitTest = htTitleBtn) then
419 DrawTitleButton(1);
420 end;
421
422 procedure TTitleBtnForm.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
423 begin
424 inherited;
425 if (Msg.HitTest = htTitleBtn) then
426 begin
427 KillHint;
428 ShowAboutBox;
429 end;
430 end;
431
432 procedure TTitleBtnForm.WMNCMouseMove(var Msg: TWMNCMouseMove);
433 begin
434 inherited;
435 if (Msg.HitTest = htTitleBtn) and PtinRect(TitleButton, Point(Msg.XCursor - Left,
436 Msg.YCursor - Top)) then
437 ShowHint
438 else
439 KillHint;
440 end;
441
442 function TTitleBtnForm.GetVerInfo: DWORD;
443 var
444 verinfo: TOSVERSIONINFO;
445 begin
446 verinfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
447 if GetVersionEx(verinfo) then
448 Result := verinfo.dwPlatformID;
449 end;
450
451 procedure TTitleBtnForm.WMNCHitTest(var Msg: TWMNCHitTest);
452 begin
453 inherited;
454 with Msg do
455 begin
456 if PtinRect(TitleButton, Point(XPos - Left, YPos - Top)) then
457 Result := htTitleBtn;
458 end;
459 end;
460
461 function TTitleBtnForm.GetSystemTitleBtnCount: integer;
462 var
463 Menu: HMenu;
464 i, n, m, l: integer;
465 begin
466 l := 0;
467 Menu := GetSystemMenu(Handle, FALSE);
468 n := GetMenuItemCount(Menu);
469 for i := 0 to n - 1 do
470 begin
471 m := GetMenuItemID(Menu, i);
472 if (m = SC_RESTORE) or (m = SC_MAXIMIZE) or (m = SC_CLOSE) then
473 Inc(l)
474 else if (m = SC_MINIMIZE) then
475 Inc(l, 2);
476 end;
477 Result := l;
478 end;
479
480 procedure TTitleBtnForm.KillHint;
481 begin
482 if Assigned(Timer2) then
483 begin
484 Timer2.Enabled := FALSE;
485 Timer2.Free;
486 Timer2 := nil;
487 end;
488 if Assigned(FHint) then
489 begin
490 FHint.ReleaseHandle;
491 FHint.Free;
492 FHint := nil;
493 end;
494 FActive := FALSE;
495 end;
496
497 procedure TTitleBtnForm.Timer2Timer(Sender: TObject);
498 var
499 thePoint: TPoint;
500 theRect: TRect;
501 Count: DWORD;
502 i: integer;
503 begin
504 Timer2.Enabled := FALSE;
505 Timer2.Free;
506 Timer2 := nil;
507 thePoint.X := TitleButton.Left;
508 thePoint.Y := TitleButton.Bottom - 25;
509 with theRect do
510 begin
511 topLeft := ClientToScreen(thePoint);
512 Right := Left + Canvas.TextWidth(MsgAbout) + 10;
513 Bottom := Top + 14;
514 end;
515 FHint := THintWindow.Create(Self);
516 FHint.Color := clInfoBk;
517 FHint.ActivateHint(theRect, MsgAbout);
518 for i := 1 to 7 do
519 begin
520 Count := GetTickCount;
521 repeat
522 {Application.ProcessMessages;}
523 until
524 (GetTickCount - Count >= 18);
525 with theRect do
526 begin
527 Inc(Top);
528 Inc(Bottom);
529 FHint.SetBounds(Left, Top, FHint.Width, FHint.Height);
530 FHint.Update;
531 end;
532 end; { i }
533 FActive := TRUE;
534 end;
535
536 procedure TTitleBtnForm.ShowHint;
537 begin
538 if FActive then
539 Exit;
540 if Assigned(Timer2) then
541 Exit;
542 Timer2 := TTimer.Create(Self);
543 Timer2.Interval := 500;
544 Timer2.OnTimer := Timer2Timer;
545 Timer2.Enabled := TRUE;
546 end;
547
548 procedure TTitleBtnForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
549 Integer);
550 begin
551 inherited;
552 KillHint;
553 end;
554
555 procedure TTitleBtnForm.FormCreate(Sender: TObject);
556 begin
557 OnMouseMove := FormMouseMove;
558 end;
559
560 end.
|
