What is the best way in Delphi to show customized Message Dialogs?

Question

I am using Delphi, and I want to show custom text in the buttons of a MessageDlg, as described here. What is the best way to do that?

Answer 1

Answering my own question.... I wrote the below unit which works well for me.

Delphi provides CreateMessageDialog() to give you a dialog template, which you can modify before displaying. I used that to create a function I called MessageDlgCustom, which takes the same parameters as a standard MessageDlg, but adds one more for replacement button titles.

It correctly handles custom fonts and automatically adjusts buttons to be wide enough for their message. If the buttons overflow the dialog, then that gets adjusted too.

After using that unit, the below sample works:

case MessageDlgCustom('Save your changes?',mtConfirmation,
  [mbYes,mbNo,mbCancel],
  ['&Yes, I would like to save them with this absurdly long button',
  '&No, I do not care about my stupid changes',
  '&Arg! What are you talking about?  Do not close the form!'],
  nil)  //nil = no custom font
of
  mrYes:   
    begin
      SaveChanges;
      CloseTheForm;
    end;  //mrYes (save & close)
  mrNo: 
    begin
      CloseForm;
    end;  //mrNo (close w/o saving)
  mrCancel:
    begin
      //do nothing
    end;  //mrCancel (neither save nor close)
end;  //case

If someone else knows a better way, please share it.

unit CustomDialog;

interface

uses
  Dialogs, Forms, Graphics, StdCtrls;

function MessageDlgCustom(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; ToCaptions: array of string;
  customFont: TFont) : integer;
procedure ModifyDialog(var frm: TForm; ToCaptions : array of string;
  customFont : TFont = nil);


implementation

uses
  Windows, SysUtils;

function GetTextWidth(s: string; fnt: TFont; HWND: THandle): integer;
var
  canvas: TCanvas;
begin
  canvas := TCanvas.Create;
  try
    canvas.Handle := GetWindowDC(HWND);
    canvas.Font := fnt;
    Result := canvas.TextWidth(s);
  finally
    ReleaseDC(HWND,canvas.Handle);
    FreeAndNil(canvas);
  end;  //try-finally
end;

function MessageDlgCustom(const Msg: string;
  DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; ToCaptions: array of string;
  customFont: TFont): integer;
var
  dialog : TForm;
begin
  try
    dialog := CreateMessageDialog(Msg, DlgType, Buttons);
    dialog.Position := poScreenCenter;
    ModifyDialog(dialog,ToCaptions,customFont);
    Result := dialog.ShowModal;
  finally
    dialog.Release;
  end;  //try-finally
end;

procedure ModifyDialog(var frm: TForm; ToCaptions: array of string;
  customFont: TFont);
const
  c_BtnMargin = 10;  //margin of button around caption text
var
  i,oldButtonWidth,newButtonWidth,btnCnt : integer;
begin
  oldButtonWidth := 0;
  newButtonWidth := 0;
  btnCnt := 0;
  for i := 0 to frm.ComponentCount - 1 do begin
    //if they asked for a custom font, assign it here
    if customFont <> nil then begin
      if frm.Components[i] is TLabel then begin
        TLabel(frm.Components[i]).Font := customFont;
      end;
      if frm.Components[i] is TButton then begin
        TButton(frm.Components[i]).Font := customFont;
      end;
    end;
    if frm.Components[i] is TButton then begin
      //check buttons for a match with a "from" (default) string
      //if found, replace with a "to" (custom) string
      Inc(btnCnt);

      //record the button width *before* we changed the caption
      oldButtonWidth := oldButtonWidth + TButton(frm.Components[i]).Width;

      //if a custom caption has been provided use that instead,
      //or just leave the default caption if the custom caption is empty
      if ToCaptions[btnCnt - 1]<>'' then
        TButton(frm.Components[i]).Caption := ToCaptions[btnCnt - 1];

      //auto-size the button for the new caption
      TButton(frm.Components[i]).Width :=
        GetTextWidth(TButton(frm.Components[i]).Caption,
          TButton(frm.Components[i]).Font,frm.Handle) + c_BtnMargin;

      //the first button can stay where it is.
      //all other buttons need to slide over to the right of the one b4.
      if (1 < btnCnt) and (0 < i) then begin
        TButton(frm.Components[i]).Left :=
          TButton(frm.Components[i-1]).Left +
          TButton(frm.Components[i-1]).Width + c_BtnMargin;
      end;

      //record the button width *after* changing the caption
      newButtonWidth := newButtonWidth + TButton(frm.Components[i]).Width;
    end;  //if TButton
  end;  //for i

  //whatever we changed the buttons by, widen / shrink the form accordingly
  frm.Width := Round(frm.Width + (newButtonWidth - oldButtonWidth) +
    (c_BtnMargin * btnCnt));
end;

end.

Answer 2

As an alternative you can use the Open Source SynTaskDialog unit. SynTaskDialog uses the Windows TaskDialog API natively on newer Windows versions and emulates it on older versions. You even can use it with FireMonkey.

For an example of a customizable MessageDlg function have a look at this answer.

Answer 3

You may have a look at the TDam component available on GitHub (https://github.com/digao-dalpiaz/Dam).

This component allows you to create customized Message Dialogs with pre-defined buttons, using formatted text (HTML Text), and allowing to customize a lot of aspects of dialogs.

Besides that, you can manage all your app dialogs into a "container", which stores all dialogs as objects (TDamMsg).

TDam Message Example

TDamMsg properties allows to customize message dialog, like:

• Button1 - button 1 caption
• Button2 - button 2 caption
• Button3 - button 3 caption

Buttons: TDamMsgButtons = Defines the buttons in the message dialog:

• dbOK: Defines one button OK
• dbYesNo: Defines two buttons Yes/No
• dbOne: Defines one button by Button1 defined caption
• dbTwo: Defines two buttons by Button1 and Button2 defined captions
• dbThree: Defines three buttons by Button1, Button2 and Button3 defined captions

Answer 4

Also, make sure that your 3rd party controls also call your custom message dlg and not standard MessageDlg function. That is if they're actually using it. It is possible that 3rd party controls do not use the Delphi messagedlg and call the MessageBox API directly. If that's case, you might end up with inconsistencies in showing message boxes.