» Delphi » Windows システム » システムメニューフォントを取得するとおかしいDelphi Forum | Borland / Inprise / CodeGear / Embarcadero Delphi や C++Builder に関する情報交換の場です。ハンドル名で投稿できます。

ゲスト
ようこそゲストさん。このフォーラムに投稿するには登録が必要です。ユーザ名: パスワード: ログイン情報を保存

Forum » Delphi » Windows システム » システムメニューフォントを取得するとおかしい

ページ: [1]

	トピック: システムメニューフォントを取得するとおかしい

DEKO

管理者
投稿数: 2691

システムメニューフォントを取得するとおかしい
on: 2013/04/06 10:03 Sat

Delphi で TActionManager を使うと、メニューにも TActionMainMenuBar を使いたくなるのが心情。でも、ActionMainMenuBar には初期値で通常のメニューのフォント (システムメニューフォント) はセットされていない。ぶっちゃけ、

// システムメニューフォントを ActionMainMenuBar に適用
ActionMainMenuBar1.Font.Assign(Screen.MenuFont);

　
ってやれば終わりな話なのだが、"引越しをすると古い雑誌を読んでしまう" のに似た衝動に駆られてしまい、古いソースではどうやっていたのか引っ張り出して眺めてみた。

var
  NONCLIENTMETRICS: TNonClientMetrics;
begin
  // システムメニューフォントを ActionMainMenuBar に適用
  NONCLIENTMETRICS.cbSize := SizeOf(NONCLIENTMETRICS);
  SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @NONCLIENTMETRICS, 0);
  ActionMainMenuBar1.Font.Name := NONCLIENTMETRICS.lfMenuFont.lfFaceName;
  ActionMainMenuBar1.Font.Size := -MulDiv(NONCLIENTMETRICS.lfMenuFont.lfHeight, 72, Screen.PixelsPerInch);
end;

　
API すか…(´ー`)y-~~ ま、勉強になっていいよね…等と思いながら、このソースを Delphi 2010 に貼り付けてコンパイル…当然の事ながら普通に動く (Vista)。ふと見ると傍らに Virual PC が起動しており、XP が動いていた。戯れに XP で動かしてみた…ら？

「なんじゃこのフォントわぁ！！」

明らかにメニューのフォントがおかしい。ShowMessage() を挟んで NONCLIENTMETRICS.lfMenuFont.lfFaceName を確認してみると文字化けしている。「ん？バッファはクリアしとかなきゃいけなかったっけ？」と思い、ZeroMemory() を追加した。

  // システムメニューフォントを ActionMainMenuBar に適用
  NONCLIENTMETRICS.cbSize := SizeOf(NONCLIENTMETRICS);
  ZeroMemory(@NONCLIENTMETRICS.lfMenuFont.lfFaceName, SizeOf(NonClientMetrics.lfMenuFont.lfFaceName));
  SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @NONCLIENTMETRICS, 0);
  ActionMainMenuBar1.Font.Name := NONCLIENTMETRICS.lfMenuFont.lfFaceName;
  ActionMainMenuBar1.Font.Size := -MulDiv(NONCLIENTMETRICS.lfMenuFont.lfHeight, 72, Screen.PixelsPerInch);

　
それでも状況は好転しない。以前はこれで動いていたのに…？そして四苦八苦しているうちにこういう記事を見つけた。

[例えば構造体にひとつ要素を追加すると，無関係な API でバグ疑惑が発生するという話 (NyaRuRuの日記)]
http://nyaruru.hatenablog.com/entry/20080303/p1

ハッとして、Delphi 2010 にある TNonClientMetrics 構造体を調べてみる。

tagNONCLIENTMETRICSW = record
    cbSize: UINT;
    iBorderWidth: Integer;
    iScrollWidth: Integer;
    iScrollHeight: Integer;
    iCaptionWidth: Integer;
    iCaptionHeight: Integer;
    lfCaptionFont: TLogFontW;
    iSmCaptionWidth: Integer;
    iSmCaptionHeight: Integer;
    lfSmCaptionFont: TLogFontW;
    iMenuWidth: Integer;
    iMenuHeight: Integer;
    lfMenuFont: TLogFontW;
    lfStatusFont: TLogFontW;
    lfMessageFont: TLogFontW;
    iPaddedBorderWidth: Integer; // Requires Windows Vista or later
    ...

　
「うぉ、iPaddedBorderWidth が最初からあるじゃねーか」ってな訳で、ソースを修正した。

  // システムメニューフォントを ActionMainMenuBar に適用
  NONCLIENTMETRICS.cbSize := SizeOf(TNonClientMetrics);
  if not SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NONCLIENTMETRICS.cbSize, @NONCLIENTMETRICS, 0) then
    begin
      NONCLIENTMETRICS.cbSize := SizeOf(TNonClientMetrics) - SizeOf(TNonClientMetrics.iPaddedBorderWidth);
      SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NONCLIENTMETRICS.cbSize, @NONCLIENTMETRICS, 0);
    end;
  ActionMainMenuBar1.Font.Name := NONCLIENTMETRICS.lfMenuFont.lfFaceName;
  ActionMainMenuBar1.Font.Size := -MulDiv(NONCLIENTMETRICS.lfMenuFont.lfHeight, 72, Screen.PixelsPerInch);

　
先のリンク先にあった記事を参考にした、"SystemParametersInfo() に失敗したら、iPaddedBorderWidth 分のサイズを引いてリトライするようにしたロジック" だ。これで Vista / XP でちゃんと動作するようになった。

…のだが、これはあまりにメンドイ。「SPI_GETNONCLIENTMETRICS やるときは自分で NONCLIENTMETRICS 構造体書いた方がいいかも…」と思って Delphi での定義をよく見てみた。そして構造体に奇妙な関数がくっついている事にやっと気が付いた。

 ...
    lfMessageFont: TLogFontW;
    iPaddedBorderWidth: Integer; // Requires Windows Vista or later
    class function SizeOf: Integer; static;
  end;

　
「あ゛ーーー！」と叫び、確認のために Screen.MenuFont の実装がどうなっているか調べた。そしてソースコードはこうなった。

  // システムメニューフォントを ActionMainMenuBar に適用
  NONCLIENTMETRICS.cbSize := TNonClientMetrics.SizeOf;
  SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NONCLIENTMETRICS.cbSize, @NONCLIENTMETRICS, 0);
  ActionMainMenuBar1.Font.Name := NONCLIENTMETRICS.lfMenuFont.lfFaceName;
  ActionMainMenuBar1.Font.Size := -MulDiv(NONCLIENTMETRICS.lfMenuFont.lfHeight, 72, Screen.PixelsPerInch);

　
案の定、TNonClientMetrics.SizeOf() は "XP 以前では構造体サイズから SizeOf(Integer) を引いたサイズを返すようになっていた"。なるホド…高度なレコード型はこういった用途にも使えるのか。今更ながら、ちょっと感心しちゃったぞ (w

TNonClientMetrics がこのような構造になっているのは、Delphi 2010 から。Delphi 2009 またはそれ以前の TNonClientMetrics には iPaddedBorderWidth メンバが存在しないので、"class function SizeOf()" も存在しない。

ページ: [1]

WP Forum Server by ForumPress | LucidCrew
バージョン: 1.7.5 ; ページロード: 0.022 sec.

ゲスト