Delphi 中显示自定义消息对话框的最佳方式是什么? [英] What is the best way in Delphi to show customized Message Dialogs?

问题描述

我正在使用 Delphi，我想在 MessageDlg 的按钮中显示自定义文本，如此处所述.最好的方法是什么?

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

推荐答案

回答我自己的问题.... 我写了下面这个对我很有效的单元.

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

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

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.

这篇关于Delphi 中显示自定义消息对话框的最佳方式是什么?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！