この記事は旧ブログ(amuns:blog)の記事です。

通常メッセージダイアログは、「MessageDlg」で呼び出せますが、フォントサイズなどを指定できません。

今回は「CreateMessageDialog」を使用して、オリジナルのメッセージダイアログを実装します。
ウィンドウはXP風ですが、フォントのサイズを指定できます。

環境

•Turbo Delphi

オリジナルのメッセージダイアログ

早速オリジナルのメッセージダイアログの関数です。

//===========================================================
// メッセージダイアログ
// フォントを指定できる。
// (大きくしたり、字体を変えたり、太文字にしたりなど)
// 引数はMessageDlgと同じ。最後にメッセージのフォントを指定する。
//===========================================================
function MessageDlgEx(const Msg: string;
                      DlgType: TMsgDlgType;
                      Buttons: TMsgDlgButtons;
                      HelpCtx: Longint;
                      MsgFont: TFont        // メッセージのフォントを指定
                      ): Integer;
var
	Dlg      : TForm;
	i        : Integer;
	strMax   : String;
	lstLine  : TStringList;
	intWidth : Integer;
	intHight : Integer;
	intBtn   : Integer;
	intTemp  : Integer;
begin
	// メッセージダイアログ作成
	Dlg := CreateMessageDialog(Msg, DlgType, Buttons);
	try

    //---------------------
    // メッセージ
    //---------------------
    // フォントを指定
    if MsgFont <> nil then begin
  		TLabel(Dlg.FindComponent('message')).Font := MsgFont;
    end;

	lstLine := TStringList.Create;
	try
		// メッセージの各行数の最大文字数を取得
		lstLine.Text := Msg;
		strMax := '';
		for i := 0 to lstLine.Count - 1 do begin
			if Length(strMax) < Length(lstLine.Strings[i]) then begin
				strMax := lstLine.Strings[i];
			end;
		end;

		// メッセージの幅と高さを設定
		intWidth := TLabel(Dlg.FindComponent('message')).Canvas.TextWidth(strMax);
		intHight := TLabel(Dlg.FindComponent('message')).Canvas.TextHeight(strMax);
		TLabel(Dlg.FindComponent('message')).Width  := intWidth;
		TLabel(Dlg.FindComponent('message')).Height := intHight * lstLine.Count;
	finally
		lstLine.Free;
	end;

    //---------------------
    // ダイアログの幅
    //---------------------
    Dlg.Width := intWidth + 80; // 調整

    //--------------------------
    // ボタンの位置調整
    // 今回は2つまで
    // またボタンのフォントは固定なので
    // 以下で調整する
    //--------------------------
    // ボタンの数を数える(ボタンの配置のため)
    intBtn := 0;
    for i := 0 to Dlg.ComponentCount - 1 do begin
      if (Dlg.Components[i] is TButton) then
        begin
        Inc(intBtn);
      end;
    end;

    intTemp := 0;
    for i := 0 to Dlg.ComponentCount - 1 do begin
      if (Dlg.Components[i] is TButton) then
      begin
        // ボタンサイズ
        TButton(Dlg.Components[i]).Font.Size := 12;
        TButton(Dlg.Components[i]).Height    := TButton(Dlg.Components[i]).Height + 10;
        TButton(Dlg.Components[i]).Width     := TButton(Dlg.Components[i]).Width + 10;

        // 表示位置
        TButton(Dlg.Components[i]).Top := TLabel(Dlg.FindComponent('message')).Top +
                                          TLabel(Dlg.FindComponent('message')).Height + 15;

        // 左位置の調整
        if intBtn = 1 then begin
          // 一個の場合
          TButton(Dlg.Components[i]).Left := Trunc(Dlg.Width/2) - Trunc(TButton(Dlg.Components[i]).Width/2);
        end else
        if intBtn = 2 then begin
          // 二個の場合
          if intTemp = 0 then begin
            // 一個目
            TButton(Dlg.Components[i]).Left := Trunc(Dlg.Width/2) - TButton(Dlg.Components[i]).Width - 10;
          end else begin
            // 二個目
            TButton(Dlg.Components[i]).Left := Trunc(Dlg.Width/2) + 10;
          end;
        end;
        Inc(intTemp);

        // ダイアログの高さを調整する
        Dlg.Height := TButton(Dlg.Components[i]).top +
                      TButton(Dlg.Components[i]).Height + 40;
      end;
    end;

    // ダイアログの位置調整(センターに表示)
    Dlg.Position := poScreenCenter;

		// メッセージは常に最前列
		Dlg.FormStyle := fsStayOnTop;
		// メッセージ表示
		Result        := Dlg.ShowModal;

	finally
      if Dlg <> nil then begin
      	FreeAndNil(Dlg);
      end;
	end;
end;

使い方は「MessageDlg」と基本は同じですが、最後の引数にTFontを指定します。

procedure TForm1.Button1Click(Sender: TObject);
var
  fnt : TFont;
  rtn : Integer;  // メッセージの戻り値
begin

  fnt := TFont.Create;
  try
    // メッセージのフォント
    fnt.Size  := 20;
    fnt.Name  := 'メイリオ';
    fnt.Style := [fsBold, fsItalic];

    // オリジナルのメッセージ
    rtn := MessageDlgEx('これはオリジナルのメッセージダイアログです。'+#13#10+
                        'フォントはメイリオです。',
                        mtWarning, [mbOK, mbCancel], 0, fnt);

    // 戻り値判定
    if rtn = mrCancel then begin
      ShowMessage('キャンセルされました');
    end;

  finally
    fnt.Free;
  end;

end;

20100413_del01-thumb-300x80-64

WinVista, 7でも同じようなウィンドウになります。

また、今回の「MessageDlgEx」は完璧ではなく、
・ボタンのフォントの指定
・ボタンの数を3つ以上に対応
など課題はありますが、カスタマイズして使用してみてください。