在Delphi中展示自定义消息对话框的最佳方法是什么？

Question

我正在使用Delphi，并且我想在MessageDlg的按钮上显示自定义文本，如此描述. 做到这一点的最佳方法是什么？

- JosephStyons

Answer 1

回答我的问题... 我编写了下面的单元，对我来说效果很好。

Delphi提供CreateMessageDialog()以提供一个对话框模板，您可以在显示之前修改。我使用它创建了一个名为MessageDlgCustom的函数，该函数接受与标准MessageDlg相同的参数，但增加了一个用于替换按钮标题的参数。

它正确处理自定义字体并自动调整按钮的宽度以适应其消息。如果按钮溢出对话框，则也会进行调整。

使用该单元后，下面的示例将起作用：

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

如果有其他更好的方法，请分享。

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.

- JosephStyons

---

如果你至少使用 Delphi 2007，那么我会创建一个全新的 MessageDlg() 函数，在检查 Windows 版本后，使用 Vista 上的新对话框类，否则使用修改过的原始 MessageDlg() 函数。这将使你能够轻松地添加“不再显示”复选框。 - mghie

目前的代码无法编译。你需要重新组织一些方法。将GetTextWidth移动到实现部分的顶部，如果你将ModifyDialog移到MessageDlgCustom方法之前，就可以从接口部分中删除声明了。在WinXP上，修改后的对话框最后一个按钮（使用你提供的示例调用）几乎贴着窗口边框。由于某种原因，该方法未能正确地重新计算对话框的宽度。 - Vivian Mills

关键在于VCL的CreateMessageDialog函数，它提供了一个存货对话框对象，供您在显示之前进行修改。请在开头提到这一点，而不是让读者在示例中查找零风头使用方法。 - Rob Kennedy

@Rob - 谢谢你的建议，确实让事情更清楚了。已添加。 - JosephStyons

我建议进行编辑，以处理您不想覆盖所有按钮的情况。例如 MessageDlgCustom('确认？',mtCustom, mbYesNoCancel, ['是的，先生！','',''], nil);，默认值将用于代替空字符串。请审核一下。 - Vitim.us

Answer 2

作为替代方案，您可以使用开源的SynTaskDialog单元。SynTaskDialog在较新的Windows版本上本地使用Windows TaskDialog API，在较旧的版本上模拟它。 您甚至可以与FireMonkey一起使用它。

有关可自定义的MessageDlg函数的示例，请参见此答案。

- yonojoy

Answer 3

您可以查看GitHub上提供的TDam组件（https://github.com/digao-dalpiaz/Dam）。

该组件允许您创建自定义消息对话框，使用格式化文本（HTML文本）和允许自定义对话框的许多方面的预定义按钮。

此外，您可以将所有应用程序对话框管理到“容器”中，该容器将所有对话框存储为对象（TDamMsg）。 TDam消息示例 TDamMsg属性允许自定义消息对话框，例如：

• Button1 - 按钮1标题
• Button2 - 按钮2标题
• Button3 - 按钮3标题

按钮：TDamMsgButtons = 定义消息对话框中的按钮。

• dbOK：定义一个按钮“确定”
• dbYesNo：定义两个按钮“是/否”
• dbOne：通过Button1定义的标题定义一个按钮
• dbTwo：通过Button1和Button2定义的标题定义两个按钮
• dbThree：通过Button1、Button2和Button3定义的标题定义三个按钮

- Digão Dalpiaz

Answer 4

此外，请确保您的第三方控件也调用您的自定义消息对话框，而不是标准的MessageDlg函数。如果它们实际上在使用它，则需要这样做。第三方控件可能不使用Delphi messagedlg并直接调用MessageBox API。如果是这种情况，您可能会出现显示消息框不一致的情况。

- Rick