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.
|
