Как лучше всего в Delphi показать настроенные диалоги сообщений?

Ответ 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.

Ответ 2

В качестве альтернативы вы можете использовать модуль Open Source SynTaskDialog. SynTaskDialog использует Windows TaskDialog API изначально на более поздних версиях Windows и эмулирует его в более старых версиях. Вы даже можете использовать его с FireMonkey.

Для примера настраиваемой функции MessageDlg просмотрите этот ответ.

Ответ 3

Кроме того, убедитесь, что ваш сторонний элемент управления также вызовите свое собственное сообщение dlg, а не стандартное MessageDlg. То есть, если они на самом деле используй это. Возможно, что сторонние элементы управления не используйте Delphi messagedlg и вызывайте MessageBox API напрямую. В этом случае вы можете заканчиваются несоответствия в показе сообщения коробки.