uses Dialogs, StdCtrls, Math;
var MessageDlgExList: TStringList;
const mbAuto = TMsgDlgBtn(Ord(High(TMsgDlgBtn)) + 1);
function MessageDlgEx(
const DlgID, Msg:
String; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; DefaultButton: TMsgDlgBtn = mbAuto): Integer;
var
Dialog: TForm;
i, X, Y: Integer;
C: TWinControl;
Query: TCheckBox;
begin
if (DlgID <> '
')
and (MessageDlgExList.IndexOfName(DlgID) >= 0)
then begin
Result := StrToInt(MessageDlgExList.Values[DlgID]);
Exit;
end;
if DefaultButton = mbAuto
then
if mbOk
in Buttons
then DefaultButton := mbOk
else if mbYes
in Buttons
then DefaultButton := mbYes
else DefaultButton := mbRetry;
Dialog := CreateMessageDialog(Msg, DlgType, Buttons, DefaultButton);
try
if DlgID <> '
'
then begin
X := 999;
Y := 0;
for i := Dialog.ComponentCount - 1
downto 0
do
if Dialog.Components[i]
is TWinControl
then begin
C := TWinControl(Dialog.Components[i]);
if C.Visible
then begin
X := Min(C.Left, X);
Y := Max(C.Top + C.Height, Y);
end;
end;
Query := TCheckBox.Create(Dialog);
Query.Parent := Dialog;
Query.Left := X;
Query.Top := Dialog.ClientHeight;
Query.Width := 100;
Query.Caption := '
merken';
Dialog.ClientHeight := Dialog.ClientHeight +
Query.Height + (Dialog.ClientHeight - Y);
end;
Result := Dialog.ShowModal;
if Query.Checked
and (Result <> MB_ABORTRETRYIGNORE)
then
MessageDlgExList.Add(DlgID + MessageDlgExList.NameValueSeparator + IntToStr(Result));
finally
Dialog.Free;
end;
end;
initialization
MessageDlgExList := TStringList.Create;
MessageDlgExList.Sorted := True;
finalization
MessageDlgExList.Free;
end.