Увеличение возможностей функции MessageDlg (документация)

Необходимость в двух неочевидных (не по умолчанию) возможностях функции messagedlg
заставили меня исследовать исходный код модуля dialogs.
Во-первых, мне нужна была форма диалога, которая закрывалась бы при нажатии клавиши и
возвращала при этом код нажатой клавиши .
Что-то наподобие команды turbopascal if keypressed then thekey:=readkey.
Во-вторых, мне нужно было контролировать,
какая кнопка диалога активна по умолчанию.
Если , например, у вас появилась форма messagedlg с вопросом : " Вы действительно хотите удалить файл?"
и по умолчанию фокус находится на кнопке yes (что верно в стандартном окне messagedlg) ,
то для нетерпеливого пользователя могут возникнуть проблемы.
В модуле dialogs имеется функция, называемая createmessagedialog ,
которая используется в messagedlg для собственно формирования диалога.
Используя функцию createmessagedialog прямо вы получаете наилучшую форму messagedlg и плюс больший контроль за поведением данной формы.
Ниже показано решение этих моих двух проблем.
Создайте новое приложение. Разместите две кнопки ( buttons) и Метку ( label) на форме.
Назовите событие onclick кнопки button1
tform1.button1click и событие onclick кнопки button2 tform1.button2click.
Щелкните кнопкой button1 , чтобы появилась диалоговая форма,
которая закроется , когда пользователь нажмет одну из видимых диалоговых кнопок или нажмет
esc или щелкнет на иконке закрытия формы диалога. Нажатая кнопка будет показана в метке label1.
Щелкните кнопкой button2 , будет показана стандартная диалоговая форма,
но с одним отличием : по умолчанию выбрана кнопка no, а не кнопка yes.
Для выбора кнопки no я использую код : if tbutton(controls[n]).name='no'.
Вместо 'no' можно использовать 'yestoall', 'abort' или любые другие заголовки кнопки ,
используемой по умолчанию.
unit unit1;
interface
uses
windows, messages, sysutils, classes, graphics, controls,
forms, dialogs,
stdctrls;
type
tform1 = class(tform)
button1: tbutton;
label1: tlabel;
button2: tbutton;
procedure button1click(sender: tobject);
procedure helpboxkeypress(sender: tobject; var key:
char);
procedure button2click(sender: tobject);
private
{ private declarations }
public
{ public declarations }
end;
var
form1: tform1;
implementation
{$r *.dfm}
var
legalkeys: string;
procedure tform1.button1click(sender: tobject);
var
s:string;
begin
legalkeys:='abc123';
s:='what do you want to do now?'#13#13'a. go home'#13'b.
eat lunch'#13+
'c. sleep'#13'1. program in delphi'#13'2. order a
pizza'#13'3. nothing';
with createmessagedialog(s, mtco
begin
try
onkeypress:=helpboxkeypress;
if showmodal=mrok
then label1.caption:='you pressed: '+legalkeys[tag]
else label1.caption:='you pressed: '+'cancel';
finally
free;
end; //try..finally
end; //with
end;
procedure tform1.helpboxkeypress(sender: tobject; var key:
char);
begin
if pos(upcase(key),legalkeys)> 0 then
begin
tform(sender).tag:=pos(upcase(key),legalkeys);
tform(sender).modalresult:=mrok;
end
else if key=#27 then tform(sender).modalresult:=mrcancel;
end;
procedure tform1.button2click(sender: tobject);
var
n:integer;
begin
with createmessagedialog('do you really want to delete
the file?',mtwarning,[mbyes,mbno]) do
begin
for n:=0 to controlcount-1 do
if (controls[n] is tbutton)
then if tbutton(controls[n]).name='no' then tbutton
(controls[n]).taborder:=0;
showmodal;
end;
end;
end.