Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
How to draw buttons on the title bar of a TForm Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
15-Oct-02
Category
VCL-Forms
Language
Delphi 2.x
Views
241
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC