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;

      //change the caption
      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

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.

Answer 3

I found a page that may be of interest to you...http://www.howtodothings.com/computers/a975-how-to-create-custom-inputquerymessagebox-etc-without-pain.html