Author: Tomas Rutkauskas
Is there a way to set the focus on a certain button when using MessageDlg? I want
to be able to set focus to the No button when the dialog executes. By default the
focus is always on the Yes button, no matter what order I code them in the function.
Answer:
Solve 1:
I had a similar situation come up and I wanted to specify which button was
considered the default when pressing ENTER and which one would be the default for
pressing ESCAPE. Also, I wanted other text in the buttons. So instead of Yes/ No I
would have liked Save File/ Skip Save.
Then it becomes easier for the user to determine which button to press. They don't
have to read the whole message, they can just look at the button. So, I will give
you my code for that. I call it MultiMessageDlg, you can specify up to 4 buttons.
Here is the source for my form:
1 unit MultiAsk;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls;
8
9 type
10 TMultiAskMenu = class(TForm)
11 LAsk: TLabel;
12 PButtons: TPanel;
13 Button1: TButton;
14 Button2: TButton;
15 Button3: TButton;
16 Panel1: TPanel;
17 Image1: TImage;
18 Button4: TButton;
19 procedure Button1Click(Sender: TObject);
20 procedure Button2Click(Sender: TObject);
21 procedure Button3Click(Sender: TObject);
22 procedure FormShow(Sender: TObject);
23 procedure Button4Click(Sender: TObject);
24 procedure FormClose(Sender: TObject; var Action: TCloseAction);
25 private
26 { Private declarations }
27 public
28 { Public declarations }
29 procedure Setup(MsgType: TMsgDlgType; Num: Integer; Title, Ask, S1, S2, S3, S4:
30 string);
31 end;
32
33 var
34 MultiAskMenu: TMultiAskMenu;
35
36 implementation
37
38 uses
39 GlobalRW;
40
41 {$R *.DFM}
42
43 procedure ButtonCode(const Butt1: TButton; var Cap: string);
44 begin
45 Butt1.Cancel := False;
46 Butt1.Tag := 0;
47 if Pos(' + ', Cap) = 1 then
48 begin
49 Butt1.Tag := 1;
50 Delete(Cap, 1, 1);
51 end;
52 if Pos(' - ', Cap) = 1 then
53 begin
54 Butt1.Cancel := True;
55 Delete(Cap, 1, 1);
56 end;
57 Butt1.Caption := Cap;
58 end;
59
60 procedure TMultiAskMenu.Setup(MsgType: TMsgDlgType; Num: Integer;
61 Title, Ask, S1, S2, S3, S4: string);
62 var
63 TmpBmp: TBitMap;
64 IconID: PChar;
65 X, W1, W2, W3, W4: Integer;
66 NonClientMetrics: TNonClientMetrics;
67 HIcon1: HIcon;
68 const
69 IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND, IDI_ASTERISK,
70 IDI_QUESTION, nil);
71 begin
72 case MsgType of
73 mtInformation:
74 begin
75 Self.Caption := ' Information ';
76 end;
77 mtWarning: b
78 begin
79 Self.Caption := ' Warning ';
80 end;
81 mtError:
82 begin
83 Self.Caption := ' Error ';
84 end;
85 end;
86 if Title <> '' then
87 Self.Caption := Title;
88 NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
89 if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
90 LAsk.Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
91 IconID := IconIDs[MsgType];
92 if IconID <> nil then
93 begin
94 with Image1 do
95 begin
96 HIcon1 := LoadIcon(0, IconID);
97 Picture.Icon.ReleaseHandle;
98 Picture.Icon.Handle := HIcon1;
99 end;
100 end;
101 TmpBmp := TBitMap.Create;
102 TmpBmp.Canvas.Font := Button1.Font;
103 W1 := TmpBmp.Canvas.TextWidth(S1) + 10;
104 Button1.Width := W1;
105 W2 := TmpBmp.Canvas.TextWidth(S2) + 10;
106 Button2.Width := W2;
107 W3 := TmpBmp.Canvas.TextWidth(S3) + 10;
108 Button3.Width := W3;
109 W4 := TmpBmp.Canvas.TextWidth(S4) + 10;
110 Button4.Width := W4;
111 TmpBmp.Free;
112 LAsk.Caption := Ask;
113 PButtons.Top := LAsk.Top + LAsk.Height + 30;
114 case Num of
115 1:
116 begin
117 Button1.Left := Button2.Left;
118 Button2.Visible := False;
119 Button3.Visible := False;
120 Button4.Visible := False;
121 Button1.Left := (Self.Width - W1) div 2;
122 end;
123 2:
124 begin
125 Button2.Left := Button3.Left;
126 Button3.Visible := False;
127 Button4.Visible := False;
128 Button1.Caption := S1;
129 X := (Self.Width - W1 - W2) div 3;
130 Button1.Left := X;
131 Button2.Left := X + W1 + X;
132 end;
133 3:
134 begin
135 Button4.Visible := False;
136 X := (Self.Width - W1 - W2 - W3) div 4;
137 Button1.Left := X;
138 Button2.Left := X + W1 + X;
139 Button3.Left := X + W1 + X + W2 + X;
140 end;
141 4:
142 begin
143 X := (Self.Width - W1 - W2 - W3 - W4) div 5;
144 Button1.Left := X;
145 Button2.Left := Button1.Left + W1 + X;
146 Button3.Left := Button2.Left + W2 + X;
147 Button4.Left := Button3.Left + W3 + X;
148 end;
149 end;
150 {Take into Account pressing ESCAPE and Default buttons!!!
151 +Yes + = Default
152 -No - = Escape}
153 ButtonCode(Button1, S1);
154 ButtonCode(Button2, S2);
155 ButtonCode(Button3, S3);
156 ButtonCode(Button4, S4);
157 Self.AutoSize := True;
158 end;
159
160 procedure TMultiAskMenu.Button1Click(Sender: TObject);
161 begin
162 ModalResult := 1;
163 end;
164
165 procedure TMultiAskMenu.Button2Click(Sender: TObject);
166 begin
167 ModalResult := 2;
168 end;
169
170 procedure TMultiAskMenu.Button3Click(Sender: TObject);
171 begin
172 ModalResult := 3;
173 end;
174
175 procedure TMultiAskMenu.Button4Click(Sender: TObject);
176 begin
177 ModalResult := 4;
178 end;
179
180 procedure TMultiAskMenu.FormShow(Sender: TObject);
181 begin
182 if Button1.Tag = 1 then
183 Button1.SetFocus;
184 if Button2.Tag = 1 then
185 Button2.SetFocus;
186 if Button3.Tag = 1 then
187 Button3.SetFocus;
188 if Button4.Tag = 1 then
189 Button4.SetFocus;
190 end;
191
192 procedure TMultiAskMenu.FormClose(Sender: TObject; var Action: TCloseAction);
193 begin
194 Self.Image1.Picture.Icon.ReleaseHandle;
195 end;
196
197 end.
So in order to use it you would do something like this:
198
199 if MultiMessageDlg('',
200 ' It has been awhile since you last checked for updates. Do you wish to check
201 the TurboView Internet site for updates to TurboView?'
202 mtInformation, 2, ' + Check NOW ', ' - Check Next Month', '', '') = 1 then
203 begin
204 {code to do checking for the latest version of program}
205 end;
So the format is MultiMessageDlg(TitleText, MessageText, MessageType,
NumberOfButtons, Button1Text, Button2Text, Button3Text, Button4Text);
The return value is which button was pressed [1..4];
TitleText is optional, if not title is given then the normal MessageDlg title will
be used for window dialog title.
MessageText is what message you want displayed
MessageType is the same thing you provide to the normal MessageDlg function
NumberOfButtons is how many buttons to actually display
ButtonText, you can provide text for up to 4 buttons.
Note: If you want a certain button to be the DEFAULT button, then you would put a
"+" plus sign in front of the text. For example: "+Save File" . And if you want a
button to be the default ESCAPE button, then put a "-" minus in front, like so:
"-Dont Save".
Solve 2:
The following function will let you define the default button, then center the
dialog above the OwnerWnd, and then play the sound associated with the message type:
206
207 function MessageDlgEx(OwnerWnd: HWND; DefButton: Integer; const Msg: string;
208 DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer;
209 var
210 vButton: TButton;
211 vRect: TRect;
212 vWidth: Integer;
213 vHeight: Integer;
214 vTop: Integer;
215 vLeft: Integer;
216 I: Integer;
217 begin
218 with CreateMessageDialog(Msg, DlgType, Buttons) do
219 begin
220 try
221 { Get the TRect }
222 GetWindowRect(OwnerWnd, vRect);
223 { Center the dialog }
224 vWidth := vRect.Right - vRect.Left;
225 vHeight := vRect.Bottom - vRect.Top;
226 vTop := vRect.Top;
227 vLeft := vRect.Left;
228 Top := vTop + ((vHeight - Height) div 2);
229 Left := vLeft + ((vWidth - Width) div 2);
230 { Set the default button }
231 for I := 0 to Pred(ComponentCount) do
232 begin
233 if Components[I] is TButton then
234 begin
235 vButton := TButton(Components[I]);
236 vButton.default := (vButton.ModalResult = DefButton);
237 if vButton.default then
238 begin
239 ActiveControl := vButton;
240 end;
241 end;
242 end;
243 { Play the sound associated with the DlgType }
244 case DlgType of
245 mtConfirmation: MessageBeep(MB_ICONQUESTION);
246 mtError: MessageBeep(MB_ICONERROR);
247 mtInformation: MessageBeep(MB_ICONINFORMATION);
248 mtWarning: MessageBeep(MB_ICONWARNING);
249 end;
250 { Show the dialog }
251 Result := ShowModal;
252 finally
253 free;
254 end;
255 end;
256 end;
257
258 procedure TForm1.Button1Click(Sender: TObject);
259 begin
260 if MessageDlgEx(Handle, mrNo, 'Do you wan''t this program to erase all of your
261 files?'
262 mtWarning, [mbYes, mbNo]) = mrYes then
263 ShowMessage('Okay...');
264 end;
|
