前の章へ
| 総目次へ
| 次の章へ 
｜前節に示したように、論理フォントを指定する TLogFont レコードを構築し、それを使ってフォントハンドルを取得し、デバイスコンテキストに選択して使用する方法が分かった。この章では､ これまでに作成してきたラベルやスピードボタンのラッパークラスやボタンやリストボックスなどの標準コントロールのラッパークラスでフォントを使用する方法を調べよう。
| 第１６章 フォントの研究 その２ |
| １６−１ フォント名の利用 |
| １６−２ コントロールにおけるフォントの利用 |
| １６−３ 論理フォントのカプセル化：その１ |
| １６−４ 論理フォントのカプセル化：その２ |
| １６−５ 論理フォントのカプセル化：その３ |
| １６−６ ラベルとスピードボタンに Font プロパティーを追加する |
| １６−７ まとめ |
前の章へ
| 総目次へ
| 次の章へ ｜ＶＣＬを使うＲＡＤ環境では､ フォントの指定はオブジェクトインスペクタの一覧から入力するので簡単であるが、キーボードを使ってフォントの名前を入力するのは､ 全角・半角の区別や空白などがあって意外と難しいものである｡ そこで、本節では､ 前章で作ったフォントビューアプログラムを少し改造して、任意のフォント名をクリップボードにコピーするプログラムを作ろう。
まず最初に、APIControl.pas に TEnumFontComboBox クラスと似たようなリストボックス TEnumFontListBox クラスを作ろう。宣言部の TAPIMSListBox の下に以下のコードを追加する｡
//---------- TEnumFontListBox -------------------------------------------- TEnumFontListBox = class(TAPIListBox) 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;
そして対応する実装部の部分に以下のように実装する。
//---------- TEnumFontListBox --------------------------------------------
function EnumFontProc(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall;
begin
result := 1;
if TEnumFontListBox(lParam).FontType <> 0 then
if (nFontType and TEnumFontListBox(lParam).FontType) = 0 then exit;
TEnumFontListBox(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;
procedure TEnumFontListBox.Initialize;
var
DC: HDC;
begin
inherited Initialize;
Clear;
DC := GetDC(Parent);
EnumFontFamilies(DC, nil, @EnumFontProc,integer(self));
ReleaseDC(Parent,DC);
end;
function TEnumFontListBox.GetSelLogFont: TLogFont;
var
DC: HDC;
begin
DC := GetDC(Parent);
EnumFontFamilies(DC,PChar(SelText),@FindFontProc,integer(@result));
ReleaseDC(Parent,DC);
end;
procedure TEnumFontListBox.SetFontType(value: integer);
var
DC: HDC;
begin
if FFontType = value then Exit;
FFontType := value;
Clear;
DC := GetDC(Parent);
EnumFontFamilies(DC, nil, @EnumFontProc,integer(self));
ReleaseDC(Parent,DC);
end;これは、前章で作成した TEnumFontComboBox クラスとほとんど同じなので説明の必要はないだろう。このクラスをつかって選択されたフォント名をクリップボードにコピーするプログラムを以下のように作成する。
program InputFontName;
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;
LB1: TEnumFontListBox;
ED1: TAPIEdit;
Btn1: TAPIButton;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg:TMessage);
var
DC: HDC;
r: TRect;
begin
lf := LB1.SelLogFont;
lf.lfItalic := 0;
DC := GetDC(MainWnd.Handle);
lf.lfHeight := -MulDiv(18,GetDeviceCaps(DC,LOGPIXELSY),72);
ReleaseDC(MainWnd.Handle,DC);
r := SetDim(0,0,400,54);
InvalidateRect(MainWnd.Handle,@r,true);
ED1.Text := LB1.SelText;
end;
procedure Btn1Click(var Msg:TMessage);
begin
ED1.SelectAll;
ED1.Copy;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
LB1 := TEnumFontListBox.Create(hWindow);
with LB1 do begin
Dimension := SetDim(10,90,200,240);
OnSelChange := LB1SelChange;
end;
ED1 := CreateEdit(hWindow,10,55,200,30,'',nil);
Btn1 := CreateButton(hWindow,220,55,150,35,'Copy',Btn1Click);
with MainWnd do begin
ClientWidth := 380;
ClientHeight := 340;
Center;
end;
end;
procedure MainPaint(var Msg: TMessage);
var
hF, HOldF: HFONT;
ps: TPaintStruct;
begin
BeginPaint(MainWnd.Handle,ps);
if lf.lfFaceName[0]<>#0 then begin
hF := CreateFontIndirect(lf);
hOldF := SelectObject(ps.hdc,hF);
if lf.lfCharSet = SHIFTJIS_CHARSET then
TextOut(ps.hdc,10,5,' サンプルてきすと出力 ',22)
else
TextOut(ps.hdc,10,10,' Sample Text Output. ',21);
SelectObject(ps.hdc,hOldF);
DeleteObject(hF);
end;
EndPaint(MainWnd.Handle,ps);
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;
Trap(WM_PAINT,MainPaint);
end;
MainWnd.DoCreate;
Halt(MessageLoopNormal);
end.
InputFontName.zip(16.353kB)
実行すると右図のようになる｡ MainCreate( ) ハンドラでは、TEnumFontListBox クラスのインスタンスとエディットとボタンを一つずつ作っている。リストボックスからフォントが選択されると、そのサンプル文字列が上部に表示されるとともにエディットにフォント名が表示される｡ ボタンを押すとエディットのメソッドを使ってクリップボードにフォント名がコピーされる｡ これは、エディタなどに貼り付けて確認できる｡
これまで GDIObject.pas につくってきた TAPILabel や TAPISpeedBtn などの TGDIObject の派生クラスでは､ 親のウィンドウ関数をサブクラス化して WM_PAINT メッセージを盗み、それに同期して各クラスの DefaultHandler( ) メソッド内で自分自身を描画している｡ そこでは、親のデバイスコンテキストを取得して、テキストを DrawText( ) ＡＰＩを使って出力していた｡ したがって、前章で示したプログラムと同じように、DrawText( ) を呼び出す直前にフォントハンドルをＤＣに選択すれば、任意のフォントを利用できるだろう｡ これに対して､ Win32 の定義済み子ウィンドウである、ボタンやリストボックス、エディットなどの標準コントロールでは、テキストの描画はそれぞれのウィンドウ関数の中で行っているので､ プログラマがそこに直接立ち入ることは出来ない｡ では、コントロールで任意のフォントを利用するにはどうしたらよいのだろうか｡ ＶＣＬでは、実際に任意のフォントを TButton などの TWinControl の派生コンポーネントに指定できる｡
これまでにこれらのコントロールをカプセル化したクラスを、TAPIControl の派生クラスとして APIControl.pas に実装してきた｡ そこでは、ウィンドウオブジェクトであるコントロールを制御するためのメソッドやプロパティーの取得・設定のためには、対応するメッセージを SendMessage( ) を使ってコントロールのウィンドウ関数に送出していたことを思い出してほしい｡ これと同じように､ フォントの設定・取得のためには、WM_SETFONT と WM_GETFONT というメッセージを適切に送るだけでよいのだ｡ Delphi に付いてくる Win32.hlp から、このメッセージの定義を以下に示す｡
WM_SETFONT wParam = (WPARAM) hfont; // handle of font lParam = MAKELPARAM(fRedraw, 0); // redraw flag
これから分かるように、wParam に使用するフォントのハンドルを指定し、LOWORD(lParam) にゼロ以外の値を設定すると、直ちにコントロールのテキストに反映される｡ コントロールが設定されたフォントを使用している間は、そのフォントを削除してはならない。逆に、不要になったフォントは DeleteObject( ) で適宜削除しなければならない｡ 現在設定されているフォントは、WM_GETFONT メッセージを送ると戻り値としてハンドルが返される。
WM_GETFONT wParam = 0; // not used, must be zero lParam = 0; // not used, must be zero
コントロールが、システムのデフォルトフォントを使っている場合はゼロが返される｡
WM_SETFONT と WM_GETFONT メッセージを使って、コントロールのフォントを変更することをテストするプログラムを作ろう｡
以下に ControlFont01.dpr の全リストを示す｡
program ControlFont01;
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;
hFNew,hFPrev: HFONT;
LB1: TEnumFontListBox;
LB2: TAPIListBox;
Btn1: TAPIButton;
Ckb1: TAPICheckBox;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg: TMessage);
var
DC: HDC;
lf: TLogFont;
begin
lf := LB1.SelLogFont;
DC := GetDC(MainWnd.Handle);
lf.lfHeight := MulDiv(16,GetDeviceCaps(DC,LOGPIXELSY),72);
ReleaseDC(MainWnd.Handle,DC);
lf.lfWidth := 0;
lf.lfItalic := 0;
hFPrev := hFNew; // restore Previous Font Handle
hFNew := CreateFontIndirect(lf);
SendMessage(LB2.Handle,WM_SETFONT,hFNew,MakeLong(1,0));
SendMessage(Btn1.Handle,WM_SETFONT,hFNew,MakeLong(1,0));
SendMessage(Ckb1.Handle,WM_SETFONT,hFNew,MakeLong(1,0));
if hFPrev <> 0 then DeleteObject(hFPrev);
end;
procedure ControlClick(var Msg: TMessage);
begin
SendMessage(TAPIControl(Msg.Msg).Handle,
WM_SETFONT,0,MakeLong(1,0));
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
LB1 := TEnumFontListBox.Create(hWindow);
with LB1 do begin
Dimension := SetDim(10,10,200,250);
OnSelChange := LB1SelChange;
end;
LB2 := CreateListBox(hWindow,220,10,200,120,ControlClick);
with LB2 do begin
AddString('ABCDEFGHIJK');
AddString('1234567890');
AddString('abcdefghijk');
AddString('@++=/-%$#&');
end;
Btn1 := CreateButton(hWindow,220,140,200,50,'APIButton',ControlClick);
Ckb1 := CreateCheckBox(hWindow,240,200,200,50,'APICheckBox',ControlClick);
with MainWnd do begin
ClientWidth := 440;
ClientHeight := 270;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
var
hF: HFONT;
begin
hF := SendMessage(LB2.Handle,WM_GETFONT,0,0);
DeleteObject(hF);
InvalidateRect(hWindow,nil,true);
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
DeleteObject(hFNew);
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.ControlFont01.zip(16.074kB)
これで完成である｡ 実行すると TEnumFontListBox クラスのインスタンス LB1 にタイプフェース名が列挙される｡ マウスで一つを選択するとリストボックス LB2、プッシュボタン Btn1、チェックボックス Ckb1 のテキスト表示に選択されたフォントが反映される｡ この様子を右図に示す｡ Test! メニューを選択するとテキスト表示がデフォルトフォントに戻る｡ LB2,Btn1,Ckb1 の各コントロールをクリックするとそのコントロールの表示がデフォルトフォントに戻る。
コードを調べよう。LB1SelChange( ) では LB1 で選択された TLogFont から CreateFontIndirect( ) をつかって論理フォントのハンドルを取得している｡ サイズを１６ポイント、非イタリックにしてから SendMessage( ) を使って WM_SETFONT メッセージを送ることで各コントロールにフォントを設定している｡ フォントハンドルは、設定直前のものは hFPrev に、設定するものは hFNew のグローバル変数に格納し、設定直後に hFPrev で示されるフォントを廃棄している｡
MainDestroy( ) ハンドラでは､ 最後に設定したフォントを廃棄している｡ OnTest( ) ハンドラは、設定中のフォントを廃棄すると何が起こるかをテストしている｡ ControlClick( ) ハンドラでは、フォントハンドルにゼロを指定して、個別のコントロールのフォントをデフォルトに戻している｡ おもしろいのは、LB2 をクリックしてデフォルトフォントにしてから、Test! を選択すると､ 他のコントロールのフォントをデフォルトに出来ないことだ。OnTest( ) ハンドラでは、設定中のフォントを LB2 から WM_GETFONT メッセージを送ってハンドルを取得しているので、この動作は納得できるだろう｡
以上で、Win32 の標準コントロールのテキスト表示に使用されるフォントの設定・取得方法について知ることができた。
Delphi のＶＣＬでは、多くのコンポーネントが TFont 型の Font プロパティーを備えている。ハンドルで管理される論理フォントは、ＧＤＩオブジェクトであり、システムのリソースを消費する｡ 多数のコンポーネントの各々が論理フォントを個別に維持しているとリソースの消費が心配になる｡ この対策として TFont クラスが実装されている Graphics.pas では、実装部に定義されている TResourceManager のローカルなインスタンスである FontManager が論理フォントの維持管理を受け持っており、リソースを節約することに成功している｡ TFont は TLogFont レコードをカプセル化したものであり、ハンドルの取得にはここで説明してきた CreateFontIndirect( ) ＡＰＩを使用している｡
前節までで見てきたように、論理フォントのハンドルを取得するためには、TLogFont 型のレコードを構築できればよい。また、TextOut( ) や DrawText( ) などのＧＤＩ関数を用いてテキストを表示するときには､ SetTextColor( ) ＡＰＩでテキストの色を設定できる｡ 結局、TLogFont 型のレコードと COLORREF 型の変数が一つずつ決まれば、ＧＤＩ関数で出力するテキストのフォントは、制御できることになる｡ この場合、出力直前に SelectObject( ) と SetTextColor( )でデバイスコンテキストにフォントと色を設定し、出力直後には論理フォントを削除してもよい。これに対して､ コントロールにフォントを設定するには WM_SETFONT メッセージを送って、フォントハンドルを指定する｡ そして、設定されている間は、その論理フォントを削除してはならない｡ 前節のプログラム例で見たように、削除するとそのフォントが設定されている全てのコントロールのテキスト表示がデフォルトフォントに戻ってしまう｡ コントロールに現在設定されているフォントのハンドルは、WM_GETFONT メッセージを送ることで取得できるので､ コントロール自身が設定された論理フォントを維持する事ができると言える｡
この節では､ ＧＤＩ関数を用いてテキストを出力する際に、フォントの指定を容易にするために、TLogFont 型のレコードをカプセル化したクラス TAPIGFont をつくる。そして、このクラスを使ってメインウィンドウのクライアント領域にテキストを表示するプログラムを作ろう｡
まず最初に、UtilClass.pas に TAPIGFont クラスを実装しよう｡ Interface 部の TMessageTrapper の宣言の直ぐ下に以下の宣言を書く｡
//------------- TAPIGFont ----------------------------------------------- TAPIGFont = class(TObject) private FLogFont: TLogFont; FHandle: HFONT; FPrevHandle: HFONT; FName: string; FSize: integer; FEscapement: integer; FBold: Boolean; FItalic: Boolean; FUnderline: Boolean; FStrikeOut: Boolean; FColor: COLORREF; procedure SetLogFont(value: TLogFont); function GetLogFont: TLogFont; public constructor Create; procedure SelectHandle(DC: HDC); procedure DeleteHandle(DC: HDC); property LogFont: TLogFont read GetLogFont write SetLogFont; property Name: string read FName write FName; property Size: integer read FSize write FSize; property Escapement: integer read FEscapement write FEscapement; property Bold: Boolean read FBold write FBold; property Italic: Boolean read FItalic write FItalic; property Underline: Boolean read FUnderline write FUnderline; property StrikeOut: Boolean read FStrikeOut write FStrikeOut; property Color: COLORREF read FColor write FColor; end;
実装部の対応する場所に、以下のコードを書く。
//------------- TAPIGFont -----------------------------------------------
function FindFontProc(lpelf: PEnumLogFont;
lpntm: PNewTextMetric;
nFontType: integer;
lParam: LParam):integer; stdcall; export;
begin
PLogFont(lParam)^ := lpelf^.elfLogFont;
Result := 1;
end;
constructor TAPIGFont.Create;
var
hF: HFONT;
begin
hf := GetStockObject(SYSTEM_FONT);
GetObject(hF,SizeOf(FLogFont),@FLogFont);
FName := FLogFont.lfFacename;
FSize := 12;
FEscapement := FLogFont.lfEscapement;
FBold := (FLogFont.lfWeight > 300);
FItalic := (FLogFont.lfItalic <> 0);
FUnderline := (FLogFont.lfUnderline <> 0);
FStrikeOut := (FLogFont.lfStrikeOut <> 0);
end;
procedure TAPIGFont.SelectHandle(DC: HDC);
begin
If FName = 'System' then Exit;
EnumFontFamilies(DC,PChar(FName),@FindFontProc,integer(@FLogFont));
with FLogFont do begin
lfHeight := -MulDiv(FSize,GetDeviceCaps(DC,LOGPIXELSY),72);
lfWidth := 0;
lfEscapement := FEscapement;
if FBold then lfWeight := FW_BOLD else lfWeight := FW_NORMAL;
if FItalic then lfItalic := 1 else lfItalic := 0;
if FUnderline then lfUnderline := 1 else lfUnderline := 0;
if FStrikeOut then lfStrikeOut := 1 else lfStrikeOut := 0;
end;
FHandle := CreateFontIndirect(FLogFont);
FPrevHandle := SelectObject(DC,FHandle);
SetTextColor(DC,FColor);
end;
procedure TAPIGFont.DeleteHandle(DC: HDC);
begin
If FName = 'System' then Exit;
if FHandle<>0 then begin
SelectObject(DC,FPrevHandle);
DeleteObject(FHandle);
FHandle := 0;
SetTextColor(DC,0);
end;
end;
procedure TAPIGFont.SetLogFont(value: TLogFont);
var
IC: HDC;
begin
FLogFont := value;
FName := value.lfFaceName;
IC := CreateIC('DISPLAY',nil,nil,nil);
FSize := ((value.lfHeight)*72) div GetDeviceCaps(IC,LOGPIXELSY);
DeleteDC(IC);
FEscapement := value.lfEscapement;
FBold := (value.lfWeight > 500);
FItalic := (value.lfItalic <> 0);
FUnderline := (value.lfUnderline <> 0);
FStrikeOut := (value.lfStrikeOut <> 0);
end;
function TAPIGFont.GetLogFont: TLogFont;
var
IC: HDC;
begin
IC := CreateIC('DISPLAY',nil,nil,nil);
EnumFontFamilies(IC,PChar(FName),@FindFontProc,integer(@FLogFont));
with FLogFont do begin
lfHeight := -MulDiv(FSize,GetDeviceCaps(IC,LOGPIXELSY),72);
DeleteDC(IC);
lfWidth := 0;
lfEscapement := FEscapement;
if FBold then lfWeight := FW_BOLD else lfWeight := FW_NORMAL;
if FItalic then lfItalic := 1 else lfItalic := 0;
if FUnderline then lfUnderline := 1 else lfUnderline := 0;
if FStrikeOut then lfStrikeOut := 1 else lfStrikeOut := 0;
end;
result := FLogFont;
end;これで TAPIGFont クラスは完成である｡ コードを見ていこう。このクラスは、宣言を見ても分かるように､ TObject から直接派生しており、TLogFont レコード型のプライベートな変数 FLogFont と COLORREF 型の FColor をカプセル化したものだ｡ TLogFont の主なフィールド変数に対応するものをプロパティーとして装備している｡ コンストラクタ Create では、SYSTEM_FONT を指定して､ ストックオブジェクトからデフォルトフォントの TLogFont 型レコードを取得して、各プロパティーの保存用変数に代入している｡ LogFont プロパティーの設定メソッド SetLogFont( ) では、指定のレコードから同じようにプロパティー保存用の変数に代入している｡ SelectHandle( ) メソッドでは、EnumFontFamilies( ) にフォント名を指定して TLogFont 型のレコードを取得し、それにプロパティーの設定を反映させる｡ つぎに、出来た TLogFont レコードから CreateFontIndirect( ) ＡＰＩを使って、論理フォントのハンドルを取得し､ ＤＣに選択する｡ 最後に、SetTextColor( ) でＤＣにテキスト色を設定する｡ DeleteHandle( ) メソッドでは、フォントの設定をもとに戻してから、設定フォントを削除し、テキスト色をデフォルトの黒に戻す｡ このように、フォントの設定と削除は、SelectHandle( ) と DeleteHandle( ) をペアで使うことを前提としている｡ このようにして使うと DeleteHandle( ) を呼び出した後は、フォントとテキスト色についてはＤＣがデフォルト値になっていることが保証される｡ このクラスは､ 論理フォントのハンドルをユーザーに公開していない｡ ハンドルが必要なときは、LogFont プロパティーを指定して、CreateFontIndirect( ) を使って取得できる｡
TAPIGFont クラスをテストする実行コードを APIGFont.dpr に書こう｡ 以下に全リストを示す｡
program APIGFont;
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;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
with MainWnd do begin
ClientWidth := 400;
ClientHeight := 400;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
var
ft1, ft2: TAPIGFont;
s: string;
DC: HDC;
r: TRect;
hBr: HBRUSH;
Flag: UINT;
hF, hPrevF: HFONT;
begin
s := ' サンプルてきすと出力 ';
ft1 := TAPIGFont.Create;
with ft1 do begin
Name := 'ＭＳ Ｐ明朝';
Size := 22;
Bold := true;
Color := clrBlue;
end;
ft2 := TAPIGFont.Create;
with ft2 do begin
Name := 'ＭＳ ゴシック';
Size := 22;
Italic := true;
Color := clrRed;
Escapement := -100;
end;
DC := GetDC(hWindow);
SetBkMode(DC,TRANSPARENT);
ft1.SelectHandle(DC);
TextOut(DC,20,20,PChar(s),Length(s));
ft1.DeleteHandle(DC);
SetBkMode(DC,OPAQUE);
ft2.SelectHandle(DC);
TextOut(DC,20,60,PChar(s),Length(s));
ft2.DeleteHandle(DC);
r := SetDim(20,150,350,200);
hBr := CreateSolidBrush(clrLime);
FrameRect(DC,r,hBr);
DeleteObject(hBr);
ft1.SelectHandle(DC);
Flag := DT_SINGLELINE or DT_CENTER or DT_VCENTER;
DrawText(DC,PChar(s),Length(s),r,Flag);
ft1.DeleteHandle(DC);
r := SetDim(20,210,350,280);
hBr := CreateSolidBrush(clrYellow);
FrameRect(DC,r,hBr);
DeleteObject(hBr);
ft2.Escapement := 100;
ft2.SelectHandle(DC);
Flag := DT_SINGLELINE or DT_BOTTOM;
DrawText(DC,PChar(s),Length(s),r,Flag);
ft2.DeleteHandle(DC);
SetBkMode(DC,TRANSPARENT);
hF := CreateFontIndirect(ft1.LogFont);
hPrevF := SelectObject(DC,hF);
SetTextColor(DC,ft1.Color);
TextOut(DC,20,290,PChar(s),Length(s));
DeleteObject(SelectObject(DC,hPrevF));
SetTextColor(DC,0);
ReleaseDC(hWindow,DC);
ft1.Free;
ft2.Free;
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.APIGFont.zip(13.731kB)
以上で完成である｡ 実行して、Test! メニューを選択したときの様子を右図に示す｡ OnTest( ) ハンドラでは、TAPIGFont のローカルインスタンス ft1 と ft2 を生成した後、プロパティーを幾つか設定している｡ メインウィンドウのＤＣハンドルを指定して､ SelectHandle( ) メソッドと DeleteHandle( ) メソッドのペアを四回使って、テキストを四行出力している｡ 五行目のテキストは､ LogFont プロパティーを利用して、コードで論理フォントを取得・設定・廃棄するすることで出力している｡ 初めの二行は、TextOut( ) で、３，４行目は DrawText( ) ＡＰＩを使っている｡ ここでは、真ん中の三行は背景モードを OPAQUE にして、出力矩形を見やすくした｡ ft2 の Escapement プロパティーを最初は -100 に設定して、二行目の出力では時計回りの方向に１０度だけ傾けている｡ TextOut( ) では、出力矩形の左上の角が座標指定に使われていることが分かるだろう｡ 三行目の出力は､ DrawText( ) ＡＰＩの第４パラメータに DT_SINGLELINE or DT_CENTER or DT_VCENTER を指定して､ 書式矩形の中央にテキストを出力している｡ 書式矩形は FrameRect( ) を使って描いている｡ 四行目のテキストは､ ft2 の Escapement プロパティーを 100 にして反時計回りに１０度傾けており、書式矩形の下から描いている｡ 出力の後の方は書式矩形によってクリップされているのが分かるだろう｡ Flag に DT_NOCLIP を加えるとクリッピングされない｡ 最後に、ローカルインスタンス ft1 と ft2 を廃棄している｡
このように TAPIGFont クラスのインスタンスを使うと、フォントハンドルの設定が非常に簡単になることが理解出来るだろう｡
前節では、TAPIGFont クラスを作成して、そのメソッドを使ってＤＣ にフォントを選択していた。このクラスは論理フォントをカプセル化したというより TLogFont レコードをカプセル化したものだった。ハンドルを持つ論理フォントは SelectHandle( ) メソッドで実体化されＤＣに選択されたあと、DeleteHandle( ) メソッドで廃棄されていた。16-2節で述べたように、コントロールに論理フォントを設定すると設定中は廃棄することが出来ない｡ これが ＧＤＩ関数でテキストを出力するときのフォントの指定の仕方との大きな相違点である｡ コントロールへフォントを設定するために TAPIGFont を使う場合は、その LogFont プロパティーを利用して CreateFontIndirect( ) ＡＰＩを使って論理フォントを簡単に作成できることは前節の最後の文字列を出力するときに示した｡ ここでは、この手法を使ってコントロールにフォントを設定してみよう｡
TAPIGFont クラスを使って、コントロールにフォントを設定するするプログラムを作ろう。
以下に、ControlFont02.dpr の全リストを示す｡
program ControlFont02;
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;
Btn: TAPIButton;
LB: TAPIListBox;
GB: TAPIGroupBox;
RB: TAPIRadioButton;
hF: HFONT;
Flag: Boolean = true;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure BtnClick(var Msg:TMessage);
begin
Btn.DestroyObject;
InvalidateRect(MainWnd.Handle,nil,true);
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
Btn := CreateButton(hWindow,10,10,150,40,'SelfDestroy',BtnClick);
LB := CreateListBox(hWindow,10,60,150,100,nil);
with LB do begin
AddString('リストボックス');
AddString('1234567890$#%&');
AddString('ABCdefGHijklm');
end;
GB := CreateGroupBox(hWindow,10,170,150,60,'GroupBox');
RB := CreateRadioButton(GB.Handle,10,25,120,30,'RadioButton',0,nil);
with MainWnd do begin
ClientWidth := 170;
ClientHeight := 250;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
var
ft: TAPIGFont;
begin
if Flag then begin
ft := TAPIGFont.Create;
with ft do begin
Name := 'ＭＳ Ｐ明朝';
Size := 12;
Italic := true;
end;
hF := CreateFontIndirect(ft.LogFont);
SendMessage(Btn.Handle,WM_SETFONT,hF,1);
SendMessage(LB.Handle,WM_SETFONT,hF,1);
SendMessage(GB.Handle,WM_SETFONT,hF,1);
SendMessage(RB.Handle,WM_SETFONT,hF,1);
ft.Free;
end else
DeleteObject(hF);
Flag := not Flag;
InvalidateRect(hWindow,nil,true);
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
DeleteObject(hF);
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.ControlFont02.zip(16.273kB)
以上で完成だ｡ 実行して､ Test! メニューを選択すると、右図のようになる｡ Test! メニューを選択するたびにフォントの設定と解除が交互に行われる｡ コードの最後の InvalidateRect( ) は、グループボックスがフォントを変更するときに「書き残し」するための対策である｡ MainCreate( ) ハンドラでは、プッシュボタン、リストボックス、グループボックス、ラジオボタンを一つずつ作っている。OnTest( ) ハンドラでは Flag が true のとき、TAPIGFont のローカルインスタンス ft を作成し、各フィールドをカスタマイズしてからその LogFont プロパティーを設定して CreateFontIndirect( ) ＡＰＩ を使ってフォントハンドルを取得しグローバル変数に代入している｡ それから４つのコントロールに WM_SETFONT メッセージを送ってフォントを設定し、ft を廃棄している｡ Flag が false のときは、フォントハンドルを使って設定中のフォントを DeleteObject( ) で廃棄している｡
ここでフォント設定中にボタンを押すと何が起こるか調べよう｡ BtnClick( ) ハンドラでは、ボタン自身を廃棄している。しかし、このときも他のコントロールのフォント設定状況には変化が起こらない｡ これらのコントロールには一つの共通のフォントハンドルで代表される論理フォントを設定しているのにもかかわらず、その一つのインスタンスが廃棄されても変化が起こらないのは､ コントロール自身は廃棄されるときに自分に設定中の論理フォントは廃棄しないということだ｡ つまり、コントロールは自分に設定中のフォントの廃棄に責任をもっていない事を意味している｡ この事実により、ＶＣＬ では FontManager によりリソースの節約ができるわけである｡ 本稿の当初の目論見では、論理フォントをカプセル化した TAPIGFont に似たクラスを作成して、これを使って TAPIControl クラスに Font プロパティーを追加する予定であった。そうすればこのクラスから派生した全てのコントロールクラスでフォントを扱えるようになる。しかし、上記のような事情から各コントロールが個別に論理フォントを持つのは非常に無駄であるように思えてきた｡ 通常、ダイアログ等で多数のコントロールを使用するにしても、その各々が別々のフォントを持つ状況は考えにくい。通常は、一つか二つのフォントで十分であろうし、そのほうが外観に統一性があるだろう｡ このような事情から Font プロパティーは装備しないことにするが、次節ではコントロールでより簡単にフォントを指定できるようなクラスを作成しよう｡
前節で述べたように各コントロールにフォントを設定するために TAPIGFont クラスを使用することは出来るが、ハンドルを取得したりフォントを設定したりするためにナマのＡＰＩを使わなければならず、使い勝手は良くない｡ ここでは、TAPIGFont クラスから派生し、これらの作業をメソッドとして持つ真に論理フォントをカプセル化したクラス TAPICFont を作成しテストしてみよう｡ このクラスは、SelectHandle( ) メソッドや DeleteHandle( ) メソッドの代わりにコントロールに論理フォントを設定・削除するメソッドを持っているほかに、フォントハンドルをプロパティーとして公開する。
最初に UtilClass.pas に TAPICFont クラスを作ろう｡ interface 部の TAPIGFont の宣言の下に以下の宣言を書く｡
//------------- TAPICFont ----------------------------------------------- TAPICFont = class(TAPIGFont) public destructor Destroy; override; procedure GetHandle; procedure SetHandle(ctlHandle: HWND); procedure ResetHandle(ctlHandle: HWND); property Handle: HFONT read FHandle; end;
実装部の対応する場所に以下の実装コードを書く。
//------------- TAPICFont ----------------------------------------------- destructor TAPICFont.Destroy; begin DeleteObject(FHandle); inherited Destroy; end; procedure TAPICFont.GetHandle; begin DeleteObject(FHandle); FHandle := CreateFontIndirect(LogFont); end; procedure TAPICFont.SetHandle(ctlHandle: HWND); begin SendMessage(ctlHandle,WM_SETFONT,FHandle,1); end; procedure TAPICFont.ResetHandle(ctlHandle: HWND); begin SendMessage(ctlHandle,WM_SETFONT,0,1); end;
これで完成である｡ このクラスは、GetHandle メソッドで論理フォントを実体化して Handleプロパティーとして公開し、SetHandle( ) メソッドで任意のコントロールに設定し、ResetHandle( ) メソッドでそれを解除できる。デストラクタでは、最後の論理フォントを解放する。
TAPICFont をテストするプログラムを ControlFont03.dpr に書こう｡ 以下に全リストを示す｡
program ControlFont03;
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;
Btn: TAPIButton;
LB: TAPIListBox;
GB: TAPIGroupBox;
RB: TAPIRadioButton;
Flag: Boolean = true;
ft: TAPICFont;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure BtnClick(var Msg:TMessage);
begin
MainWnd.Close;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
Btn := CreateButton(hWindow,10,10,150,40,'Quit',BtnClick);
LB := CreateListBox(hWindow,10,60,150,100,nil);
with LB do begin
Color := clrYellow;
TextColor := clrMaroon;
AddString('リストボックス');
AddString('1234567890$#%&');
AddString('ABCdefGHijklm');
end;
GB := CreateGroupBox(hWindow,10,170,150,60,'GroupBox');
RB := CreateRadioButton(GB.Handle,10,25,120,30,'RadioButton',0,nil);
ft := TAPICFont.Create;
with ft do begin
Name := 'ＭＳ Ｐ明朝';
Size := 12;
Bold := true;
GetHandle;
end;
with MainWnd do begin
ClientWidth := 170;
ClientHeight := 250;
Center;
end;
end;
procedure OnTest(hWindow: HWND);
begin
if Flag then begin
ft.SetHandle(Btn.Handle);
ft.SetHandle(LB.Handle);
ft.SetHandle(GB.Handle);
ft.SetHandle(RB.Handle);
end else begin
ft.ResetHandle(Btn.Handle);
ft.ResetHandle(LB.Handle);
ft.ResetHandle(GB.Handle);
ft.ResetHandle(RB.Handle);
end;
Flag := not Flag;
InvalidateRect(hWindow,nil,true);
end;
procedure MainCommand(var Msg: TMessage);
begin
Msg.Msg := MainWnd.Handle;
InitMenuCommand(Msg,OnTest);
end;
procedure MainDestroy(var Msg: TMessage);
begin
ft.Free;
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.ControlFont03.zip(16.410kB)
以上で完成である｡ 実行して､ Test! メニューを選択すると右図のようにフォントが変更されるのが分かるだろう｡ 外観は前節のプログラムと全く同じである｡ TAPICFont のインスタンスは MainCreate( ) でつくられ、MainDestroy( ) で解放されている｡ OnTest( ) ハンドラでは、このクラスのメソッドやプロパティーをつかってフォントの設定や解除を行っている｡
TAPIGFont をつかって TGDIObject の派生クラスに Font プロパティーを追加する事を考える｡ TGDIObject クラスに Font プロパティーを追加すると、その全ての派生クラスで利用できるようになるが、利用するすべてのクラスの DefaultHandler( ) メソッドを書き換えなくてはならない｡ここでは、TAPISpeedBtn クラスと TAPILabel クラスに個別に Font プロパティーを追加し、それをテストしよう。他のクラスに追加するのは､ 以下の手続きをまねすれば、簡単にできるだろう｡
まず、GDIObject.pas にある TAPILabel クラスに Font プロパティーを追加しよう｡ 変更後の宣言を以下に示す｡
//------------- TAPILabel --------------------------------------------- TAPILabel = class(TGDIObject) private FColor: COLORREF; FText: string; FTextAlign: UINT; FFont: TAPIGFont; // この行を追加する FMargin: integer; FBkMode: integer; FDrawFrame: Boolean; FFrameColor: COLORREF; procedure SetColor(value: COLORREF); procedure SetText(value:string); procedure SetTextAlign(value:UINT); procedure SetMargin(value:integer); procedure SetBkMode(value:integer); procedure SetDrawFrame(value:Boolean); procedure SetFrameColor(value:COLORREF); public constructor Create(hParent:HWND); override; destructor Destroy; override; // この行を追加する procedure DefaultHandler(var Message);override; property Color: COLORREF read FColor write SetColor; property Text: string read FText write SetText; property TextAlign: UINT read FTextAlign write SetTextAlign; property Font: TAPIGFont read FFont; // この行を追加する property Margin: integer read FMargin write SetMargin; property BkMode: integer read FBkMode write SetBkMode; property DrawFrame: Boolean read FDrawFrame write SetDrawFrame; property FrameColor: COLORREF read FFrameColor write SetFrameCOlor; end;
以前の宣言から変更するのは、まず、TextColor プロパティーとその保存用変数 FTextColor とその設定メソッド SetTextColor( ) の宣言を削除する｡ そして、上記のリストのコメントにあるように三行を追加する。次に実装部の SetTextColor( ) メソッドを削除する。それから、コンストラクタを以下のように変更する。
constructor TAPILabel.Create(hParent:HWND); begin FFont := TAPIGFont.Create; // この行を追加する inherited Create(hParent); Dispatcher.TrapMessage(WM_PAINT,self); FColor := clrWhite; FTextAlign := DT_LEFT; FText := ClassName; FMargin := 4; FBkMode := OPAQUE; FDrawFrame := false; FFrameColor := clrBlack; Update; end;
コンストラクタでは、FTextColor := clrBlack; の行を削除して、そのかわりにコードの最初の実行文として FFont := TAPIGFont.Create; を加える｡ 継承メソッドの実行前に、この文を実行することが重要である｡ なぜならば、上位クラスの TGDIObject のコンストラクタで、WM_PAINT メッセージを発生させているので、FFont が生成する前に DefaultHandler( ) が実行されては実行時エラーが起こるからだ｡ 追加したデストラクタを以下のようにする。
destructor TAPILabel.Destroy; begin FFont.Free; inherited Destroy; end;
ここでは､コンストラクタで生成した FFont を廃棄する｡ 最後に DefaultHandler( ) を以下のようにする｡
procedure TAPILabel.DefaultHandler(var Message);
var
DC:HDC;
AMsg: TMessage;
hBr: hBrush;
iR: TRect;
uFlags: UINT;
begin
if not FVisible then Exit;
AMsg := TMessage(Message);
if AMsg.Msg = WM_PAINT then begin
DC := GetDC(Parent);
if FBkMode = OPAQUE then begin
hBr := CreateSolidBrush(FColor);
FillRect(DC,FRect,hBr);
DeleteObject(hBr);
end;
if FDrawFrame then begin
hBr := CreateSolidBrush(FFrameColor);
FrameRect(DC,FRect,hBr);
DeleteObject(hBr);
end;
Windows.SetBkMode(DC,TRANSPARENT);
FFont.SelectHandle(DC); // この行を追加する
iR := FRect;
InflateRect(iR,-FMargin,-FMargin);
uFlags := DT_WORDBREAK or DT_EXTERNALLEADING or
DT_EXPANDTABS or FTextAlign;
DrawText(DC,PChar(FText),Length(FText),iR,uFlags);
FFont.DeleteHandle(DC); // この行を追加する
ReleaseDC(Parent,DC);
end;
end;以前のコードと異なるところは､ Windows.SetTextColor(DC,FTextColor); の行を削除したことと、上記のコメントで示した二行を追加したことだ。これで、DrawText( ) の実行の前後で、フォントの設定・削除が行われる｡ これで完成である｡ 示したリストに較べて、変更するところは僅かである｡
次に、TAPISpeedBtn クラスに Font プロパティーを追加する。宣言部は以下のようになる。
//-------------------- TAPISpeedBtn ------------------------------------- TAPISpeedBtn = class(TGDIObject) private FEdge: UINT; FCaption: string; FDown: Boolean; FFont: TAPIGFont; // この行を追加する FOnClick: TNotifyMessage; procedure SetCaption(value:string); public constructor Create(hParent:HWND); override; destructor Destroy; override; // この行を追加する procedure DefaultHandler(var Message);override; property Caption: string read FCaption write SetCaption; property Font: TAPIGFont read FFont; // この行を追加する property OnClick: TNotifyMessage read FOnClick write FOnClick; end;
変更は､ コメントで示した三行を追加するだけだ｡ 実装部の変更を以下に示す｡
constructor TAPISpeedBtn.Create(hParent:HWND); begin FFont := TAPIGFont.Create; // この行を追加する inherited Create(hParent); Dispatcher.TrapMessage(WM_PAINT,self); Dispatcher.TrapMessage(WM_LBUTTONDOWN,self); Dispatcher.TrapMessage(WM_LBUTTONUP,self); Dispatcher.TrapMessage(WM_MOUSEMOVE,self); FEdge := EDGE_RAISED; FCaption := ''; FDown := false; end;
コンストラクタでは、FFont を生成する｡ 追加したデストラクタは以下のようになる。
destructor TAPISpeedBtn.Destroy; begin FFont.Free; inherited Destroy; end;
最後に、DefaultHandler( ) の WM_PAINT メッセージの処理コードを以下のようにする｡
WM_PAINT : begin
DC := GetDC(Parent);
hBr := CreateSolidBrush(clrBtnFace);
FillRect(DC, FRect, hBr);
DeleteObject(hBr);
DrawEdge(DC, FRect, FEdge, BF_RECT);
if Length(FCaption)>0 then begin
if not Enable then SetTextColor(DC,clrGrayText);
SetBkMode(DC,TRANSPARENT);
dr := FRect;
if FEdge = EDGE_RAISED then
OffsetRect(dr,1,1)
else
OffsetRect(dr,-1,-1);
FFont.SelectHandle(DC); // この行を追加する
DrawText(DC,PChar(FCaption),Length(FCaption),
dr,DT_CENTER or DT_SINGLELINE or DT_VCENTER);
FFont.DeleteHandle(DC); // この行を追加する
end;
ReleaseDC(Parent,DC);
end;ここではコメントで示した二行を追加するだけだ｡ これで完成である｡
以上で､ TAPILabel クラスと TAPISpeedBtn クラスに Font プロパティーが追加できたので､ これをテストするプログラムを LabelFont.dpr に書く｡ 以下に全リストを示す｡
program LabelFont;
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: TEnumFontListBox;
GB1: TAPIGroupBox;
RB: array[1..3] of TAPIRadioButton;
L1,L2,L3: TAPILabel;
Sp1, Sp2: TAPISpeedBtn;
//------------------------------------------------------------
// Helper Handlers
//------------------------------------------------------------
//------------------------------------------------------------
// Object Event Handlers
//------------------------------------------------------------
procedure LB1SelChange(var Msg:TMessage);
begin
if RB[1].Checked then begin
L1.Font.Name := LB1.SelLogFont.lfFaceName;
L1.Text := L1.Font.Name;
end else if RB[2].Checked then begin
L2.Font.Name := LB1.SelLogFont.lfFaceName;
L2.Text := L2.Font.Name;
end else begin
L3.Font.Name := LB1.SelLogFont.lfFaceName;
L3.Text := L3.Font.Name;
L3.UpdateAll;
end;
end;
procedure SpClick(var Msg: TMessage);
var
ALogFont: TLogFont;
c: COLORREF;
SPB: TAPISpeedBtn;
begin
SPB := TAPISpeedBtn(Msg.Msg); // sender
ALogFont := SPB.Font.LogFont;
c := SPB.Font.Color;
if DoChooseFont(MainWnd.Handle,ALogFont,0,c) then
with SPB do begin
Font.LogFont := ALogFont;
Font.Color := c;
Caption := Font.Name;
Update;
end;
end;
//------------------------------------------------------------
// Main Window Event Handlers
//------------------------------------------------------------
procedure MainCreate(var Msg: TMessage);
var
hWindow: HWND;
i: integer;
begin
hWindow := MainWnd.Handle;
MakeInitMenu(hWindow);
L1 := CreateLabel(hWindow,220,10,350,40,'');
with L1 do begin
Margin := 7;
Font.Color := clrGreen;
Font.Size := 18;
Font.Name := 'Times New Roman';
Font.Italic := true;
Text := Font.Name;
end;
L2 := CreateLabel(hWindow,220,60,350,50,'');
with L2 do begin
Margin := 7;
Color := clrNavy;
TextAlign := DT_CENTER;
Font.Color := clrWhite;
Font.Size := 24;
Font.Name := 'ＭＳ Ｐ明朝';
Font.Underline := true;
Text := Font.Name;
end;
L3 := CreateLabel(hWindow,220,120,350,70,'');
with L3 do begin
Margin := 12;
BkMode := TRANSPARENT;
TextAlign := DT_RIGHT;
FrameColor := clrLime;
DrawFrame := true;
Font.Size := 32;
Font.Name := 'ＭＳ Ｐゴシック';
Text := Font.Name;
end;
Sp1 := CreateSpeedBtn(hWindow,240,200,200,40,'',SpClick);
with Sp1 do begin
Font.Size := 16;
Font.Name := 'ＭＳ 明朝';
Caption := Font.Name;
end;
Sp2 := CreateSpeedBtn(hWindow,240,250,200,40,'',SpClick);
with Sp2 do begin
Font.Size := 16;
Font.Name := 'Times New Roman';
Caption := Font.Name;
end;
LB1 := TEnumFontListBox.Create(hWindow);
with LB1 do begin
Dimension := SetDim(10,10,200,150);
FontType := TRUETYPE_FONTTYPE;
OnSelChange := LB1SelChange;
end;
GB1 := CreateGroupBox(hWindow,10,170,200,120,' Select ');
for i := 1 to 3 do begin
RB[i] := CreateRadioButton(GB1.Handle,40,30*i-10,90,30,
'Label '+AIntToStr(i),1,nil)
end;
RB[3].Checked := true;
with MainWnd do begin
ClientWidth := 580;
ClientHeight := 300;
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.LabelFont.zip(18.909kB)
以上で完成である。実行して､ LB1 の項目とラジオボタンを適当に選択すると、三つのラベルのフォントが変更される｡ スピードボタンを押すと、「フォントの選択」ダイアログが表示され、選択されたフォントが押したスピードボタンのキャプションの表示に反映される｡ この様子を右図に示す｡ LB1SelChange( ) ハンドラでは、ラジオボタンのチェック状態に応じて、対応するラベルの Font プロパティーの Name プロパティーを変更している。一方､ SpClick( ) ハンドラでは、DoChooseFont( ) 関数が設定する TLogFont 型レコードと文字色を対応するボタンの Font プロパティーにそのまま代入している｡
以上で、本稿で作った多くのクラスでフォントを利用することができるようになった。コントロールでフォントを利用するのは、ハンドルを維持することが必要ではあるが、驚くほど簡単であることが理解出来ただろう｡ ＧＤＩ関数でのフォントの利用は､ コントロールよりもっと簡単である｡ それは、文字列を出力する関数が実行されるときだけ、ＤＣに選択されていればよいからである｡ TAPIGFont や TAPICFont クラスを利用すれば、ほとんどフォントの名前とサイズを指定するだけで、容易にフォントが利用できる。
前章と本章では、Win32 におけるフォントについて調べた。フォントは、ペンやブラシ、ビットマップなどと同じような、ハンドルを持つＧＤＩオブジェクトであり、ハンドルが手に入ったらそれをＤＣに選択して使うことができる｡ 前章では､ フォントハンドルを取得するために論理フォントを記述するレコードの TLogFont 型について調べ、これを使って適宜カスタマイズしてからフォントハンドルを取得する方法について探求した｡ 本章では、この TLogoFont レコードをカプセル化した TAPIGFont クラスや、それから派生して論理フォントのハンドルを維持する TAPICFont クラスを作成し、これらを使ってコントロールやＧＤＩオブジェクトにフォントを設定して使用する方法を調べた。
ここまでのプログラムファイル