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 implement custom button captions in a MessageDlg 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
30-Aug-02
Category
Dialogs
Language
Delphi 3.x
Views
176
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			Author: Tomas Rutkauskas

Is there a way to show a message box with some custom button captions (not only 
Yes, No, Cancel, etc.)? I know there are some third party components for using 
translating an application in different languages, but I would like to do it with 
only the standard functions or APIs.

Answer:

1   {
2   TggMessageDlg Component.
3   Author: Geurts Guido.
4   Date: 04 December 1998.
5   Delphi version: Delphi 3 Client/Server, no patches installed.
6   Operating System: Windows NT 4 WorkStation.
7   Known bugs: None at this time
8   
9   Still to test features:
10  Try running it under different languages of windows, see if it still is able to 
11  change the captions of
12  the buttons.
13  }
14  
15  unit ggMsgDlg;
16  
17  interface
18  
19  uses
20    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
21    StdCtrls, DsgnIntf;
22  
23  type
24    TAboutProperty = class(TPropertyEditor)
25    private
26    protected
27    public
28      procedure Edit; override;
29      function GetAttributes: TPropertyAttributes; override;
30      function GetName: string; override;
31      function GetValue: string; override;
32    end;
33  
34    {This class can hold the different values for the caption used in the messagebox}
35    TggDlgTypeCaption = class(TPersistent)
36    private
37      FInformationText: string;
38      FWarningText: string;
39      FErrorText: string;
40      FConfirmationText: string;
41      FCustomText: string;
42    protected
43    public
44    published
45      property InformationText: string read FInformationText write FInformationText;
46      property WarningText: string read FWarningText write FWarningText;
47      property ErrorText: string read FErrorText write FErrorText;
48      property ConfirmationText: string read FConfirmationText write 
49  FConfirmationText;
50      property CustomText: string read FCustomText write FCustomText;
51    end;
52  
53    {This class stores values that can be used later to determine if a "button" is to 
54  be included
55    in the messagebox or not, and if so, if the caption and/ or width needs to be 
56  overriden.}
57    TggButton = class(TPersistent)
58    private
59      FInclude: Boolean;
60      FCaption: string;
61      FWidth: Integer;
62    protected
63    public
64    published
65      property Include: Boolean read FInclude write FInclude;
66      property Caption: string read FCaption write FCaption;
67      property Width: Integer read FWidth write FWidth;
68    end;
69  
70    {This class defines the possible buttons that can be set and configured in the 
71  messagebox.
72    To know if a button is to be included or not, and any other information about 
73  this button, is
74    stored in the TggButton Class.}
75    TggButtons = class(TPersistent)
76    private
77      FYes: TggButton;
78      FNO: TggButton;
79      FCancel: TggButton;
80      FOK: TggButton;
81      FHelp: TggButton;
82      FAbort: TggButton;
83      FRetry: TggButton;
84      FIgnore: TggButton;
85      FAll: TggButton;
86    protected
87    public
88      constructor Create;
89      destructor Destroy; override;
90    published
91      property Yes: TggButton read FYes write FYes;
92      property NO: TggButton read FNo write FNo;
93      property Cancel: TggButton read FCancel write FCancel;
94      property OK: TggButton read FOK write FOK;
95      property Help: TggButton read FHelp write FHelp;
96      property Abort: TggButton read FAbort write FAbort;
97      property Retry: TggButton read FRetry write FRetry;
98      property Ignore: TggButton read FIgnore write FIgnore;
99      property All: TggButton read FAll write FAll;
100   end;
101 
102   {This is the actual ggMessageBox Component. This is the only registed class of 
103 this unit.}
104   TggMessageDlg = class(TComponent)
105   private
106     FAbout: TAboutProperty;
107     FDlgType: TMsgDlgType;
108     FDlgTypeText: TggDlgTypeCaption;
109     FMsgDlgButtons: TMsgDlgButtons;
110     FText: string;
111     FWidth: Integer;
112     FggButtons: TggButtons;
113     FDesignTimeTest: Boolean;
114   protected
115     function DoggMessageDLG(const Msg: string; DlgType: TMsgDlgType;
116       ggButtons: TMsgDlgButtons; HelpCtx: LongInt): Integer;
117     procedure SetDesignTimeTest(Value: Boolean);
118     property MsgDlgButtons: TMsgDlgButtons read FMsgDlgButtons write FMsgDlgButtons;
119   public
120     constructor Create(aOwner: TComponent); override;
121     destructor Destroy; override;
122     function Execute: Integer;
123   published
124     property About: TAboutProperty read FAbout write FAbout;
125     property Text: string read FText write FText;
126     property DlgType: TMsgDlgType read FDlgType write FDlgType;
127     property Width: Integer read FWidth write FWidth;
128     property DlgTypeCaption: TggDlgTypeCaption read FDlgTypeText write FDlgTypeText;
129     property ggButtons: TggButtons read FggButtons write FggButtons;
130     property DesignTimeTest: Boolean read FDesignTimeTest write SetDesignTimeTest;
131   end;
132 
133 procedure register;
134 
135 implementation
136 
137 {The TggButtons Class}
138 
139 constructor TggButtons.Create;
140 begin
141   inherited Create;
142   FYes := TggButton.Create;
143   FNo := TggButton.Create;
144   FCancel := TggButton.Create;
145   FOK := TggButton.Create;
146   FHelp := TggButton.Create;
147   FAbort := TggButton.Create;
148   FRetry := TggButton.Create;
149   FIgnore := TggButton.Create;
150   FAll := TggButton.Create;
151 end;
152 
153 destructor TggButtons.Destroy;
154 begin
155   FYes.Free;
156   FNo.Free;
157   FCancel.Free;
158   FOK.Free;
159   FHelp.Free;
160   FAbort.Free;
161   FRetry.Free;
162   FIgnore.Free;
163   FAll.Free;
164   inherited Destroy;
165 end;
166 
167 {The TggMessageDlg Component}
168 
169 constructor TggMessageDlg.Create(AOwner: TComponent);
170 begin
171   inherited Create(AOwner);
172   FDlgTypeText := TggDlgTypeCaption.Create;
173   FggButtons := TggButtons.Create;
174   ggButtons.OK.Include := True;
175   DlgType := mtInformation;
176   {if (csAncestor in ComponentState) then
177     DesignTimeTest := True;  //Does not work yet}
178 end;
179 
180 destructor TggMessageDlg.Destroy;
181 begin
182   FDlgTypeText.Free;
183   FggButtons.Free;
184   inherited Destroy;
185 end;
186 
187 {This published property can show the designed messagebox at designtime so the 
188 developer
189 does not have to his program every time he changes the messagebox and want's to see 
190 what he
191 has made of it. Its value remains false, because there simply is no use for storing 
192 anything here.}
193 
194 procedure TggMessageDlg.SetDesignTimeTest(Value: Boolean);
195 begin
196   {There's no need to set anything here, so let's not confuse the user to much 
197 here.}
198   if Value then
199   begin
200     if Text = '' then
201       Text := 'FreeWare' + #13 + 'by' + #13 + 'Geurts Guido' + #13 + '1998' + #13 + 
202 'Delphi 3';
203     Execute;
204     if Text = 'FreeWare' + #13 + 'by' + #13 + 'Geurts Guido' + #13 + '1998' + #13 + 
205 'Delphi 3' then
206       Text := '';
207   end;
208 end;
209 
210 {This public procedure still needs to be rebuild to give back the modal result of 
211 the messagebox.
212 Damned, why did I not think of this before. It will popup the messagebox at 
213 runtime.}
214 
215 function TggMessageDlg.Execute: Integer;
216 begin
217   Result := -1;
218   MsgDlgButtons := [];
219   with ggButtons do
220   begin
221     if YES.Include then
222       MsgDlgButtons := MsgDlgButtons + [mbYes];
223     if NO.Include then
224       MsgDlgButtons := MsgDlgButtons + [mbNO];
225     if Cancel.Include then
226       MsgDlgButtons := MsgDlgButtons + [mbCancel];
227     if OK.Include then
228       MsgDlgButtons := MsgDlgButtons + [mbOK];
229     if Help.Include then
230       MsgDlgButtons := MsgDlgButtons + [mbHelp];
231     if Abort.Include then
232       MsgDlgButtons := MsgDlgButtons + [mbAbort];
233     if Retry.Include then
234       MsgDlgButtons := MsgDlgButtons + [mbRetry];
235     if Ignore.Include then
236       MsgDlgButtons := MsgDlgButtons + [mbIgnore];
237     if All.Include then
238       MsgDlgButtons := MsgDlgButtons + [mbAll];
239   end;
240   Result := DoggMessageDLG(Text, DlgType, MsgDlgButtons, 0);
241 end;
242 
243 {This function is the actual motor of the component. It will change the layout of 
244 the messabox
245 while Delphi is creating it, to the layout speficied by the devoloper.}
246 
247 function TggMessageDlg.DoggMessageDLG(const Msg: string; DlgType: TMsgDlgType;
248   ggButtons: TMsgDlgButtons; HelpCtx: LongInt): Integer;
249 var
250   I: Integer;
251 begin
252   with CreateMessageDialog(Msg, DlgType, ggButtons) do
253   try
254     case DlgType of
255       mtInformation:
256         if DlgTypeCaption.InformationText <> '' then
257           Caption := DlgTypeCaption.InformationText;
258       mtWarning:
259         if DlgTypeCaption.WarningText <> '' then
260           Caption := DlgTypeCaption.WarningText;
261       mtError:
262         if DlgTypeCaption.ErrorText <> '' then
263           Caption := DlgTypeCaption.ErrorText;
264       mtConfirmation:
265         if DlgTypeCaption.ConfirmationText <> '' then
266           Caption := DlgTypeCaption.ConfirmationText;
267       mtCustom:
268         if DlgTypeCaption.CustomText <> '' then
269           Caption := DlgTypeCaption.CustomText;
270     end;
271     for I := 0 to ComponentCount - 1 do
272     begin
273       if (Components[I]).name = 'Yes' then
274       begin
275         if Self.ggButtons.Yes.Caption <> '' then
276           TButton(Components[I]).Caption := Self.ggButtons.Yes.Caption;
277         if Self.ggButtons.Yes.Width <> 0 then
278           TButton(Components[I]).Width := Self.ggButtons.Yes.Width;
279       end;
280       if (Components[I]).name = 'No' then
281       begin
282         if Self.ggButtons.NO.Caption <> '' then
283           TButton(Components[I]).Caption := Self.ggButtons.NO.Caption;
284         if Self.ggButtons.NO.Width <> 0 then
285           TButton(Components[I]).Width := Self.ggButtons.NO.Width;
286       end;
287       if (Components[I]).name = 'Cancel' then
288       begin
289         if Self.ggButtons.Cancel.Caption <> '' then
290           TButton(Components[I]).Caption := Self.ggButtons.Cancel.Caption;
291         if Self.ggButtons.Cancel.Width <> 0 then
292           TButton(Components[I]).Width := Self.ggButtons.Cancel.Width;
293       end;
294       if (Components[I]).name = 'OK' then
295       begin
296         if Self.ggButtons.OK.Caption <> '' then
297           TButton(Components[I]).Caption := Self.ggButtons.OK.Caption;
298         if Self.ggButtons.OK.Width <> 0 then
299           TButton(Components[I]).Width := Self.ggButtons.OK.Width;
300       end;
301       if (Components[I]).name = 'Help' then
302       begin
303         if Self.ggButtons.Help.Caption <> '' then
304           TButton(Components[I]).Caption := Self.ggButtons.Help.Caption;
305         if Self.ggButtons.Help.Width <> 0 then
306           TButton(Components[I]).Width := Self.ggButtons.Help.Width;
307       end;
308       if (Components[I]).name = 'Abort' then
309       begin
310         if Self.ggButtons.Abort.Caption <> '' then
311           TButton(Components[I]).Caption := Self.ggButtons.Abort.Caption;
312         if Self.ggButtons.Abort.Width <> 0 then
313           TButton(Components[I]).Width := Self.ggButtons.Abort.Width;
314       end;
315       if (Components[I]).name = 'Retry' then
316       begin
317         if Self.ggButtons.Retry.Caption <> '' then
318           TButton(Components[I]).Caption := Self.ggButtons.Retry.Caption;
319         if Self.ggButtons.Retry.Width <> 0 then
320           TButton(Components[I]).Width := Self.ggButtons.Retry.Width;
321       end;
322       if (Components[I]).name = 'Ignore' then
323       begin
324         if Self.ggButtons.Ignore.Caption <> '' then
325           TButton(Components[I]).Caption := Self.ggButtons.Ignore.Caption;
326         if Self.ggButtons.Ignore.Width <> 0 then
327           TButton(Components[I]).Width := Self.ggButtons.Ignore.Width;
328       end;
329       if (Components[I]).name = 'All' then
330       begin
331         if Self.ggButtons.All.Caption <> '' then
332           TButton(Components[I]).Caption := Self.ggButtons.All.Caption;
333         if Self.ggButtons.All.Width <> 0 then
334           TButton(Components[I]).Width := Self.ggButtons.All.Width;
335       end;
336     end;
337     HelpContext := HelpCtx;
338     {Width := Self.Width;}
339     Result := ShowModal;
340   finally
341     Free;
342   end;
343 end;
344 
345 {TAboutProperty}
346 
347 procedure TAboutProperty.Edit;
348 begin
349   MessageBox(0, PChar('TggMessageDlg component' + #13 + #13 + 'by Geurts
350     Guido - guido.geurts@advalvas.be '
351     PChar('The GuidoG utilities present...'), MB_OK);
352 end;
353 
354 function TAboutProperty.GetAttributes: TPropertyAttributes;
355 begin
356   Result := [paDialog, paReadOnly];
357 end;
358 
359 function TAboutProperty.GetName: string;
360 begin
361   Result := 'About';
362 end;
363 
364 function TAboutProperty.GetValue: string;
365 begin
366   Result := GetStrValue;
367 end;
368 
369 {Non class related procedures and functions}
370 
371 procedure register;
372 begin
373   RegisterComponents('GuidoG', [TggMessageDlg]);
374   RegisterPropertyEditor(TypeInfo(TAboutProperty), TggMessageDlg, 'About', 
375 TAboutProperty);
376 end;
377 
378 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