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 Add a Custom Button to the Caption Bar with System Menu and Hint 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
20-Jun-03
Category
VCL-Forms
Language
Delphi 3.x
Views
322
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tercio Ferdinando Gaudencio Filho

How to add a custom button to the caption bar with a System Menu and HINT!!!!

Answer:

That code can create a button to the caption bar, create a MenuItem in System menu 
and create a Hint to the button! 
Just put the code above in your Unit and change the "FrmMainForm" to your Form 
name, and other small things like Text of Hint

1   private
2   { Private declarations }
3   
4   procedure WMNCPAINT(var msg: Tmessage); message WM_NCPAINT;
5   procedure WMNCACTIVATE(var msg: Tmessage); message WM_NCACTIVATE;
6   procedure WMNCMOUSEDOWN(var msg: Tmessage); message WM_NCLBUTTONDOWN;
7   procedure WMNCMOUSEMOVE(var Msg: TMessage); message WM_NCMOUSEMOVE;
8   procedure WMMOUSEMOVE(var Msg: TMessage); message WM_MOUSEMOVE;
9   procedure WMLBUTTONUP(var msg: Tmessage); message WM_LBUTTONUP;
10  procedure WNCLBUTTONDBLCLICK(var msg: Tmessage); message
11    WM_NCLBUTTONDBLCLK;
12  procedure WMNCRBUTTONDOWN(var msg: Tmessage); message WM_NCRBUTTONDOWN;
13  procedure WMNCHITTEST(var msg: Tmessage); message WM_NCHITTEST;
14  procedure WMSYSCOMMAND(var msg: Tmessage); message WM_SYSCOMMAND;
15  
16  {...}
17  
18  var
19    {...}
20    Pressed: Boolean;
21    FocusLost: Boolean;
22    Rec: TRect;
23    NovoMenuHandle: THandle;
24    PT1: TPoint;
25    FHintshow: Boolean;
26    FHint: THintWindow;
27    FHintText: string;
28    FHintWidth: Integer;
29  
30    {...}
31  
32                      
33  //------------------------------------------------------------------------------
34  
35  procedure TFrmMainForm.WMSYSCOMMAND(var Msg: TMessage);
36  begin
37    if Msg.WParam = LongInt(NovoMenuHandle) then
38      //*********************************************
39      //The button was clicked! Put you function here
40      //*********************************************
41      inherited;
42  end;
43  
44  //------------------------------------------------------------------------------
45  
46  procedure TFrmMainForm.WMNCHITTEST(var Msg: TMessage);
47  var
48    Tmp: Boolean;
49  begin
50    if Pressed then
51    begin
52      Tmp := FocusLost;
53      PT1.X := Msg.LParamLo - FrmMainForm.Left;
54      PT1.Y := Msg.LParamHi - FrmMainForm.Top;
55      if PTInRect(Rec, PT1) then
56        FocusLost := False
57      else
58        FocusLost := True;
59      if FocusLost <> Tmp then
60        InvalidateRect(FrmMainForm.Handle, @Rec, True);
61    end;
62    inherited;
63  end;
64  
65  //------------------------------------------------------------------------------
66  
67  procedure TFrmMainForm.WMLBUTTONUP(var Msg: TMessage);
68  var
69    Tmp: Boolean;
70  begin
71    ReleaseCapture;
72    Tmp := Pressed;
73    Pressed := False;
74    if Tmp and PTInRect(Rec, PT1) then
75    begin
76      InvalidateRect(FrmMainForm.Handle, @Rec, True);
77      FHintShow := False;
78      FHint.ReleaseHandle;
79      //*********************************************
80      //The button was clicked! Put you function here
81      //*********************************************
82    end
83    else
84      inherited;
85  end;
86  
87  //------------------------------------------------------------------------------
88  
89  procedure TFrmMainForm.WNCLBUTTONDBLCLICK(var Msg: TMessage);
90  begin
91    PT1.X := Msg.LParamLo - FrmMainForm.Left;
92    PT1.Y := Msg.LParamHi - FrmMainForm.Top;
93    if not PTInRect(Rec, PT1) then
94      inherited;
95  end;
96  
97  //------------------------------------------------------------------------------
98  
99  procedure TFrmMainForm.WMNCRBUTTONDOWN(var Msg: TMessage);
100 begin
101   PT1.X := Msg.LParamLo - FrmMainForm.Left;
102   PT1.Y := Msg.LParamHi - FrmMainForm.Top;
103   if not PTInRect(Rec, PT1) then
104     inherited;
105 end;
106 
107 //------------------------------------------------------------------------------
108 
109 procedure TFrmMainForm.WMNCMOUSEDOWN(var Msg: TMessage);
110 begin
111   PT1.X := Msg.LParamLo - FrmMainForm.Left;
112   PT1.Y := Msg.LParamHi - FrmMainForm.Top;
113   FHintShow := False;
114   if PTInRect(Rec, PT1) then
115   begin
116     Pressed := True;
117     FocusLost := False;
118     InvalidateRect(FrmMainForm.Handle, @Rec, True);
119     SetCapture(TWinControl(FrmMainForm).Handle);
120   end
121   else
122   begin
123     FrmMainForm.Paint;
124     inherited;
125   end;
126 end;
127 
128 //------------------------------------------------------------------------------
129 
130 //That function Create a Hint
131 
132 procedure TFrmMainForm.WMNCMOUSEMOVE(var Msg: TMessage);
133 begin
134   PT1.X := Msg.LParamLo - FrmMainForm.Left;
135   PT1.Y := Msg.LParamHi - FrmMainForm.Top;
136   if PTInRect(Rec, PT1) then
137   begin
138     FHintWidth := FHint.Canvas.TextWidth(FHintText);
139     if (FHintShow = False) and (Length(Trim(FHintText)) <> 0) then
140       FHint.ActivateHint(
141         Rect(
142         Mouse.CursorPos.X,
143         Mouse.CursorPos.Y + 20,
144         Mouse.CursorPos.X + FHintWidth + 10,
145         Mouse.CursorPos.Y + 35
146         ),
147         FHintText
148         );
149     FHintShow := True;
150   end
151   else
152   begin
153     FHintShow := False;
154     FHint.ReleaseHandle;
155   end;
156 end;
157 
158 //------------------------------------------------------------------------------
159 
160 procedure TFrmMainForm.WMMOUSEMOVE(var Msg: TMessage);
161 begin
162   FHintShow := False;
163   FHint.ReleaseHandle;
164 end;
165 
166 //------------------------------------------------------------------------------
167 
168 procedure TFrmMainForm.WMNCACTIVATE(var Msg: TMessage);
169 begin
170   InvalidateRect(FrmMainForm.Handle, @Rec, True);
171   inherited;
172 end;
173 
174 //------------------------------------------------------------------------------
175 
176 procedure TFrmMainForm.WMNCPAINT(var Msg: TMessage);
177 begin
178   InvalidateRect(FrmMainForm.Handle, @Rec, True);
179   inherited;
180 end;
181 
182 //------------------------------------------------------------------------------
183 
184 procedure TFrmMainForm.FormPaint(Sender: TObject);
185 var
186   Border3D_Y, Border_Thickness, Btn_Width,
187     Button_Width, Button_Height: Integer;
188   MyCanvas: TCanvas;
189 begin
190   MyCanvas := TCanvas.Create;
191   MyCanvas.Handle := GetWindowDC(FrmMainForm.Handle);
192   Border3D_Y := GetSystemMetrics(SM_CYEDGE);
193   Border_Thickness := GetSystemMetrics(SM_CYSIZEFRAME);
194   Button_Width := GetSystemMetrics(SM_CXSIZE);
195   Button_Height := GetSystemMetrics(SM_CYSIZE);
196 
197   //It make a square button, but if you want a different button
198   //just change that var to your width.
199   Btn_Width := Border3D_Y + Border_Thickness + Button_Height - (2
200     * Border3D_Y) - 1;
201 
202   Rec.Left := FrmMainForm.Width - (3 * Button_Width + Btn_Width);
203   Rec.Right := FrmMainForm.Width - (3 * Button_Width + 03);
204   Rec.Top := Border3D_Y + Border_Thickness - 1;
205   Rec.Bottom := Rec.Top + Button_Height - (2 * Border3D_Y);
206   FillRect(MyCanvas.Handle, Rec, HBRUSH(COLOR_BTNFACE + 1));
207   if not Pressed or Focuslost then
208     DrawEdge(MyCanvas.Handle, Rec, EDGE_RAISED, BF_SOFT or BF_RECT)
209   else if Pressed and not Focuslost then
210     DrawEdge(MyCanvas.Handle, Rec, EDGE_SUNKEN, BF_SOFT or
211       BF_RECT);
212 
213   //It draw a the application icon to the button. Easy to change.
214   DrawIconEX(MyCanvas.Handle, Rec.Left + 4, Rec.Top + 3,
215     Application.Icon.Handle, 8, 8, 0, 0, DI_NORMAL);
216 
217   MyCanvas.Free;
218 end;
219 
220 {... }
221 
222 procedure TFrmMainForm.FormCreate(Sender: TObject);
223 
224 {... }
225 
226 InsertMenu(GetSystemMenu(Handle, False), 4, MF_BYPOSITION +
227   MF_STRING, NovoMenuHandle, pchar('TEXT OF THE MENU'));
228 Rec := Rect(0, 0, 0, 0);
229 FHintText := 'Put the text of your Hint HERE';
230 FHint := THintWindow.Create(Self);
231 FHint.Color := clInfoBk;
232 //You can change the background color of the Hint


			
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