前の章へ
| 総目次へ
| 次の章へ 
｜Windows アプリケーションを使ったことがあるなら、フォントとは何であるか説明の必要はないであろう｡ 厳密な定義はここでは論じない｡ Windows アプリケーションにおける ＧＵＩの重要性からみてもフォントについての章を割くのは妥当だろう｡ これまで、多くのコントロールをカプセル化したクラスを作ってきたがフォントについては完全に無視してきた｡ ボタンのキャプションやリストボックスやエディットに表示される文字列は、デバイスコンテキストのデフォルトのフォントである、SYSTEM_FONT を使ってきた｡ 正確に言うと SYSTEM_FONT はフォントの名前ではなく､ GetStockObject( ) ＡＰＩでデフォルトのフォントハンドルを取得するときに指定する定義済みの定数（= 13)である｡
文字列を表示するあらゆる場面でフォントを指定することが出来る｡ フォントを指定するには､ フォントハンドルを取得して、これを SelectObject( ) ＡＰＩをつかってデバイスコンテキストに選択すればよい｡ このように、フォントは ペンやブラシ、ビットマップなどと同じ Win32 のオブジェクトである。この章では､ いかにしてフォントハンドルを取得し、それをどのようにして利用するのかを探求する｡
| 第１５章 フォントの研究 その１ |
| １５−１ フォントハンドルと論理フォント |
| １５−２ 「フォントの選択」ダイアログ |
| １５−３ ChooseFont( ) 関数のカプセル化 |
| １５−４ フォントの列挙と検索 |
| １５−５ TLogFont レコード |
| １５−６ フォントビューワプログラム |
前の章へ
| 総目次へ
| 次の章へ ｜フォントは、ペンやブラシと同じように「フォントハンドル」を指定して SelectObject( ) ＡＰＩを使ってデバイスコンテキストに選択できる｡ 問題は、フォントハンドルをいかにして取得するかということだ。フォントハンドルを返すＡＰＩとして以下の二つがある｡
function CreateFont(nHeight,
nWidth,
nEscapement,
nOrientaion,
fnWeight: Integer;
fdwItalic,
fdwUnderline,
fdwStrikeOut,
fdwCharSet,
fdwOutputPrecision,
fdwClipPrecision,
fdwQuality,
fdwPitchAndFamily: DWORD;
lpszFace: PChar): HFONT; stdcall;
function CreateFontIndirect(const p1: TLogFont): HFONT; stdcall;CreateFont( ) は１４個ものパラメータを持つのに対し､ CreateFontIndirect( ) のそれは TLogFont 型のレコードを一つ持つだけだ｡ しかし、その定義を見れば、この二つの関数はまったく同じものであることが分かるだろう｡
type
TLogFontA = packed record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
end;
TLogFont = TLogFontATLogFontの１４個フィールドを完全に指定すれば、フォントハンドルが得られる。つまり、TLogFont レコードは、フォントの全ての属性を完全に表していると考えられ、「論理フォント」と呼ばれている｡ 正確にいえば、TLogFont 型のレコードを指定して、CreateFontIndirect( ) ＡＰＩで取得したフォントハンドルが代表している論理上のフォントが論理フォントである｡ TLogFont 型レコードで指定した内容と実際にハンドルとして取得できる論理フォントの間には、フォントマッパによるマッチング操作が介在するので、TLogFont 型レコードは論理フォントを指定するデータ構造の一つであるにすぎない｡ しかし、フォントマッパの存在は、間接的にしろ TLogFont 型レコードと論理フォントの間に強い相関関係をつくることは確かだ。ここでは正確さを犠牲にして、TLogFont 型のレコードの構築を「論理フォント」の構築と同一視する事にしよう｡ したがって、フォントを指定するするためには、いかにして論理フォントを構築するのかが分かればよい｡ 具体的には､ 例えば、「ＭＳ 明朝」の１８ポイントの赤い文字列をイタリックで表示するには TLogFont の各フィールドをどのように指定したらよいのか、という問題である｡
先述したように、デバイスコンテキストのデフォルトのフォントのハンドルは､ GetStockObject( ) ＡＰＩに SYSTEM_FONT を指定すると得ることが出来る｡ フォントハンドルが手に入ったら、それを使ってフォントに関する情報を TLogFont 型レコードとして知ることが出来る｡ これは、上に示した CreateFontIndirect( ) ＡＰＩとは逆の操作である｡ 具体的には、GetObject( ) ＡＰＩを使うことになる｡ ここでは、システムのストックフォントに対応する TLogFont 型レコードを取得して、その各フィールドの値を表示するプログラムを作ろう｡
以下に SystemFont.dpr の全リストを示す。
program SystemFont;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
LB1,LB2: TAPIListBox;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure DisplayLogFont(lf: TLogFont; LB: TAPIListBox);
var
s: string;
begin
LB.Clear;
LB.AddString(' FontName :'#9+ string(lf.lfFaceName));
LB.AddString(' Height :'#9+ AIntToStr(lf.lfHeight));
LB.AddString(' Width : '#9+ AIntToStr(lf.lfWidth));
LB.AddString(' Escapement :'#9+ AIntToStr(lf.lfEscapement));
LB.AddString(' Orientation :'#9+ AIntToStr(lf.lfOrientation));
case lf.lfWeight of
0: s := 'DONTCARE';
100: s := 'THIN';
200: s := 'EXTRALIGHT';
300: s := 'LIGHT';
400: s := 'NORMAL';
500: s := 'MEDIUM';
600: s := 'SEMIBOLD';
700: s := 'BOLD';
800: s := 'EXTRABOLD';
900: s := 'HEAVY';
else
s := AIntToStr(lf.lfWeight);
end;
LB.AddString(' Weight :'#9+s);
if lf.lfItalic = 0 then s := 'No' else s := 'Yes';
LB.AddString(' Italic : '#9+ s);
if lf.lfUnderline = 0 then s := 'No' else s := 'Yes';
LB.AddString(' Underline : '#9+ s);
if lf.lfStrikeOut = 0 then s := 'No' else s := 'Yes';
LB.AddString(' StrikeOut : '#9+ s);
case lf.lfCharSet of
0: s := 'ANSI_CHARSET';
1: s := 'DEFAULT_CHARSET';
2: s := 'SYMBOL_CHARSET';
128: s := 'SHIFTJIS_CHARSET';
255: s := 'OEM_CHARSET';
161: s := 'GREEK_CHARSET';
else
s := AIntToStr(lf.lfCharSet);
end;
LB.AddString(' CharSet : '#9+ s);
case lf.lfOutPrecision of
0: s := 'OUT_DEFAULT_PRECIS';
1: s := 'OUT_STRING_PRECIS';
2: s := 'OUT_CHARACTER_PRECIS';
3: s := 'OUT_STROKE_PRECIS';
4: s := 'OUT_TT_PRECIS';
5: s := 'OUT_DEVICE_PRECIS';
6: s := 'OUT_RASTER_PRECIS';
7: s := 'OUT_TT_ONLY_PRECIS';
8: s := 'OUT_OUTLINE_PRECIS';
9: s := 'OUT_SCREEN_OUTLINE_PRECIS';
else
s := AIntToStr(lf.lfOutPrecision);
end;
LB.AddString(' OutPrecision : '#9+ s);
case lf.lfClipPrecision of
0: s := 'CLIP_DEFAULT_PRECIS';
1: s := 'CLIP_CHARACTER_PRECIS';
2: s := 'CLIP_STROKE_PRECIS';
else
s := AIntToStr(lf.lfClipPrecision);
end;
LB.AddString(' ClipPrecision : '#9+ s);
case lf.lfQuality of
0: s := 'DEFAULT_QUALITY';
1: s := 'DRAFT_QUALITY';
2: s := 'PROOF_QUALITY';
3: s := 'NONANTIALIASED_QUALITY';
4: s := 'ANTIALIASED_QUALITY';
else
s := AIntToStr(lf.lfQuality);
end;
LB.AddString(' Quality : '#9+ s);
case (lf.lfPitchAndFamily and $F) of
0: s := 'DEFAULT_PITCH';
1: s := 'FIXED_PITCH';
2: s := 'VARIABLE_PITCH';
8: s := 'MONO_FONT';
else
s := AIntToStr(lf.lfPitchAndFamily and $F);
end;
LB.AddString(' Pitch : '#9+ s);
case (lf.lfPitchAndFamily shr 4) of
0: s := 'FF_DONTCARE';
1: s := 'FF_ROMAN';
2: s := 'FF_SWISS';
3: s := 'FF_MODERN';
4: s := 'FF_SCRIPT';
5: s := 'FF_DECORATIVE';
else
s := AIntToStr(lf.lfPitchAndFamily shr 4);
end;
LB.AddString(' Family : '#9+ s);
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB2SelChange(var Msg: TMessage);
var
hF: HFONT;
LF: TLogFont;
begin
if LB2.SelIndex = 5 then begin
LB1.Clear;
LB1.AddString('Not Available');
Exit;
end;
hf := GetStockObject(LB2.SelIndex+10);
GetObject(hF,SizeOf(LF),@LF);
DisplayLogFont(LF,LB1);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
LB1 := CreateListbox(hWindow,10,10,300,300,nil);
LB2 := CreateListbox(hWindow,320,10,180,180,LB2SelChange);
with LB2 do begin
AddString('OEM_FIXED_FONT');
AddString('ANSI_FIXED_FONT');
AddString('ANSI_VAR_FONT');
AddString('SYSTEM_FONT');
AddString('DEVICE_DEFAULT_FONT');
AddString(' ');
AddString('SYSTEM_FIXED_FONT');
AddString('DEFAULT_GUI_FONT');
end;
with MainWnd do begin
ClientWidth := 520;
ClientHeight := 320;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
MessageBeep($FFFFFFFF);
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TSDIMainWindow.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.
SystemFont.zip(17.915kB)
以上で完成である｡ 実行すると右側のリストボックスにフォントに関連するストックオブジェクトのリストが表示される。各項目をマウスで選択すると対応するフォントの TLogFont 型レコードの情報が左側のリストボックスに表示される｡ このときのイメージは右図のようになる｡
LB2SelChange( ) ハンドラでは、最初に、GetStockObject( ) ＡＰＩでデフォルトフォントのハンドルを取得している｡
function GetStockObject(Index: Integer): HGDIOBJ; stdcall;
この関数に指定できるパラメータは、windows.pas に以下のように定義されている。
{ Stock Logical Objects }
WHITE_BRUSH = 0;
LTGRAY_BRUSH = 1;
GRAY_BRUSH = 2;
DKGRAY_BRUSH = 3;
BLACK_BRUSH = 4;
NULL_BRUSH = 5;
HOLLOW_BRUSH = NULL_BRUSH;
WHITE_PEN = 6;
BLACK_PEN = 7;
NULL_PEN = 8;
OEM_FIXED_FONT = 10;
ANSI_FIXED_FONT = 11;
ANSI_VAR_FONT = 12;
SYSTEM_FONT = 13;
DEVICE_DEFAULT_FONT = 14;
DEFAULT_PALETTE = 15;
SYSTEM_FIXED_FONT = $10;
DEFAULT_GUI_FONT = 17;
STOCK_LAST = 17;フォントに関連するのは､ 10 から 17 までで 15 を除く部分である｡ フォントハンドルを使って、GetObject( ) により、論理フォントの情報を取得する。
function GetObject(p1: HGDIOBJ;
p2: Integer;
p3: Pointer): Integer; stdcall;p1 には、ペン、ブラシ、フォント、ビットマップなどのＧＤＩオブジェクトのハンドルを指定する｡ p3 には、論理ペン、論理ブラシ、論理フォント、ビットマップレコード（TBitmap）のアドレスを指定し､ p2 には p3 に指定したレコードのサイズを指定する｡ ここでは、p1 には、直前に取得したフォントハンドル、p3 には TLogFont レコードのローカル変数のアドレス、p2 にはそのサイズを指定する｡ この関数により、p3 で指定した TLogFont 型レコードを取得できる｡ 次に、ヘルパ関数 DisplayLogFont( ) 手続きにより、 TLogFont 型レコードの各フィールドの値をリストボックスに表示する｡ DisplayLogFont( ) 手続きのコードを見ると、 TLogFont 型レコードの各フィールドの意味が理解できるだろう｡ 各ストックフォントに対応する実際のフォント名は、ＯＳのバージョンによって異なる可能性がある｡ 筆者の環境では、OEM_FIXED_FONT は Terminal、ANSI_FIXED_FONT は Courier、ANSI_VAR_FONT は MS Sans Serif、SYSTEM_FONT は System、DEVICE_DEFAULT_FONT はなし、SYSTEM_FIXED_FONT は FixedSys、DEFAULT_GUI_FONT は ＭＳ Ｐゴシック となっている｡
ＯＳは TLogFont 型レコードで指定された属性に最も近いフォントをインストールされているフォントに対応させるフォントマッパを持っている｡ システムにインストールされているフォントは、ユーザーの環境によって異なっているのが普通である｡ ワープロなどのアプリケーションをインストールすると、自動的に幾つかのフォントがインストールされる。したがって、プログラマは、ユーザーの環境にどのようなフォントがインストールされているのか、予め知ることはできない。ＯＳには、デフォルトで幾つかのフォントがインストールされていることが期待できるが､ ユーザーの選択をそのフォントだけに限定することはできない。したがって、その時点でインストールされているフォントを列挙し、そこからユーザーが選択し、その結果から論理フォントを構築できればよい｡ ＶＣＬを使ったＲＡＤ環境では､ オブジェクトインスペクタをつかってフォントを指定できる｡ このような機能を、ＡＰＩを使って実現するには、二つの方法が考えられる｡ 最初の方法では､コモンダイアログの一つである「フォントの選択ダイアログ」を利用する。もう一つの方法では、EnumFontFamilies( ) ＡＰＩを使って、システムにインストールされているフォントに関する情報を獲得し、それから TLogFont 型レコードを構築して論理フォントを取得する｡
次の三つの節で、それぞれの方法を実験してみよう｡ この中で TLogFont の各フィールドの意味は、徐々に明らかになるだろう｡
ＶＣＬのコンポーネントパレットの Dialogs ページの TFontDialog は、Win32 の ChooseFont( ) 関数をカプセル化したものだ。この関数を実行すると表示されるダイアログは、多くのアプリケーションで使われているので､ いままでに何度か目にしたことはあるだろう。この関数は、CommDlg.pas に定義されている｡
function ChooseFont(var ChooseFont: TChooseFont): Bool; stdcall;
この関数のパラメータは TChooseFont 型のレコードを変数渡しするだけだ｡
type
TChooseFontA = packed record
lStructSize: DWORD; { このレコードのサイズ }
hWndOwner: HWnd; { 呼び出し側ウィンドウのハンドル }
hDC: HDC; { プリンタの DC/IC または nil }
lpLogFont: PLogFontA; { TLogFont へのポインタ }
iPointSize: Integer; { 選択されたフォントのサイズ: 1/10 ポイント単位 }
Flags: DWORD; { 初期化フラグ }
rgbColors: COLORREF; { テキストカラー }
lCustData: LPARAM; { フック関数へのデータ }
lpfnHook: function(Wnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
{ フック関数のアドレス }
lpTemplateName: PAnsiChar; { テンプレートの名前 }
hInstance: HINST; { テンプレートを含む実行プロセスのインスタンスハンドル }
lpszStyle: PAnsiChar; { スタイルデータのバッファへのポインタ }
nFontType: Word; { フォントのタイプ }
wReserved: Word;
nSizeMin: Integer; { 選択できるフォントサイズの最小ポイント数 }
nSizeMax: Integer; { 選択できるフォントサイズの最大ポイント数 }
end;
TChooseFont = TChooseFontA;このレコードが多数のフィールドを持っているのは、カスタマイズできるような柔軟性を備えているためだ。テンプレートやフック関数を使わない「普通」の使いかたでは、多くのフィールドはゼロか nil の指定で済ますことができる｡ Flags フィールドには、以下のものを組み合わせて指定できる｡
const
CF_SCREENFONTS = $00000001;
CF_PRINTERFONTS = $00000002;
CF_BOTH = CF_SCREENFONTS OR CF_PRINTERFONTS;
CF_SHOWHELP = $00000004;
CF_ENABLEHOOK = $00000008;
CF_ENABLETEMPLATE = $00000010;
CF_ENABLETEMPLATEHANDLE = $00000020;
CF_INITTOLOGFONTSTRUCT = $00000040;
CF_USESTYLE = $00000080;
CF_EFFECTS = $00000100;
CF_APPLY = $00000200;
CF_ANSIONLY = $00000400;
CF_SCRIPTSONLY = CF_ANSIONLY;
CF_NOVECTORFONTS = $00000800;
CF_NOOEMFONTS = CF_NOVECTORFONTS;
CF_NOSIMULATIONS = $00001000;
CF_LIMITSIZE = $00002000;
CF_FIXEDPITCHONLY = $00004000;
CF_WYSIWYG = $00008000; { must also have CF_SCREENFONTS & CF_PRINTERFONTS }
CF_FORCEFONTEXIST = $00010000;
CF_SCALABLEONLY = $00020000;
CF_TTONLY = $00040000;
CF_NOFACESEL = $00080000;
CF_NOSTYLESEL = $00100000;
CF_NOSIZESEL = $00200000;
CF_SELECTSCRIPT = $00400000;
CF_NOSCRIPTSEL = $00800000;
CF_NOVERTFONTS = $01000000;既に有効なフォントが指定されていて､ このダイアログを表示して別のフォントを選択する場合は、CF_INITTOLOGFONTSTRUCT フラグを指定し､ 既存の論理フォントを lpLogFont フィールドに指定すると、ダイアログを開いたときの初期選択フォントとして表示される｡ 取り消し線、下線、色の指定を有効にするには、CF_EFFECTS を指定する｡ このとき、rgbColors フィールドの指定と論理フォントの lfUnderline とlfStrikeOut フィールドを使ってダイアログが初期化される｡ CF_LIMITSIZE を指定すると､ nSizeMin と nSizeMax を設定することで、ユーザーが選択できるフォントサイズの範囲を指定できる｡ CF_TTONLY を指定すると TrueType フォントのみが選択対象となる｡ 他のフラグの意味については、ヘルプを参照してほしい｡ ChooseFont( ) 関数は、フォントを選択して OK ボタンが押されると、true を返し､ それ以外は false を返す｡
ここまでの知識で、とにかく ChooseFont( ) を使ってみることにしよう｡ TChooseFont のフィールドの数がいかに多くても､ 普通の使い方はそんなに複雑ではないことが分かるだろう｡
以下に、ChooseFont01.dpr の全リストを示す｡
program ChooseFont01;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas',
CommDlg;
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
LB1: TAPIListBox;
lf: TLogFont;
tc: COLORREF;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure DisplayLogFont(lf: TLogFont; LB: TAPIListBox);
var
s: string;
begin
{ 前節で示したコードと同じなので省略 }
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
LB1 := CreateListBox(hWindow,10,70,300,300,nil);
with MainWnd do begin
ClientWidth := 320;
ClientHeight := 380;
Center;
end;
end;
procedure MainPaint(var Msg: TMessage);
var
hF, HOldF: HFONT;
OldColor: COLORREF;
ps: TPaintStruct;
begin
BeginPaint(Mainwnd.Handle,ps);
if lf.lfFaceName[0]<>#0 then begin
hF := CreateFontIndirect(lf);
hOldF := SelectObject(ps.hdc,hF);
OldColor := SetTextColor(ps.hdc,tc);
if lf.lfCharSet = SHIFTJIS_CHARSET then
TextOut(ps.hdc, 10, 10, ' サンプルてきすと出力 ',22)
else
TextOut(ps.hdc, 10, 10, ' Sample Text Output. ',21);
SelectObject(ps.hdc,hOldF);
SetTextColor(ps.hdc,OldColor);
DeleteObject(hF);
end;
EndPaint(MainWnd.Handle,ps);
end;
procedure OnTest(hWindow: HWND);
var
cf: TChooseFont;
begin
FillChar(cf,SizeOf(cf),0);
with cf do begin
lStructSize := SizeOf(cf);
hWndOwner := hWindow;
lpLogFont := @lf;
Flags := CF_BOTH or CF_EFFECTS;
rgbColors := tc;
if lf.lfFaceName[0]<>#0 then Flags := Flags or CF_INITTOLOGFONTSTRUCT;
end;
if ChooseFont(cf) then begin
InvalidateRect(hWindow,nil,true);
tc := cf.rgbColors;
DisplayLogFont(lf,LB1);
InvalidateRect(hWindow,nil,true);
end;
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TSDIMainWindow.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
Trap(WM_PAINT,MainPaint);
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.ChooseFont01.zip(18.317kB)
まず、TChooseFont 型のローカル変数 cf の全フィールドを FillChar( ) を使ってゼロに初期化する｡ 次に、最低必要な cf の フィールド変数を設定している｡ lStructSize、hWndOwner、lpLogFont、Flags の設定は必須である｡ 普通の使い方では、このコード例どおりで十分だろう｡ rgbColors の指定はオプションであるが、グローバル変数でテキストの色を表す tc を指定しておく。最初に ChooseFont( ) を実行するときは､ グローバル変数 lf は有効な「論理フォント」ではないので CF_INITTOLOGFONTSTRUCT フラグは指定しない。２回目以降は、このフラグを指定して､ グローバル変数である TLogFont 型レコード lf と テキストの色 tc でダイアログを初期化することができる｡ ChooseFont( ) が true を返すと、ユーザーが選択したフォントの情報が lf と rgbColors フィールドに設定されている｡ DisplayFont( ) で lf の情報を表示したあと、InvalidateRect( ) ＡＰＩで WM_PAINT メッセージをウィンドウ関数に送ってサンプルテキストを表示する｡ MainPaint( ) ハンドラは、 TLogFont 型レコードの使って論理フォントを取得し、それを実際に使用する方法を示している｡
procedure MainPaint(var Msg: TMessage);
var
hF, HOldF: HFONT;
OldColor: COLORREF;
ps: TPaintStruct;
begin
BeginPaint(Mainwnd.Handle,ps);
if lf.lfFaceName[0]<>#0 then begin
hF := CreateFontIndirect(lf);
hOldF := SelectObject(ps.hdc,hF);
OldColor := SetTextColor(ps.hdc,tc);
if lf.lfCharSet = SHIFTJIS_CHARSET then
TextOut(ps.hdc, 10, 10, ' サンプルてきすと出力 ',22)
else
TextOut(ps.hdc, 10, 10, ' Sample Text Output. ',21);
SelectObject(ps.hdc,hOldF);
SetTextColor(ps.hdc,OldColor);
DeleteObject(hF);
end;
EndPaint(MainWnd.Handle,ps);
end;最初の if 文は lf の有効性をテストしている｡ 有効なときは処理を続行する｡ まず、TLogFont 型のグローバル変数 lf を使って、CreateFontIndirect( ) によりフォントハンドルを取得している｡ これをデバイスコンテキストに選択し、さらに､ SetTextColor( ) に tc を指定してテキストの色を設定する｡ 日本語フォントか欧文フォントかを判断して、TextOut( ) ＡＰＩにより、サンプルテキストを出力している｡ 最後に､ フォントとテキスト色をもとに戻してから、作成したフォントを廃棄している｡
ここでは、ChooseFont( ) 関数から得られた TLogFont 型レコード lf をそのまま CreateFontIndirect( ) に指定して、フォントハンドルを取得しているが､ CreateFontIndirect( ) を実行する前に､ lf の各フィールドをコードで指定し直して、カスタマイズする事もできる｡ 例えば、ユーザーの設定に関わらず、必ずイタリックで表示されるようにするには､ lf.lfItalic := 1 とすればよい｡
以上のプログラム例からも分かるように、ChooseFont( ) を使うための TChooseFont 型のレコードの指定は、普通につかうためには４つないし５つのフィールドを指定するだけで十分である｡ この関数から戻される TLogFont 型のレコードとテキスト色を取得できれば、対応するフォントを使用してテキストを表示することは簡単である｡
前節で作ったプログラムでは、Test! メニューを選択すると、ChooseFont( ) 関数を呼び出していた。このコードを再掲する。
procedure OnTest(hWindow: HWND);
var
cf: TChooseFont;
begin
FillChar(cf,SizeOf(cf),0);
with cf do begin
lStructSize := SizeOf(cf);
hWndOwner := hWindow;
lpLogFont := @lf;
Flags := CF_BOTH or CF_EFFECTS;
rgbColors := tc;
if lf.lfFaceName[0]<>#0 then Flags := Flags or CF_INITTOLOGFONTSTRUCT;
end;
if ChooseFont(cf) then begin
InvalidateRect(hWindow,nil,true);
tc := cf.rgbColors;
DisplayLogFont(lf,LB1);
InvalidateRect(hWindow,nil,true);
end;
end;このコードを見ると、ChooseFont( ) を呼び出すためには、hWndOwner、lpLogFont、Flags 、rgbColors を指定できれば良いことが分かる｡ これらをパラメータとして、ChooseFont( ) をカプセル化した関数 DoChooseFont( ) を UtilFunc.pas に作ることにしよう。そして、それをテストするプログラムをつくる。これは、ChooseFont01.dpr を少しだけコードを変えたものだ｡
まず、UtilFunc.pas に DoChooseFont( ) 関数を実装しよう｡ このユニットの uses 節に CommDlg を追加する｡ 次に、--- Utility Functions --- のところの一番下に以下の宣言を追加する｡
function DoChooseFont(hOwner: HWND;var ALogFont: TLogFont; Flag: DWORD;
var Color: COLORREF): Boolean;実装部の対応するところに以下のコードを書く。
function DoChooseFont(hOwner: HWND;var ALogFont: TLogFont; Flag: DWORD;
var Color: COLORREF): Boolean;
var
cf: TChooseFont;
begin
FillChar(cf,SizeOf(cf),0);
with cf do begin
lStructSize := SizeOf(cf);
hWndOwner := hOwner;
lpLogFont := @ALogFont;
if Flag = 0 then
Flags := CF_BOTH or CF_EFFECTS
else
Flags := Flag;
rgbColors := Color;
if ALogFont.lfFaceName[0]<>#0 then Flags := Flags or CF_INITTOLOGFONTSTRUCT;
end;
if ChooseFont(cf) then begin
result := true;
Color := cf.rgbColors;
end else result := false;
end;これで DoChooseFont( ) 関数の実装は完了である｡ これをテストするために ChooseFont02.dpr のコードを少し修正する。最初に､ uses 節から CommDlg を削除する。次に、OnTest( ) ハンドラを以下のようにする。
procedure OnTest(hWindow: HWND);
begin
if DoChooseFont(hWindow,lf,0,tc) then begin
DisplayLogFont(lf,LB1);
InvalidateRect(hWindow,nil,true);
end;
end;ChooseFont02.zip(18.392kB)
これで完成だ｡ 実行すると ChooseFont01 と全く同じ動作をする｡ OnTest( ) ハンドラでは、DoChooseFont( ) 関数を呼び出しているが、前節のプログラムで行ったナマの ChooseFont( ) ＡＰＩを使うより、かなり簡単化されたのが分かるだろう｡ DoChooseFont( ) 関数は、ChooseFont( ) ＡＰＩをカプセル化したものだ。柔軟さを犠牲にしてパラメータを少なくしたので、簡単に使える｡ この関数は成功すると true を返す｡ TLogFont 型のレコードとテキスト色は、変数渡しで関数から設定される｡ Flag にゼロを指定すると、CF_BOTH or CF_EFFECTS が設定され､ ゼロ以外ではその値が設定される。従って、TrueType フォントだけを選択する場合は CF_BOTH or CF_EFFECTS or CF_TTONLY を Flag に設定することになる。その場合は、これらの定数が定義されている CommDlg.pas を uses 節に加えなければならない。
システムにインストールされているフォントを列挙したり、名前を指定して検索したりするために EnumFontFamilies( ) というＡＰＩが用意されている｡
function EnumFontFamilies(DC: HDC;
p2: PChar;
p3: TFNFontEnumProc;
p4: LPARAM): BOOL; stdcall;DC パラメータには、取得するフォントに関連するデバイスコンテキストのハンドルを指定する。 p2 には、'ＭＳ 明朝' などの検索するフォントの名前の文字列を指定する｡ 列挙するときは、nil を指定する｡ p3 には、フォントが見つかったときにシステムから呼ばれるコールバック関数のアドレスを指定する。p4 には、コールバック関数に渡される任意の３２ビットデータを指定する。コールバック関数の書式は以下のとおり｡
function EnumFontProc(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;第一パラメータの型 PEnumLogFont の定義は、
PEnumLogFontA = ^TEnumLogFontA;
PEnumLogFont = PEnumLogFontA;
TEnumLogFontA = packed record
elfLogFont: TLogFontA;
elfFullName: array[0..LF_FULLFACESIZE - 1] of AnsiChar;
elfStyle: array[0..LF_FACESIZE - 1] of AnsiChar;
end;である｡ このレコードの第一フィールドが TLogFont 型レコードに相当する。elfFullName は完全なフォント名、elfStyle は 'Bold' などのフォントスタイルが入った文字列が設定されている｡ コールバック関数の第二パラメータ lpntm には、検索されたフォントが TrueType フォントならフォントの物理的な情報を格納した TNewTextMetric 型レコードへのポインタが格納されている｡ それ以外のフォントの場合は、TTextMetic レコードへのポインタが格納されている。第三パラメータ nFontType には、以下のうちの幾つかが組み合わさって格納されている｡
{ EnumFonts Masks }
RASTER_FONTTYPE = 1;
DEVICE_FONTTYPE = 2;
TRUETYPE_FONTTYPE = 4;コールバック関数の最後のパラメータは、EnumFontFamilies( ) の第四パラメータで指定した、任意の３２ビットデータである｡ コールバック関数は、ゼロを戻すと終了する。したがって、一般にはゼロ以外を戻り値にする｡
ここまでの知識をつかって、インストールされているフォントを列挙し、対応する論理フォントの情報を表示するプログラムを作ろう｡
以下に EnumFonts.dpr の全リストを示す｡
program EnumFonts;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
LB1,LB2: TAPIListBox;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure DisplayLogFont(lf: TLogFont; LB: TAPIListBox);
var
s: string;
begin
{ ここのコードは既に示したので省略 }
end;
function EnumFontProc(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;
begin
result := 1;
if (nFontType and TRUETYPE_FONTTYPE)<>0 then
TAPIListBox(lParam).AddString(string(lpelf^.elfLogFont.lfFaceName));
end;
function FindFontProc(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;
begin
PLogFont(lParam)^ := lpelf^.elfLogFont;
Result := 1;
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg: TMessage);
var
DC: HDC;
lf: TLogFont;
begin
DC := GetDC(MainWnd.Handle);
EnumFontFamilies(DC,PChar(LB1.SelText),@FindFontProc,integer(@lf));
ReleaseDC(MainWnd.Handle,DC);
DisplayLogFont(lf,LB2);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
DC: HDC;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
LB1 := CreateListBox(hWindow,10,10,200,300,LB1SelChange);
DC := GetDC(hWindow);
EnumFontFamilies(DC, nil, @EnumFontProc,integer(LB1));
ReleaseDC(hWindow, DC);
LB2 := CreateListBox(hWindow,220,10,300,300,nil);
with MainWnd do begin
ClientWidth := 540;
ClientHeight := 320;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
MessageBeep($FFFFFFFF);
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TSDIMainWindow.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.EnumFonts.zip(18.299kB)
これで完成だ。コンパイルして実行すると､ インストールされている TrueType フォントの名前のリストが左側のリストボックスに表示される｡ どれかの名前をクリックすると、対応する論理フォントの情報が右側のリストボックスに表示される｡ この様子を右図に示す。
コードを調べよう｡ MainCreate( ) ハンドラでリストボックスオブジェクト LB1 を生成したあとのコードは､
DC := GetDC(hWindow);
EnumFontFamilies(DC, nil, @EnumFontProc,integer(LB1));
ReleaseDC(hWindow, DC);となっている｡ EnumFontFamilies( ) ＡＰＩの第一パラメータには、メインウィンドウのデバイスコンテキストを指定している｡ 第二パラメータが nil なので、この呼び出しはフォントの列挙である｡ 第四パラメータには、LB1 のオブジェクト参照を integer にキャストして渡している｡ コールバック関数を見てみよう｡
function EnumFontProc(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;
begin
result := 1;
if (nFontType and TRUETYPE_FONTTYPE)<>0 then
TAPIListBox(lParam).AddString(string(lpelf^.elfLogFont.lfFaceName));
end;if 文によって、検索されたフォントが TrueType であるかどうかを判断し、そうなら、lpelf の指すレコードの elfLogFont フィールドを参照して、フォントの名前を LB1 に追加する｡ if 文の一行をコメントアウトして実行すると、全てのフォントがリストに追加される｡ これにより、実行直後に LB1 にフォントのリストが表示されることになる｡ リストから、項目を選択すると LB1SelChange( ) ハンドラが呼び出される｡
procedure LB1SelChange(var Msg: TMessage);
var
DC: HDC;
lf: TLogFont;
begin
DC := GetDC(MainWnd.Handle);
EnumFontFamilies(DC,PChar(LB1.SelText),@FindFontProc,integer(@lf));
ReleaseDC(MainWnd.Handle,DC);
DisplayLogFont(lf,LB2);
end;ここでも、メインウィンドウのデバイスコンテキストを指定して EnumFontFamilies( ）ＡＰＩが呼び出されるが、第二パラメータにフォント名を指定しているので列挙ではなく検索である｡ 第四パラメータには、TLogFont 型のローカル変数のアドレスを渡している｡ コールバック関数を見てみよう｡
function FindFontProc(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;
begin
PLogFont(lParam)^ := lpelf^.elfLogFont;
Result := 1;
end;ここでは、見つかったフォントの TLogFont 型のレコードを、任意データとして渡されたアドレスにコピーしているだけだ｡ これにより、LB1SelChange( ) で「論理フォント」を取得できたので、DisplayLogFont( ) でその内容を LB2 に表示する｡
このプログラム例で EnumFontFamilies( ) ＡＰＩをつかって、フォントの列挙と検索の仕方が理解できたと思う｡ このＡＰＩで関連付けられるコールバック関数のパラメータの大部分は、利用されずに無視されている｡ テキスト表示を精密に制御するためには､ システムがコールバック関数のパラメータとして設定する、フォントの物理情報が格納されている TNewTextMetric あるいは TTextMetric 型のレコードが利用できるが、ここでは言及しない｡
ここまでで、ChooseFont( ) ＡＰＩや EnumFontFamilies( ) ＡＰＩをつかって、TLogFont 型の「論理フォント」を取得することができるようになった。 TLogFont 型レコードが手に入れば、そのうちの幾つかのフィールドをカスタマイズした後、CreateFontIndirect( ) ＡＰＩを使って、フォントハンドルつまり論理フォントを取得できる｡ ここでは、いよいよ TLogFont レコードの各フィールドの意味について調べ、どのフィールドがカスタマイズできるかを考えよう｡ 上記のＡＰＩを使って、取得した TLogFont 型レコードは実際にインストールされているフォントの情報を反映しているので､ CreateFontIndirect( ) を使ってフォントハンドルを取得するときのマッピングはかなり厳密に対応付けられるだろう｡ しかし、多くのフィールドの指定を変更すると、意図したものと異なるフォントに対応付けられる可能性もあるし、CreateFontIndirect( ) の戻り値がゼロとなって失敗することもありうる｡ どのフィールドがフォントマッピングに関して優先順位が高いかなどは、ＡＰＩのリファレンスを読んでもよく分からない｡ しかし、多くのユーザーにとって重要なのは､ フォントの名前と大きさとスタイルとウェイトだろう。場合によっては､ 表示する方向も指定できる。さっそく、TLogFont レコードの定義を以下に再掲する。
type
TLogFontA = packed record
lfHeight: Longint;
lfWidth: Longint;
lfEscapement: Longint;
lfOrientation: Longint;
lfWeight: Longint;
lfItalic: Byte;
lfUnderline: Byte;
lfStrikeOut: Byte;
lfCharSet: Byte;
lfOutPrecision: Byte;
lfClipPrecision: Byte;
lfQuality: Byte;
lfPitchAndFamily: Byte;
lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
end;
TLogFont = TLogFontA各フィールドの意味について調べていこう。
【 lfHeight 】は、作成するフォントの高さを指定する。ゼロのときは、デフォルトの高さが指定される｡ 正の値のときは、キャラクタセルの高さが指定される｡ 負の値のときは、その絶対値でキャラクタの高さが指定される｡ ポイント値で指定するときは､ 次の式で指定する｡
lfHeight := -MulDiv(PointSize,GetDeviceCaps(DC,LOGPIXELSY),72);
この式の MulDiv( ) ＡＰＩは、
function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; stdcall;
と宣言され、result := (nNumber * nNumerator) div nDenominator である。GetDeviceCaps(DC,LOGPIXELSY) は、DC で指定されるデバイスコンテキストの垂直方向の論理インチあたりのピクセル数を返す｡ 上記の式を使って、ポイント数でフォントサイズを指定するのが一番簡単である｡
【 lfWidth 】は、作成するフォントのキャラクタの平均幅を指定する｡ 普通は lfHeight フィールドに負の値を指定して、lfWidth フィールドにはゼロを指定する｡
【 lfEscapement 】は、テキストを表示する方向（ベースライン）とデバイスのＸ軸とのなす角度を1/10度を単位として指定する。例えば、下から上の方向にテキストを表示するときは 900 を指定する｡ ちょっと寄り道をして、小さなプログラムを作って、このフィールドの意味を探って見よう。 Skeleton03.dpr の OnTest( ) ハンドラを以下のように変更するだけで完成である｡
procedure OnTest(hWindow: HWND);
var
DC: HDC;
hF, hOldF: HFONT;
LF: TLogFont;
i: integer;
s: string;
begin
hF := GetStockObject(DEFAULT_GUI_FONT);
GetObject(hF,SizeOf(LF),@LF);
LF.lfHeight := -18;
LF.lfWeight := 700;
DC := GetDC(hWindow);
hOldF := SelectObject(DC,hF);
SetBkMode(DC,TRANSPARENT);
for i := 0 to 11 do begin
LF.lfEscapement := i*300;
hF := CreateFontIndirect(LF);
DeleteObject(SelectObject(DC,hF));
s := ' Test String - '+AIntToStr(i*300);
TextOut(DC,210,190,PChar(s),Length(s));
end;
SelectObject(DC,hOldF);
ReleaseDC(hWindow,DC);
DeleteObject(hF);
end;Escapement.zip(14.122kB)
このプロジェクトを 1505Escapement として保存する｡ 実行して、Test! メニューをクリックすると右図のようになる｡ このコードでは最初に GetStockObject( ) ＡＰＩに DEFAULT_GUI_FONT を指定して、フォントハンドルを取得する｡ つぎに、それを使って GetObject( ) ＡＰＩにより TLogFont 型のレコード LF を取得する｡ サイズを指定し､ （後で説明する）lfWeight フィールドに 700 を指定して、ボールドにする｡ lfEscapement フィールドを 300 （つまり３０度）ごとに指定してから、CreateFontIndirect( ) でフォントハンドルを取得し、次々に DC に選択して、テキストを出力している｡ 前にも述べたように筆者の環境では､ DEFAULT_GUI_FONT で得られるストックフォントは、「ＭＳ Ｐゴシック」である｡ もし、SYSTEM_FONT を指定して、System フォントで同様のことを実行すると、lfEscapement の値が９０度ごとに丸められて、四方向にだけ表示される｡ 読者の環境でも DEFAULT_GUI_FONT を SYSTEM_FONT に変更して試してみてほしい｡ この事実は､ 論理フォントの指定が、フォントごとに異なった方式でマッピングされることを示している｡ システムは、指定のものに出来るだけ近いフォントを作成しようとする、と期待して良いだろう｡
【 lfOrientation 】は、各キャラクタのベースラインと表示デバイスのＸ軸方向のなす角度を1/10度を単位として指定する｡ lfEscapement は文字列全体の出力方向を指定するのに対し、このフィールドでは各文字ごとの方向を指定する｡ 筆者の環境では､ lfEscapement をテストしたようなプログラムで lfOrientation をテストしてみたがどのフォントでも期待通りの結果は得られなかった｡ プリンタに対しては試していない｡
【 lfWeight 】は、作成されるフォントのウェイト、つまり、文字の太さを指定する｡ ゼロのときは、デフォルトの太さが使われる｡ このフィールドに指定できる定義済み定数が windows.pas にある。
{ Font Weights }
FW_DONTCARE = 0;
FW_THIN = 100;
FW_EXTRALIGHT = 200;
FW_LIGHT = 300;
FW_NORMAL = 400;
FW_MEDIUM = 500;
FW_SEMIBOLD = 600;
FW_BOLD = 700;
FW_EXTRABOLD = 800;
FW_HEAVY = 900;
FW_ULTRALIGHT = FW_EXTRALIGHT;
FW_REGULAR = FW_NORMAL;
FW_DEMIBOLD = FW_SEMIBOLD;
FW_ULTRABOLD = FW_EXTRABOLD;
FW_BLACK = FW_HEAVY;フォントの種類によっては、この定数の全ての指定に忠実に応答できないことがある｡ その場合でもフォントマッパは、ユーザーの指定を出来るだけ実現しようと努力し、場合によってはもとになるフォントから合成したフォントを返すこともある｡
【 lfItalic 】、【 lfUnderline 】、【 lfStrikeOut 】の各フィールドの型は Byte であるが実質的には Boolean である｡ つまり、イタリック体や下線、取消線を指定するときにはゼロ以外の値を指定する｡
ここまでのフィールドは、かなり安全にコードでカスタマイズできると考えられる｡ ChooseFont( ) ＡＰＩで表示されるダイアログで指定の変更ができるのと同じだ｡ しかし、TrueType 以外のフォントを選択すると、指定できる文字のサイズが限定されたり、スタイルが選択できなかったりすることを経験したことがあるはずだ。これは、インストールされているフォントの種類によっては、これらのフィールドに指定された値がフォントマッパによっていつも完全に反映されるとは限らないことを示している｡ また、以下のフィールドをコードで変更して、「新しいフォント」を合成する必要はほとんどないはずである｡
【 lfCharSet 】は、キャラクタセットを指定する｡ フォントの名前を指定して、EnumFontFamilies( ) ＡＰＩ で返される値を変更してはならない｡ このフィールドは､ フォントマッピングの際の重要なパラメータであると考えられる｡ 定義済みの値は、windows.pas にある｡
ANSI_CHARSET = 0; DEFAULT_CHARSET = 1; SYMBOL_CHARSET = 2; SHIFTJIS_CHARSET = $80; HANGEUL_CHARSET = 129; GB2312_CHARSET = 134; CHINESEBIG5_CHARSET = 136; OEM_CHARSET = 255; JOHAB_CHARSET = 130; HEBREW_CHARSET = 177; ARABIC_CHARSET = 178; GREEK_CHARSET = 161; TURKISH_CHARSET = 162; VIETNAMESE_CHARSET = 163; THAI_CHARSET = 222; EASTEUROPE_CHARSET = 238; RUSSIAN_CHARSET = 204; MAC_CHARSET = 77; BALTIC_CHARSET = 186;
２バイト文字をもつ日本語対応フォントの場合は、SHIFTJIS_CHARSET = $80 であることが多い｡ 一方、欧文のフォントは ANSI_CHARSET = 0 であることが多い｡
【 lfOutPrecision 】は、出力の精度を指定する｡ 定義済みの値を以下に示す｡
OUT_DEFAULT_PRECIS = 0; OUT_STRING_PRECIS = 1; OUT_CHARACTER_PRECIS = 2; OUT_STROKE_PRECIS = 3; OUT_TT_PRECIS = 4; OUT_DEVICE_PRECIS = 5; OUT_RASTER_PRECIS = 6; OUT_TT_ONLY_PRECIS = 7; OUT_OUTLINE_PRECIS = 8; OUT_SCREEN_OUTLINE_PRECIS = 9;
EnumFontFamilies( ) から返される値は､ TrueType フォントの場合は､ OUT_STROKE_PRECIS = 3 であることが多い｡ それ以外のフォントでは、OUT_STRING_PRECIS = 1 が返されることが多い｡
【 lfClipPrecision 】は、クリッピングの精度を指定する。定義済みの定数は以下の通り｡
CLIP_DEFAULT_PRECIS = 0; CLIP_CHARACTER_PRECIS = 1; CLIP_STROKE_PRECIS = 2; CLIP_MASK = 15; CLIP_LH_ANGLES = (1 shl 4); CLIP_TT_ALWAYS = (2 shl 4); CLIP_EMBEDDED = (8 shl 4);
筆者の実験では EnumFontFamilies( ) から返される値は､ ほとんどの場合 CLIP_STROKE_PRECIS = 2 であった｡ これを変更してフォントハンドルを得る実験はしていない｡
【 lfQuality 】は、出力の品質を指定する｡ 定義済みの定数を以下に示す｡
DEFAULT_QUALITY = 0; DRAFT_QUALITY = 1; PROOF_QUALITY = 2; NONANTIALIASED_QUALITY = 3; ANTIALIASED_QUALITY = 4;
EnumFontFamilies( ) から返される値は､ ほとんどの場合 DRAFT_QUALITY = 1 であった｡ より品質の高い PROOF_QUALITY = 2 に変更することができるかもしれない｡
【 lfPitchAndFamily 】は、フォントのピッチとファミリを指定する｡ このフィールドでは、EnumFontFamilies( ) から返される値を変更することは、マッピングを混乱させるだけで好ましくない｡ 定義済みの定数を以下に示す｡
DEFAULT_PITCH = 0;
FIXED_PITCH = 1;
VARIABLE_PITCH = 2;
MONO_FONT = 8;
{ Font Families }
FF_DONTCARE = (0 shl 4); { 未知または指定しない }
FF_ROMAN = (1 shl 4); { Variable stroke width, serifed. }
{ Times Roman, Century Schoolbook, etc. }
FF_SWISS = (2 shl 4); { Variable stroke width, sans-serifed. }
{ Helvetica, Swiss, etc. }
FF_MODERN = (3 shl 4); { Constant stroke width, serifed or sans-serifed. }
{ Pica, Elite, Courier, etc. }
FF_SCRIPT = (4 shl 4); { Cursive, etc. }
FF_DECORATIVE = (5 shl 4); { Old English, etc. }このフィールドの型は Byte であるが、上記の定義から分かるように１６進数表示で、下位桁の $0 から $F の領域がピッチを表し、上位桁の $00 から $F0 がファミリを表している｡ 例えば、$21 は、ファミリが FF_SWISS でピッチが FIXED_PITCH であることを示している｡
【 lfFaceName 】は、フォントの名前（タイプフェース名）を指定する｡ EnumFontFamilies( ) ではフォントの名前だけを指定して検索できたことを思い出してほしい｡ このフィールドを指定することは､ マッピングの際の最も重要なことであると考えられる｡ 名前の長さは半角対応で､
LF_FACESIZE = 32;
と定義されている｡
第４節では、EnumFontFamilies( ) ＡＰＩを使って、インストールされているフォントの名前をリストボックスに表示した。この節では､ この章のここまでのまとめとして、インストールされているフォントの名前のリストを自動的に表示するコンボボックスのクラスを作る｡ そして、その中の項目を選択すると、対応する TLogFont レコードを読みとり専用のプロパティーとして取得できるようにする。このクラスの動作をテストするプログラムとして、フォントビューワプログラムを作成する｡
まず最初に、APIControl.pas に TEnumFontComboBox クラスを作ろう。宣言部の TAPIDriveCombo の下に以下のコードを追加する｡
//---------- TEnumFontComboBox -------------------------------------------- TEnumFontComboBox = class(TAPIDDLCombo) private FFontType: integer; function GetSelLogFont: TLogFont; procedure SetFontType(value: integer); protected procedure Initialize; override; public property SelLogFont: TLogFont read GetSelLogFont; property FontType: integer read FFontType write SetFontType; end;
そして、実装部の対応する場所に実装する｡
//---------- TEnumFontComboBox --------------------------------------------
function EnumFontProcB(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;
begin
result := 1;
if TEnumFontComboBox(lParam).FontType <> 0 then
if (nFontType and TEnumFontComboBox(lParam).FontType) = 0 then exit;
TEnumFontComboBox(lParam).AddString(string(lpelf^.elfLogFont.lfFaceName));
end;
function FindFontProcB(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;
begin
PLogFont(lParam)^ := lpelf^.elfLogFont;
Result := 1;
end;
procedure TEnumFontComboBox.Initialize;
var
DC: HDC;
begin
inherited Initialize;
Clear;
DC := GetDC(Parent);
EnumFontFamilies(DC, nil, @EnumFontProcB,integer(self));
ReleaseDC(Parent,DC);
end;
function TEnumFontComboBox.GetSelLogFont: TLogFont;
var
DC: HDC;
begin
DC := GetDC(Parent);
EnumFontFamilies(DC,PChar(SelText),@FindFontProcB,integer(@result));
ReleaseDC(Parent,DC);
end;
procedure TEnumFontComboBox.SetFontType(value: integer);
var
DC: HDC;
begin
if FFontType = value then Exit;
FFontType := value;
Clear;
DC := GetDC(Parent);
EnumFontFamilies(DC, nil, @EnumFontProcB,integer(self));
ReleaseDC(Parent,DC);
end;これで完成である｡ TEnumFontComboBox クラスは TAPIDDLCombo を継承し、Initialize 手続きを override し、プロパティーを二つ追加しただけである｡ Initialize 手続きでは、親ウィンドウのデバイスコンテキストを取得して、EnumFontFamilies( ) を使って自分にフォントの名前のリストを追加する。選択されたフォント名に対応する TLogFont レコードを与える SelLogFont プロパティーの取得メソッド GetSelLogFont では、選択されたフォント名の文字列を指定して、EnumFontFamilies( ) を使って検索し TLogFont レコードを取得している｡ 列挙するフォントタイプを指定する FontType プロパティーの設定メソッド SetFontType( ) では、設定値を保存してから Initialize 手続きを呼び出して、表示リストを更新する。このプロパティーに設定できるのは、既に示した
{ EnumFonts Masks }
RASTER_FONTTYPE = 1;
DEVICE_FONTTYPE = 2;
TRUETYPE_FONTTYPE = 4;の値の組み合わせである｡ ゼロを設定すると全てのフォントが検索列挙される｡ EnumFontFamilies( ) ＡＰＩとそこで指定されるコールバック関数の使い方は､ すでに「フォントの列挙と検索」の節で説明した。ここでのコードは、前の説明で示したコードとほとんど同じなので容易に理解できるだろう｡
TEnumFontComboBox クラスを使って、インストールされているフォントに関する情報を表示するフォントビューワを作ろう｡ その前に、今後の便利のために UtilClass.pas に DisplayLogFont( ) 手続きを移してしまおう｡ GetFileAttributes( ) 関数の下に以下の宣言をする。
procedure DisplayLogFont(lf: TLogFont; SA: TStringArray);
そして実装部に以下のように実装する。
procedure DisplayLogFont(lf: TLogFont; SA: TStringArray);
var
s: string;
begin
SA.Clear;
SA.Add(' FontName :'#9+ string(lf.lfFaceName));
SA.Add(' Height :'#9+ AIntToStr(lf.lfHeight));
SA.Add(' Width : '#9+ AIntToStr(lf.lfWidth));
SA.Add(' Escapement :'#9+ AIntToStr(lf.lfEscapement));
SA.Add(' Orientation :'#9+ AIntToStr(lf.lfOrientation));
case lf.lfWeight of
0: s := 'DONTCARE';
100: s := 'THIN';
200: s := 'EXTRALIGHT';
300: s := 'LIGHT';
400: s := 'NORMAL';
500: s := 'MEDIUM';
600: s := 'SEMIBOLD';
700: s := 'BOLD';
800: s := 'EXTRABOLD';
900: s := 'HEAVY';
else
s := AIntToStr(lf.lfWeight);
end;
SA.Add(' Weight :'#9+s);
if lf.lfItalic = 0 then s := 'No' else s := 'Yes';
SA.Add(' Italic : '#9+ s);
if lf.lfUnderline = 0 then s := 'No' else s := 'Yes';
SA.Add(' Underline : '#9+ s);
if lf.lfStrikeOut = 0 then s := 'No' else s := 'Yes';
SA.Add(' StrikeOut : '#9+ s);
case lf.lfCharSet of
0: s := 'ANSI_CHARSET';
1: s := 'DEFAULT_CHARSET';
2: s := 'SYMBOL_CHARSET';
128: s := 'SHIFTJIS_CHARSET';
255: s := 'OEM_CHARSET';
161: s := 'GREEK_CHARSET';
else
s := AIntToStr(lf.lfCharSet);
end;
SA.Add(' CharSet : '#9+ s);
case lf.lfOutPrecision of
0: s := 'OUT_DEFAULT_PRECIS';
1: s := 'OUT_STRING_PRECIS';
2: s := 'OUT_CHARACTER_PRECIS';
3: s := 'OUT_STROKE_PRECIS';
4: s := 'OUT_TT_PRECIS';
5: s := 'OUT_DEVICE_PRECIS';
6: s := 'OUT_RASTER_PRECIS';
7: s := 'OUT_TT_ONLY_PRECIS';
8: s := 'OUT_OUTLINE_PRECIS';
9: s := 'OUT_SCREEN_OUTLINE_PRECIS';
else
s := AIntToStr(lf.lfOutPrecision);
end;
SA.Add(' OutPrecision : '#9+ s);
case lf.lfClipPrecision of
0: s := 'CLIP_DEFAULT_PRECIS';
1: s := 'CLIP_CHARACTER_PRECIS';
2: s := 'CLIP_STROKE_PRECIS';
else
s := AIntToStr(lf.lfClipPrecision);
end;
SA.Add(' ClipPrecision : '#9+ s);
case lf.lfQuality of
0: s := 'DEFAULT_QUALITY';
1: s := 'DRAFT_QUALITY';
2: s := 'PROOF_QUALITY';
3: s := 'NONANTIALIASED_QUALITY';
4: s := 'ANTIALIASED_QUALITY';
else
s := AIntToStr(lf.lfQuality);
end;
SA.Add(' Quality : '#9+ s);
case (lf.lfPitchAndFamily and $F) of
0: s := 'DEFAULT_PITCH';
1: s := 'FIXED_PITCH';
2: s := 'VARIABLE_PITCH';
8: s := 'MONO_FONT';
else
s := AIntToStr(lf.lfPitchAndFamily and $F);
end;
SA.Add(' Pitch : '#9+ s);
case (lf.lfPitchAndFamily shr 4) of
0: s := 'FF_DONTCARE';
1: s := 'FF_ROMAN';
2: s := 'FF_SWISS';
3: s := 'FF_MODERN';
4: s := 'FF_SCRIPT';
5: s := 'FF_DECORATIVE';
else
s := AIntToStr(lf.lfPitchAndFamily shr 4);
end;
SA.Add(' Family : '#9+ s);
end;このように、TStringArray クラスのインスタンスに文字列を渡すほかは、これまで使ってきたのと同じである｡
以上で準備ができたので FontViewer.dpr の全リストを以下に掲載する。
program FontViewer;
uses
windows,
messages,
UtilFunc in 'UtilFunc.pas',
UtilClass in 'UtilClass.pas',
GDIObject in 'GDIObject.pas',
APIWindow in 'APIWindow.pas',
APIControl in 'APIControl.pas';
//------------------------------------------------------------
// Global Types, Constants and Variables
//------------------------------------------------------------
var
MainWnd: TSDIMainWindow;
lf: TLogFont;
tc: COLORREF;
ECB: TEnumFontComboBox;
LB1: TAPIListBox;
CB: array[1..4] of TAPICheckBox;
RB: array[1..8] of TAPIRadioButton;
GB1, GB2, GB3: TAPIGroupBox;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
procedure DisplayTLogFont(lf: TLogFont);
var
SA: TStringArray;
i: integer;
begin
SA := TStringArray.Create;
DisplayLogFont(lf,SA);
LB1.Clear;
for i := 0 to SA.Count-1 do LB1.AddString(SA[i]);
SA.Free;
end;
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure ECBSelChange(var Msg:TMessage);
var
DC: HDC;
pnt: integer;
r: TRect;
begin
lf := ECB.SelLogFont;
if CB[1].Checked then lf.lfWeight := FW_BOLD else lf.lfWeight := FW_NORMAL;
if CB[2].Checked then lf.lfItalic := 1 else lf.lfItalic := 0;
if CB[3].Checked then lf.lfUnderline := 1 else lf.lfUnderline := 0;
if CB[4].Checked then lf.lfStrikeOut := 1 else lf.lfStrikeOut := 0;
if RB[1].Checked then
pnt := 12
else if RB[2].Checked then
pnt := 18
else if RB[3].Checked then
pnt := 24
else
pnt := 36;
DC := GetDC(MainWnd.Handle);
lf.lfHeight := -MulDiv(pnt,GetDeviceCaps(DC,LOGPIXELSY),72);
ReleaseDC(MainWnd.Handle,DC);
lf.lfWidth := 0;
if RB[5].Checked then
tc := clrBlack
else if RB[6].Checked then
tc := clrRed
else if RB[7].Checked then
tc := clrGreen
else
tc := clrBlue;
GetClientRect(MainWnd.Handle,r);
r.Bottom := 70;
InvalidateRect(MainWnd.Handle, @r, true);
GetClientRect(MainWnd.Handle,r);
r.Right := 55;
InvalidateRect(MainWnd.Handle, @r, true);
DisplayTLogFont(lf);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
i: integer;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
ECB := TEnumFontComboBox.Create(hWindow);
with ECB do begin
Dimension := SetDim(60,70,210,300);
OnSelChange := ECBSelChange;
end;
GB1 := CreateGroupBox(hWindow,60,260,210,140,' Option ');
GB2 := CreateGroupBox(hWindow,60,110,100,140,' Size/Point ');
GB3 := CreateGroupBox(hWindow,170,110,100,140,' Color ');
for i := 1 to 4 do
RB[i] := CreateRadioButton(GB2.Handle,20,3+25*i,60,30,'',1,ECBSelChange);
RB[1].Caption := ' 12';
RB[2].Caption := ' 18';
RB[3].Caption := ' 24';
RB[4].Caption := ' 36';
RB[3].Checked := true;
for i := 1 to 4 do
CB[i] := CreateCheckBox(GB1.Handle,40,3+25*i,100,30,'',ECBSelChange);
CB[1].Caption := ' Bold';
CB[2].Caption := ' Italic';
CB[3].Caption := ' Underline';
CB[4].Caption := ' StrikeOut';
for i := 5 to 8 do
RB[i] := CreateRadioButton(GB3.Handle,20,3+25*(i-4),70,30,
'',2,ECBSelChange);
RB[5].Caption := ' Black';
RB[6].Caption := ' Red';
RB[7].Caption := ' Green';
RB[8].Caption := ' Blue';
RB[5].Checked := true;
LB1 := CreateListBox(hWindow,280,70,320,330,nil);
with MainWnd do begin
ClientWidth := 620;
ClientHeight := 410;
Center;
end;
end;
procedure MainPaint(var Msg: TMessage);
var
hF, HOldF: HFONT;
OldColor: COLORREF;
ps: TPaintStruct;
begin
BeginPaint(MainWnd.Handle,ps);
if lf.lfFaceName[0]<>#0 then begin
if lf.lfFaceName[0] = '@' then lf.lfEscapement := -900;
hF := CreateFontIndirect(lf);
hOldF := SelectObject(ps.hdc,hF);
OldColor := SetTextColor(ps.hdc,tc);
if lf.lfCharSet = SHIFTJIS_CHARSET then
if lf.lfFaceName[0] <> '@' then
TextOut(ps.hdc, 5, 5, ' サンプルてきすと出力 ',22)
else
TextOut(ps.hdc, 55, 5, ' サンプルてきすと出力 ',22)
else
TextOut(ps.hdc, 10, 10, ' Sample Text Output. ',21);
SelectObject(ps.hdc,hOldF);
SetTextColor(ps.hdc,OldColor);
DeleteObject(hF);
end;
EndPaint(MainWnd.Handle,ps);
end;
procedure OnTest(hWindow: HWND);
begin
ECB.FontType := TRUETYPE_FONTTYPE;
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
PostQuitMessage(0);
end;
//------------------------------------------------------------
// Main Procedure
//------------------------------------------------------------
begin
MainWnd := TSDIMainWindow.Create(0,GetExeName);
with MainWnd do begin
OnCreate := MainCreate;
OnDestroy := MainDestroy;
OnCommand := MainCommand;
Trap(WM_PAINT,MainPaint);
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.FontViewer.zip(21.074kB)
コンパイルして実行すると上図のようになる｡ 左上側のコンボボックスにはフォント名のリストが表示され、項目を選ぶとサンプルのテキストが表示され、対応する TLogFont レコードの内容が右側のリストボックスに表示される｡真ん中のラジオボタンとチェックボックスを選択すると、フォントのサイズと色とスタイルを変更することができる｡ これらは、ECBSelChange( ) ハンドラで TLogFont 型のレコードのフィールドの値を変更して実現している｡ MainPaint( ) ハンドラでは、このレコードと色をグローバル変数を通して受け取り、CreateFontIndirect( )でフォントハンドルを取得してＤＣに選択し、SetTextColor( )で色を設定し、TextOut( ) でサンプルテキストを表示している｡ 日本語フォントには、タイプフェース名の先頭が @ で始まる縦書き用のフォントがあるが、これらを選択すると lf の lfEscapement フィールドを -900 に設定して縦書きのサンプルテキストを表示する｡ Test! メニューを選択すると TrueType フォントだけがコンボボックスに表示される｡
ここまでのプログラムファイル