メニューにUnicodeを表示
ウムラウトのようなUnicode文字をメニューに表示させましょうというページ。
始めに
メニューにウムラウトのようなUnicode文字を表示させるにはTListBoxにUnicodeを表示と同じような要領でやればOKですが、以下の点に注意する必要があります。
- Unicodeを表示させるためにUTF-7に変換した文字列を使うのではなくURLもどきの独自変換関数を使います。
- TMenuItemにはOnAdvancedDrawItemとOnDrawItemイベントの二種類がありますが、OnAdvancedDrawItemの方を使います。
- キャプションの描画だけでなくチェックマークやショートカットの描画も自前でやらないとなりません。
- XPの新しいテーマと旧来のクラシックテーマとでメインメニューのメニューバーの背景色が違ってしまうので対策が必要になります。
このようにメニューにUnicodeな文字列を表示させるには少し骨が折れます。
OnAdvancedDrawItemイベントが起きるようにする
メニューにUnicodeな文字を表示するにはTMenuItemのOnAdvancedDrawItemイベントが起きるようにしなければなりません。
それには二つ方法があります。
一つはTMenu(あるいはTPopupMenu)のImagesプロパティにイメージリストを割り当てる方法。
もう一つはOwnerDrawプロパティをTrueにする方法です。
OwnerDrawだけをTrueにするとチェックマークやショートカット分のスペースのない、キャプションだけの幅になります。
ImagesプロパティにImageListを割り当てた場合はチェックマークやショートカット分も含めた幅になります。
キャプションだけでなくチェックマークやショートカットも描画する必要がある場合はImagesプロパティにImageListを割り当てる必要があります。
デフォルトの描画。
OwnerDrawプロパティをTrueにしただけの描画。
ショートカットの描画がかぶってしまっています。
ImagesプロパティにImageListを割り当てただけの描画。
幅が広がっています。
ImagesプロパティにImageListを割り当て、更にOwnerDrawプロパティをTrueにした場合の描画。
ImagesプロパティにImageListを割り当てただけのときと同じになります。
メインメニューのメニューバーのメニュー項目(「ファイル(F)」や「編集(E)」など)は、ImagesプロパティにImageListを割り当てただけではOnDrawItemやOnAdvancedDrawItemイベントは起きず、OwnerDrawプロパティもTrueにしないといけません。
独自変換関数を使う
Unicodeを表示するのにListBoxではUTF-7を利用しましたがメニューではURLもどきの独自変換関数を使います。
UTF-7を利用しようとするとメニューデザイナでMenuItemのCaptionプロパティに文字列をセットするときにUTF-7に変換した文字列をセットしないといけなくなります。
例えば「ファイル」は「+MNUwoTCkMOs-」、「編集」なら「+feiWxg-」をセットしないといけないということです。
正直面倒くさくてやってられません。
URLもどきの独自変換関数ならUnicodeでしか表せない文字だけを特殊な書き方にしているのでShift_JISな文字列はそのままでOKです。
また、Unicodeな文字を"$+4桁のUnicodeのコード番号"で表すので文字コード表からコード番号を拾って記述することでUnicodeな文字を(比較的簡単に)埋め込むこともできます。
//--- WideString⇔AnsiString
//WideStringとAnsiStringの可逆変換関数
const
l_csDEFAULT_CHAR = #1;
l_csPREFIX_CHAR = '$';
function gfnsWideToAnsiEx(
const sWSrc:
WideString): AnsiString;
{
WideString→AnsiString
WideStringをAnsiStringに変換
キャストするだけやWideCharToString関数と違ってウムラウトなどのUnicode文字を%+16進に変換して返す
http://yokohama.cool.ne.jp/chokuto/urawaza/api/WideCharToMultiByte.html
0x00000400 (WC_NO_BEST_FIT_CHARS)
Windows 2000/XP： 直接マルチバイト文字に変換できない文字をデフォルトキャラクタに置きかえます。
}
var
i, li_Pos, li_Len: Integer;
lb_Bool: LongBool;
ls_PStr: PAnsiChar;
begin
Result := '';
if (sWSrc <> '')
then begin
li_Len := WideCharToMultiByte(CP_ACP, $400, PWideChar(sWSrc),
-1,
nil, 0, l_csDEFAULT_CHAR, @lb_Bool);
if (lb_Bool = False)
and (Pos(l_csPREFIX_CHAR, sWSrc) = 0)
then begin
//ウムラウトのようなUnicode文字がなくプリフィクス文字($)もない場合は変換する必要なし
//$は2バイト文字の第一バイトにも第二バイトにも現れないのでPosでよい
Result := sWSrc;
end else begin
ls_PStr := AllocMem(li_Len + 1);
try
li_Len := WideCharToMultiByte(CP_ACP, $400,
PWideChar(sWSrc), -1, ls_PStr, li_Len, l_csDEFAULT_CHAR,
nil);
if (li_Len > 0)
then begin
Dec(li_Len);
i := 0;
//ls_PStr のインデックス
li_Pos := 1;
//sWSrc のインデックス
repeat
if (ls_PStr[i] = l_csDEFAULT_CHAR)
or (ls_PStr[i] = l_csPREFIX_CHAR)
then begin
//デフォルトキャラクタとプリフィクスキャラクタは $xxxx の書式に変換
Result := Result + l_csPREFIX_CHAR
+ Format('%0.4x', [Ord(sWSrc[li_Pos])]);
end else begin
Result := Result + ls_PStr[i];
end;
if (IsDBCSLeadByte(Byte(ls_PStr[i])))
then begin
//2バイト文字の先頭バイトなのでもう1バイトスキップ
Result := Result + ls_PStr[i + 1];
Inc(i, 2);
end else begin
Inc(i);
end;
Inc(li_Pos);
until (i >= li_Len);
//untilは条件がTrueで終了
end;
finally
FreeMem(ls_PStr);
end;
end;
end;
end;
function gfnsAnsiToWideEx(
const sSrc: AnsiString):
WideString;
//gfnsWideToAnsiExの逆
//2010-06-06:プリフィクス文字を % から $ に変更。
//2008-05-30:速度向上のため書き換え。200倍くらい速くなった…
var
li_Pos, li_Len: Integer;
ls_WStr, ls_WCnv:
WideString;
begin
Result := '';
if (sSrc <> '')
then begin
ls_WStr :=
WideString(sSrc);
li_Pos := Pos(l_csPREFIX_CHAR, ls_WStr);
if (li_Pos = 0)
then begin
//2008-02-12:プリフィクス文字($)がなければ変換する必要はない
Result := ls_WStr;
end else begin
li_Len := Length(ls_WStr);
repeat
//'$'までの文字列を足しこむ
Result := Result + Copy(ls_WStr, 1, li_Pos - 1);
try
//'$'に続く(はずの)4文字の数値をUnicode文字に変換
ls_WCnv :=
WideString(WideChar(StrToInt(Copy(ls_WStr, li_Pos, 5))));
Result := Result + ls_WCnv;
ls_WStr := Copy(ls_WStr, li_Pos +4 +1, li_Len);
//4文字の数値の次からコピー開始
except
//イレギュラー
Result := Result +
WideString(l_csPREFIX_CHAR);
//イレギュラー時はそのままにする
ls_WStr := Copy(ls_WStr, li_Pos +1, li_Len);
//'$'の次からコピー開始
end;
//次の'$'までの位置を取得
li_Pos := Pos(l_csPREFIX_CHAR, ls_WStr);
Application.ProcessMessages;
until (li_Pos = 0);
//untilは条件がTrueで終了
Result := Result + ls_WStr;
end;
end;
end;
CaptionプロパティにUnicodeな文字を埋め込む例。
$00FF は ÿ に変換されて表示されます。
procedure TForm1.MenuItem1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
ACanvas.Brush.Color := clMenu;
ACanvas.Font.Color := clMenuText;
//塗りつぶし
ACanvas.FillRect(ARect);
//キャプション描画
DrawTextW(ACanvas.Handle, PWideChar(
gfnsAnsiToWideEx(TMenuItem(Sender).Caption)), -1, ARect, DT_SINGLELINE
or DT_VCENTER);
end;
ウムラウトのようなUnicode文字「ÿ」がちゃんと表示されています。
メニューでUnicodeを表示するにはOnAdvancedDrawItemとOnDrawItemの二つのイベントがありますが、そのうちのOnAdvancedDrawItemの方を使います。
OnDrawItemの方がいくらか簡単なのですがメインメニューのホットトラッキングをシミュレートしたりチェック状態を判定するためにはOnAdvancedDrawItemの方を使う必要があります。
チェックマークを自前で用意する
チェックマークは自前で用意しないといけません。
そのためにまずチェックマークのビットマップのリソースを作ります。
//mymenu.rc
MENU_CHECK BITMAP "menu_check.bmp"
MENU_CHECKMASK BITMAP "menu_check_mask.bmp"
MENU_RADIO BITMAP "menu_radio.bmp"
MENU_RADIOMASK BITMAP "menu_radio_mask.bmp"
このmymenu.rcを一度プロジェクトに追加してコンパイルします。
mymenu.resができあがったらプロジェクトからmymenu.rcを削除します。
mymenu.res
チェック menu_check.bmp
チェックのマスク menu_check_mask.bmp
ラジオ menu_radio.bmp
ラジオのマスク menu_radio_mask.bmp
program Project1;
{$R 'mymenu.res' 'mymenu.rc'} //リソースファイルができた後は削除あるいはコメントアウト。
uses
Forms,
main in 'main.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
メニューアイテムがチェック状態かどうかは引数のStateにodCheckedが含まれているかで判断します。
チェックがラジオかどうかはメニューアイテムのRadioItemプロパティで判断します。
//チェックマークのリソース
{$R mymenu.res}
//XPテーマが有効かどうか
function IsThemeActive: BOOL; stdcall; external 'uxtheme.dll';
メインメニューのメニューバーの背景色はXPスタイルとクラシックスタイルとで違っています。
XPスタイルかどうかはIsThemeActive APIで取得できますがDelphi 6では宣言されていないので自分で宣言して使います。
多分Windows 2000以前ではIsThemeActive APIは実装されていないと思うので、その場合はIsThemeActive APIを動的リンクにして対応する必要があります。
procedure MenuBarAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
State: TOwnerDrawState);
//メインメニューのメニューバー用
begin
with ACanvas do begin
if (odSelected in State)
or (odHotLight in State)
then begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end else begin
//背景色
Brush.Color := clMenu; //クラシックスタイルの背景色
if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin
if ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) //XP
or ( Win32MajorVersion > 5)
//Vista以上
then begin
if (IsThemeActive) then begin
//XPスタイルの背景色
Brush.Color := clMenuBar;
end;
end;
end;
//文字色
if (odGrayed in State)
or (odDisabled in State)
then begin
Font.Color := clGrayText;
end else begin
Font.Color := clMenuText;
end;
end;
FillRect(ARect);
DrawTextW(Handle, PWideChar(gfnsAnsiToWideEx(TMenuItem(Sender).Caption)),
-1, ARect, DT_SINGLELINE or DT_VCENTER or DT_CENTER);
end;
end;
procedure MenuItemAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
State: TOwnerDrawState);
const
lci_MARGIN = 2;
lci_CHECKWIDTH = 16;
lci_CHECKHEIGHT = 16;
var
l_MenuItem: TMenuItem;
l_Bitmap, l_Check: TBitmap;
li_Width, li_Height, li_Top, li_Left: Integer;
lrc_Rect: TRect;
begin
l_MenuItem := TMenuItem(Sender);
if (l_MenuItem.GetParentMenu is TMainMenu)
and (l_MenuItem.Parent = l_MenuItem.GetParentMenu.Items)
then begin
//メインメニューのメニューバー
MenuBarAdvancedDrawItem(Sender, ACanvas, ARect, State);
Exit;
end;
if (odSelected in State)
or (odHotLight in State) //ホットトラッキング
then begin
ACanvas.Brush.Color := clHighlight;
ACanvas.Font.Color := clHighlightText;
end else begin
ACanvas.Brush.Color := clMenu;
if (odGrayed in State)
or (odDisabled in State)
then begin
//選択不可
ACanvas.Font.Color := clGrayText;
end else begin
ACanvas.Font.Color := clMenuText;
end;
end;
//塗りつぶす
ACanvas.FillRect(ARect);
//チェックマーク描画
li_Height := ARect.Bottom - ARect.Top;
li_Width := li_Height;
lrc_Rect := Rect(ARect.Left, ARect.Top, ARect.Left + li_Width, ARect.Bottom);
if (odChecked in State) then begin
l_Check := TBitmap.Create;
try
l_Check.Width := lci_CHECKWIDTH;
l_Check.Height := lci_CHECKHEIGHT;
l_Bitmap := TBitmap.Create;
try
l_Bitmap.Width := l_Check.Width;
l_Bitmap.Height := l_Check.Height;
l_Bitmap.Canvas.Brush.Color := ACanvas.Font.Color;
l_Bitmap.Canvas.FillRect(Rect(0, 0, l_Bitmap.Width,
l_Bitmap.Height));
if (l_MenuItem.RadioItem) then begin
l_Check.Handle := LoadBitmap(HInstance,
PChar('MENU_RADIOMASK'));
end else begin
l_Check.Handle := LoadBitmap(HInstance,
PChar('MENU_CheckMask'));
end;
BitBlt(l_Bitmap.Canvas.Handle, 0, 0, l_Bitmap.Width,
l_Bitmap.Height, l_Check.Canvas.Handle, 0, 0, SRCAND);
if (l_MenuItem.RadioItem) then begin
l_Check.Handle := LoadBitmap(HInstance,
PChar('MENU_RADIO'));
end else begin
l_Check.Handle := LoadBitmap(HInstance,
PChar('MENU_CHECK'));
end;
li_Left := lrc_Rect.Left + (li_Width - l_Bitmap.Width) div 2;
li_Top := lrc_Rect.Top + (li_Height
- l_Bitmap.Height) div 2;
BitBlt(ACanvas.Handle, li_Left, li_Top, l_Bitmap.Width,
l_Bitmap.Height, l_Check.Canvas.Handle, 0, 0, SRCAND);
BitBlt(ACanvas.Handle, li_Left, li_Top, l_Bitmap.Width,
l_Bitmap.Height, l_Bitmap.Canvas.Handle, 0, 0, SRCPAINT);
finally
l_Bitmap.Free;
end;
finally
l_Check.Free;
end;
end;
if (l_MenuItem.Default) then begin
//デフォルト
ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];
end;
lrc_Rect.Left := lrc_Rect.Left + li_Width;
lrc_Rect.Right := ARect.Right;
Inc(lrc_Rect.Left, lci_MARGIN);
//キャプション描画
DrawTextW(ACanvas.Handle, PWideChar(gfnsAnsiToWideEx(l_MenuItem.Caption)),
-1, lrc_Rect, DT_SINGLELINE or DT_VCENTER);
if (l_MenuItem.ShortCut <> 0) then begin
//ショートカット描画
Dec(lrc_Rect.Right, GetSystemMetrics(SM_CXMENUCHECK));
SetBkMode(ACanvas.Handle, TRANSPARENT);
DrawTextW(ACanvas.Handle, PWideChar(WideString(ShortCutToText(l_MenuItem.ShortCut))), -1, lrc_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_RIGHT or DT_VCENTER);
end;
end;
このMenuItemAdvancedDrawItemをTMenuItemのOnAdvancedDrawItemイベントに割り当てて使います。
ユニットにまとめてみた
これらの処理をユニットにまとめてみました。
unit mymenu;
interface
uses
Windows,
Classes,
Menus,
Graphics;
procedure MenuItemAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
implementation
uses
Forms,
SysUtils;
{$R mymenu.res}
//XPテーマが有効かどうか
function IsThemeActive: BOOL;
stdcall;
external 'uxtheme.dll';
//------------------------------------------------------------------------------
//WideStringとAnsiStringの可逆変換関数
const
l_csDEFAULT_CHAR = #1;
l_csPREFIX_CHAR = '$';
function gfnsWideToAnsiEx(
const sWSrc:
WideString): AnsiString;
{
WideString→AnsiString
WideStringをAnsiStringに変換
キャストするだけやWideCharToString関数と違ってウムラウトなどのUnicode文字を%+16進に変換して返す
http://yokohama.cool.ne.jp/chokuto/urawaza/api/WideCharToMultiByte.html
0x00000400 (WC_NO_BEST_FIT_CHARS)
Windows 2000/XP： 直接マルチバイト文字に変換できない文字をデフォルトキャラクタに置きかえます。
}
var
i, li_Pos, li_Len: Integer;
lb_Bool: LongBool;
ls_PStr: PAnsiChar;
begin
Result := '';
if (sWSrc <> '')
then begin
li_Len := WideCharToMultiByte(CP_ACP, $400, PWideChar(sWSrc), -1,
nil, 0, l_csDEFAULT_CHAR, @lb_Bool);
if (lb_Bool = False)
and (Pos(l_csPREFIX_CHAR, sWSrc) = 0)
then begin
//ウムラウトのようなUnicode文字がなくプリフィクス文字($)もない場合は変換する必要なし
//$は2バイト文字の第一バイトにも第二バイトにも現れないのでPosでよい
Result := sWSrc;
end else begin
ls_PStr := AllocMem(li_Len + 1);
try
li_Len := WideCharToMultiByte(CP_ACP, $400, PWideChar(sWSrc), -1, ls_PStr, li_Len, l_csDEFAULT_CHAR,
nil);
if (li_Len > 0)
then begin
Dec(li_Len);
i := 0;
//ls_PStr のインデックス
li_Pos := 1;
//sWSrc のインデックス
repeat
if (ls_PStr[i] = l_csDEFAULT_CHAR)
or (ls_PStr[i] = l_csPREFIX_CHAR)
then begin
//デフォルトキャラクタとプリフィクスキャラクタは $xxxx の書式に変換
Result := Result + l_csPREFIX_CHAR + Format('%0.4x', [Ord(sWSrc[li_Pos])]);
end else begin
Result := Result + ls_PStr[i];
end;
if (IsDBCSLeadByte(Byte(ls_PStr[i])))
then begin
//2バイト文字の先頭バイトなのでもう1バイトスキップ
Result := Result + ls_PStr[i + 1];
Inc(i, 2);
end else begin
Inc(i);
end;
Inc(li_Pos);
until (i >= li_Len);
//untilは条件がTrueで終了
end;
finally
FreeMem(ls_PStr);
end;
end;
end;
end;
function gfnsAnsiToWideEx(
const sSrc: AnsiString):
WideString;
//gfnsWideToAnsiExの逆
//2010-06-06:プリフィクス文字を % から $ に変更。
//2008-05-30:速度向上のため書き換え。200倍くらい速くなった…
var
li_Pos, li_Len: Integer;
ls_WStr, ls_WCnv:
WideString;
begin
Result := '';
if (sSrc <> '')
then begin
ls_WStr :=
WideString(sSrc);
li_Pos := Pos(l_csPREFIX_CHAR, ls_WStr);
if (li_Pos = 0)
then begin
//2008-02-12:プリフィクス文字($)がなければ変換する必要はない
Result := ls_WStr;
end else begin
li_Len := Length(ls_WStr);
repeat
//'$'までの文字列を足しこむ
Result := Result + Copy(ls_WStr, 1, li_Pos - 1);
try
//'$'に続く(はずの)4文字の数値をUnicode文字に変換
ls_WCnv :=
WideString(WideChar(StrToInt(Copy(ls_WStr, li_Pos, 5))));
Result := Result + ls_WCnv;
ls_WStr := Copy(ls_WStr, li_Pos +4 +1, li_Len);
//4文字の数値の次からコピー開始
except
//イレギュラー
Result := Result +
WideString(l_csPREFIX_CHAR);
//イレギュラー時はそのままにする
ls_WStr := Copy(ls_WStr, li_Pos +1, li_Len);
//'$'の次からコピー開始
end;
//次の'$'までの位置を取得
li_Pos := Pos(l_csPREFIX_CHAR, ls_WStr);
Application.ProcessMessages;
until (li_Pos = 0);
//untilは条件がTrueで終了
Result := Result + ls_WStr;
end;
end;
end;
procedure MenuBarAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
//メインメニューのメニューバー用
begin
with ACanvas
do begin
if (odSelected
in State)
or (odHotLight
in State)
then begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end else begin
//背景色
Brush.Color := clMenu;
//クラシックスタイルの背景色
if (Win32Platform = VER_PLATFORM_WIN32_NT)
then begin
if ((Win32MajorVersion = 5)
and (Win32MinorVersion >= 1))
//XP
or ( Win32MajorVersion > 5)
//Vista以上
then begin
if (IsThemeActive)
then begin
//XPスタイルの背景色
Brush.Color := clMenuBar;
end;
end;
end;
//文字色
if (odGrayed
in State)
or (odDisabled
in State)
then begin
Font.Color := clGrayText;
end else begin
Font.Color := clMenuText;
end;
end;
FillRect(ARect);
DrawTextW(Handle, PWideChar(gfnsAnsiToWideEx(TMenuItem(Sender).Caption)), -1, ARect, DT_SINGLELINE
or DT_VCENTER
or DT_CENTER);
end;
end;
procedure MenuItemAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
const
lci_MARGIN = 2;
lci_CHECKWIDTH = 16;
lci_CHECKHEIGHT = 16;
var
l_MenuItem: TMenuItem;
l_Bitmap, l_Check: TBitmap;
li_Width, li_Height, li_Top, li_Left: Integer;
lrc_Rect: TRect;
begin
l_MenuItem := TMenuItem(Sender);
if (l_MenuItem.GetParentMenu
is TMainMenu)
and (l_MenuItem.Parent = l_MenuItem.GetParentMenu.Items)
then begin
//メインメニューのメニューバー
MenuBarAdvancedDrawItem(Sender, ACanvas, ARect, State);
Exit;
end;
if (odSelected
in State)
or (odHotLight
in State)
//ホットトラッキング
then begin
ACanvas.Brush.Color := clHighlight;
ACanvas.Font.Color := clHighlightText;
end else begin
ACanvas.Brush.Color := clMenu;
if (odGrayed
in State)
or (odDisabled
in State)
then begin
//選択不可
ACanvas.Font.Color := clGrayText;
end else begin
ACanvas.Font.Color := clMenuText;
end;
end;
//塗りつぶす
ACanvas.FillRect(ARect);
//チェックマーク描画
li_Height := ARect.Bottom - ARect.Top;
li_Width := li_Height;
lrc_Rect := Rect(ARect.Left, ARect.Top, ARect.Left + li_Width, ARect.Bottom);
if (odChecked
in State)
then begin
l_Check := TBitmap.Create;
try
l_Check.Width := lci_CHECKWIDTH;
l_Check.Height := lci_CHECKHEIGHT;
l_Bitmap := TBitmap.Create;
try
l_Bitmap.Width := l_Check.Width;
l_Bitmap.Height := l_Check.Height;
l_Bitmap.Canvas.Brush.Color := ACanvas.Font.Color;
l_Bitmap.Canvas.FillRect(Rect(0, 0, l_Bitmap.Width, l_Bitmap.Height));
if (l_MenuItem.RadioItem)
then begin
l_Check.Handle := LoadBitmap(HInstance, PChar('MENU_RADIOMASK'));
end else begin
l_Check.Handle := LoadBitmap(HInstance, PChar('MENU_CheckMask'));
end;
BitBlt(l_Bitmap.Canvas.Handle, 0, 0, l_Bitmap.Width, l_Bitmap.Height, l_Check.Canvas.Handle, 0, 0, SRCAND);
if (l_MenuItem.RadioItem)
then begin
l_Check.Handle := LoadBitmap(HInstance, PChar('MENU_RADIO'));
end else begin
l_Check.Handle := LoadBitmap(HInstance, PChar('MENU_CHECK'));
end;
li_Left := lrc_Rect.Left + (li_Width - l_Bitmap.Width)
div 2;
li_Top := lrc_Rect.Top + (li_Height - l_Bitmap.Height)
div 2;
BitBlt(ACanvas.Handle, li_Left, li_Top, l_Bitmap.Width, l_Bitmap.Height, l_Check.Canvas.Handle, 0, 0, SRCAND);
BitBlt(ACanvas.Handle, li_Left, li_Top, l_Bitmap.Width, l_Bitmap.Height, l_Bitmap.Canvas.Handle, 0, 0, SRCPAINT);
finally
l_Bitmap.Free;
end;
finally
l_Check.Free;
end;
end;
if (l_MenuItem.
Default)
then begin
//デフォルト
ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];
end;
lrc_Rect.Left := lrc_Rect.Left + li_Width;
lrc_Rect.Right := ARect.Right;
Inc(lrc_Rect.Left, lci_MARGIN);
//キャプション描画
DrawTextW(ACanvas.Handle, PWideChar(gfnsAnsiToWideEx(l_MenuItem.Caption)), -1, lrc_Rect, DT_SINGLELINE
or DT_VCENTER);
if (l_MenuItem.ShortCut <> 0)
then begin
//ショートカット描画
Dec(lrc_Rect.Right, GetSystemMetrics(SM_CXMENUCHECK));
SetBkMode(ACanvas.Handle, TRANSPARENT);
DrawTextW(ACanvas.Handle, PWideChar(
WideString(ShortCutToText(l_MenuItem.ShortCut))), -1, lrc_Rect, DT_SINGLELINE
or DT_NOPREFIX
or DT_RIGHT
or DT_VCENTER);
end;
end;
//幅の計算
function gfniRectWidth(rtRect: TRect): Integer;
//rtRectの幅を返す
begin
with rtRect
do
begin
Result := Right - Left;
end;
end;
procedure MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
//Unicodeなメニューの幅を計算して修正する
procedure _CalcRect(AMenuItem: TMenuItem; ACanvas: TCanvas; sCaption: WideString;
var ARect: TRect; iFormat: UINT);
begin
if not(AMenuItem.Enabled)
then
begin
OffsetRect(ARect, 1, 1);
DrawTextW(ACanvas.Handle, PWideChar(sCaption), -1,
ARect, iFormat);
OffsetRect(ARect, -1, -1);
end;
DrawTextW(ACanvas.Handle, PWideChar(sCaption), -1, ARect,
iFormat);
end;
var
l_MenuItem : TMenuItem;
ls_Text : AnsiString;
li_Format : UINT;
l_Menu : TMenu;
l_AnsiRect : TRect;
l_WideRect : TRect;
begin
if not(Sender
is TMenuItem)
then
begin
Exit;
end;
l_MenuItem := TMenuItem(Sender);
if (l_MenuItem.IsLine)
then
begin
Exit;
end;
ls_Text := l_MenuItem.Caption;
if (l_MenuItem.ShortCut <> 0)
then
begin
ls_Text := ls_Text + ShortCutToText(l_MenuItem.ShortCut);
end;
if (ls_Text = '')
or ((ls_Text[1] = cHotkeyPrefix)
and (ls_Text[2] = #0))
then
begin
ls_Text := ls_Text + ' ';
end;
l_Menu := l_MenuItem.GetParentMenu;
li_Format := DT_LEFT;
if (l_Menu
is TPopupMenu)
then
begin
case TPopupMenu(l_Menu).Alignment
of
paCenter : li_Format := DT_CENTER;
paRight : li_Format := DT_RIGHT;
end;
end;
if (l_Menu <>
nil)
and (l_Menu.IsRightToLeft)
then
begin
if ((li_Format
and DT_LEFT) = DT_LEFT)
then
begin
li_Format := li_Format
and (not DT_LEFT)
or DT_RIGHT;
end else
if ((li_Format
and DT_RIGHT) = DT_RIGHT)
then
begin
li_Format := li_Format
and (
not DT_RIGHT)
or DT_LEFT;
end;
li_Format := li_Format
or DT_RTLREADING;
end;
li_Format := li_Format
or DT_EXPANDTABS
or DT_SINGLELINE
or DT_NOCLIP
or DT_CALCRECT;
if (l_MenuItem.Default)
then
begin
ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];
end;
FillChar(l_AnsiRect, SizeOf(l_AnsiRect), 0);
_CalcRect(l_MenuItem, ACanvas, ls_Text, l_AnsiRect, li_Format);
FillChar(l_WideRect, SizeOf(l_WideRect), 0);
_CalcRect(l_MenuItem, ACanvas, gfnsAnsiToWideEx(ls_Text), l_WideRect, li_Format);
Width := Width - (
gfniRectWidth(l_AnsiRect) -
gfniRectWidth(l_WideRect));
end;
end.
フォームからは以下のようにして呼び出すことである程度の汎用化ができます。
procedure TForm1.N1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
begin
mymenu.MenuItemAdvancedDrawItem(Sender, ACanvas, ARect, State);
end;
幅の計算
メニューにUnicodeな文字が表示できるようになったのは良いのですが、このままだとUnicodeな文字があるとメニューの幅が異様に拡がってしまうことがあります。
滅多にないこととは思いますが、メニューのCaptionがすべてUnicodeな文字であったりサロゲートペアなUnicodeな文字があったりすると顕著になります。
それというのも独自関数では1文字のUnicdeな文字を5文字のAnsiStringな文字に変換するためで、上記の例で言うとUnicodeなCaptionは「Queensrÿche」ですがAnsiStringなキャプションは「Queensr$00FFche」です。
そしてメニューの幅の計算はAnsiStringなキャプションを元にされます。
ということでこの問題を解決するためにはOnMeasureItemイベントでUnicodeな文字の幅とAnsiStringな文字の幅の差を求めてメニューの幅から引くということをします。
function gfniRectWidth(rtRect: TRect): Integer;
//rtRectの幅を返す
begin
with rtRect
do
begin
Result := Right - Left;
end;
end;
procedure MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure _CalcRect(AMenuItem: TMenuItem; ACanvas: TCanvas; sCaption: WideString;
var ARect: TRect; iFormat: UINT);
begin
if not(AMenuItem.Enabled)
then
begin
OffsetRect(ARect, 1, 1);
DrawTextW(ACanvas.Handle, PWideChar(sCaption), -1,
ARect, iFormat);
OffsetRect(ARect, -1, -1);
end;
DrawTextW(ACanvas.Handle, PWideChar(sCaption), -1, ARect,
iFormat);
end;
var
l_MenuItem : TMenuItem;
ls_Text : AnsiString;
li_Format : UINT;
l_Menu : TMenu;
l_AnsiRect : TRect;
l_WideRect : TRect;
begin
if not(Sender
is TMenuItem)
then
begin
Exit;
end;
l_MenuItem := TMenuItem(Sender);
if (l_MenuItem.IsLine)
then
begin
Exit;
end;
ls_Text := l_MenuItem.Caption;
if (l_MenuItem.ShortCut <> 0)
then
begin
ls_Text := ls_Text + ShortCutToText(l_MenuItem.ShortCut);
end;
if (ls_Text = '')
or ((ls_Text[1] = cHotkeyPrefix)
and (ls_Text[2] = #0))
then
begin
ls_Text := ls_Text + ' ';
end;
l_Menu := l_MenuItem.GetParentMenu;
li_Format := DT_LEFT;
if (l_Menu
is TPopupMenu)
then
begin
case TPopupMenu(l_Menu).Alignment
of
paCenter : li_Format := DT_CENTER;
paRight : li_Format := DT_RIGHT;
end;
end;
if (l_Menu <>
nil)
and (l_Menu.IsRightToLeft)
then
begin
if ((li_Format
and DT_LEFT) = DT_LEFT)
then
begin
li_Format := li_Format
and (not DT_LEFT)
or DT_RIGHT;
end else
if ((li_Format
and DT_RIGHT) = DT_RIGHT)
then
begin
li_Format := li_Format
and (
not DT_RIGHT)
or DT_LEFT;
end;
li_Format := li_Format
or DT_RTLREADING;
end;
li_Format := li_Format
or DT_EXPANDTABS
or DT_SINGLELINE
or DT_NOCLIP
or DT_CALCRECT;
if (l_MenuItem.Default)
then
begin
ACanvas.Font.Style := ACanvas.Font.Style + [fsBold];
end;
FillChar(l_AnsiRect, SizeOf(l_AnsiRect), 0);
_CalcRect(l_MenuItem, ACanvas, ls_Text, l_AnsiRect, li_Format);
FillChar(l_WideRect, SizeOf(l_WideRect), 0);
_CalcRect(l_MenuItem, ACanvas, gfnsAnsiToWideEx(ls_Text), l_WideRect, li_Format);
Width := Width - (
gfniRectWidth(l_AnsiRect) -
gfniRectWidth(l_WideRect));
end;
DelphiのMenu.pasのソースコードをコピーして必要な部分だけを残して削ったコードなので、正直何をやっているのか良く分かっていません。
中ほどのli_Formatの値を算出している部分は多分右から左へ文字を表示するようなもの(アラビア語など)向けなのではないかと思われます。
この部分で重要なのはli_FormatにDT_CALCRECTが指定されているという点です。
この値を指定することでDrawTextWは実際にCanvasに文字を出力するのではなく、出力するのに必要な大きさをRectにセットしてくれるようになります。
そこでAnsiStringな文字で必要な大きさをl_AnsiRectにセットし、Unicodeな文字で必要な大きさをl_WideRectにセットします。
そしてその幅の差をMeasureItemイベントのWidthから引きます。
これでOKです。
ちなみにUnicodeな文字の幅をそのままWidthに代入しないのは、メニューの幅を計算するにはメニューアイコンの大きさやショートカット文字列の幅なども含んでいるからです。
そのあたりは自前でやらずとも独自変換したキャプションの変換前の幅とUnicodeな文字に変換した後の差を引くことでOKなので省略しています。
このルーチンを先のmymenu.pasに加えます。
フォームからは以下のようにして呼び出すことである程度の汎用化ができます。
procedure TForm1.N1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
mymenu.MenuItem_MeasureItem(Sender, ACanvas, Width, Height);
end;
2011-11-19:幅の計算を追加。
チェック menu_check.bmp
チェックのマスク menu_check_mask.bmp
ラジオ menu_radio.bmp
ラジオのマスク menu_radio_mask.bmp