モウヒトツなサンプルです。とりあえずフォントの切り替えを選択するとちゃんとCharSetも同時に比較的簡単に切り替えることができるので、正しくそのフォントで指定することができています。ScreenFont.zip(197,720bytes)
| history | TOP |
2004/06/27:作成
| overview | TOP |
Screen.Fontsでもフォント名は取り出せるんですが、たとえばTMemo.Font.Nameにフォント名だけを設定してもCharSetによっては反映されないことがあります。
そこで、CharSetも含めて、フォント情報を取り出せるだけ取り出そうと、そういう趣旨です。
| 参考サイト | TOP |
| コード | TOP |
(*-----------------------------------------------------------------------------
Screen.Fonts の代わりにしたいクラス
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;
TEnumLogFont = packed record
elfLogFont : TLogFontA; // 論理フォント情報
elfFullName : array[0..LF_FULLFACESIZE - 1] of AnsiChar;
// フォントのフルネーム
elfStyle : array[0..LF_FACESIZE - 1] of AnsiChar;
// フォントスタイル
end;
TNewTextMetric = record
tmHeight : Longint; // 文字の高さ
tmAscent : Longint; // 文字のアセント
tmDescent : Longint; // 文字のディセント
tmInternalLeading: Longint; // 内部レディング
tmExternalLeading: Longint; // 外部レディング
tmAveCharWidth: Longint; // 文字の平均幅
tmMaxCharWidth: Longint; // 文字の最大幅
tmWeight : Longint; // ボールド幅
tmOverhang : Longint; // オーバーハング
tmDigitizedAspectX: Longint;// 水平アスペクト
tmDigitizedAspectY: Longint;// 垂直アスペクト
tmFirstChar : AnsiChar; // 最初の文字
tmLastChar : AnsiChar; // 最後の文字
tmDefaultChar: AnsiChar; // デフォルトの文字
tmBreakChar : AnsiChar; // 区切り文字
tmItalic : Byte; // イタリックフラグ
tmUnderlined: Byte; // 下線フラグ
tmStruckOut : Byte; // 打ち消し線フラグ
tmPitchAndFamily: Byte; // ピッチとファミリのフラグ
tmCharSet : Byte; // 文字セット
ntmFlags : DWORD; // 属性ビットマスク
ntmSizeEM : UINT; // 概略単位で表したem角サイズ
ntmCellHeight: UINT; // 概略単位で表したセル高さ
ntmAvgWidth : UINT; // 概略単位で表した文字の平均幅
end;
-----------------------------------------------------------------------------*)
unit iScreenFont;
interface
uses
Windows, Messages, SysUtils, Classes;
type
// 列挙されたフォントの情報を保持するクラス
TFontKeeper = class
private
FFontType : integer;
FEnumLogFont: TEnumLogFont;
FTextMetrics: TNewTextMetric;
public
constructor Create(FontType: integer; LogFont: TEnumLogFont; TextMetrics: TNewTextMetric);
property FontType: integer read FFontType;
property EnumLogFont: TEnumLogFont read FEnumLogFont;
property TextMetrics: TNewTextMetric read FTextMetrics;
end;
// フォントの一覧を保持するクラス
TScreenFonts = class
private
FUpdating : Boolean;
FWndHandle: THandle; // ウィンドウの「ふり」をするためのハンドル
FFonts : TStringList; // フォント保持リスト
FAutoRefresh: Boolean; // 自動リフレッシュ
protected
procedure WndProc(var Msg: TMessage);
procedure Clear();
function GetFontKeeper(index: integer): TFontKeeper;
function GetEnumLogFont(index: integer): TEnumLogFont;
function GetTextMetric(index: integer): TNewTextMetric;
function GetLogFont(index: integer): TLogFont;
public
constructor Create(const AutoRefresh: Boolean);
destructor Destroy(); override;
procedure Refresh();
property Fonts: TStringList read FFonts;
property FontKeeper[index: integer]: TFontKeeper read GetFontKeeper;
property EnumLogFont[index: integer]: TEnumLogFont read GetEnumLogFont;
property TextMetrics[index: integer]: TNewTextMetric read GetTextMetric;
property LogFont[index: integer]: TLogFont read GetLogFont;
property Updating: Boolean read FUpdating;
property AutoRefresh: Boolean read FAutoRefresh write FAutoRefresh;
end;
type
TRefreshProc = procedure() of object;
var
ScreenFonts: TScreenFonts = nil;
RefreshProc: TRefreshProc = nil;
implementation
//-----------------------------------------------------------------------------
// コンストラクタ
constructor TFontKeeper.Create(FontType: integer; LogFont: TEnumLogFont;
TextMetrics: TNewTextMetric);
begin
FFontType := FontType;
FEnumLogFont := LogFont;
FTextMetrics := TextMetrics;
end;
//-----------------------------------------------------------------------------
// ウィンドウのふりをするときのウィンドウプロシージャ
procedure TScreenFonts.WndProc(var Msg: TMessage);
begin
// フォントの構成が変わった時
if Msg.Msg = WM_FONTCHANGE then
begin
// フラグを見てリフレッシュ
if FAutoRefresh then Refresh();
end else
// そうでないなら
begin
// 丸投げ
Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
end;
//-----------------------------------------------------------------------------
// コンストラクタ
constructor TScreenFonts.Create(const AutoRefresh: Boolean);
begin
inherited Create;
// フラグ初期化
FUpdating := false;
// 自動リフレッシュ
FAutoRefresh := AutoRefresh;
// フォント保持リスト作成
FFonts := TStringList.Create;
// ウィンドウのふりをするためのハンドル割り当て
FWndHandle := AllocateHWnd(WndProc);
// フォントリスト更新
Refresh();
end;
//-----------------------------------------------------------------------------
// コンストラクタ
destructor TScreenFonts.Destroy();
begin
// ウィンドウのふりをするのをやめる
DeallocateHWnd(FWndHandle);
// フォント保持リスト解放
FFonts.Free;
inherited Destroy;
end;
//-----------------------------------------------------------------------------
// クリア
procedure TScreenFonts.Clear();
begin
while FFonts.Count > 0 do
begin
FFonts.Objects[0].Free;
FFonts.Delete(0);
end;
FFonts.Clear();
end;
//------------------------------------------------------------------------
// Delphi Win32 Graphics API リファレンス P618-
// コールバック関数
function FontEnumProc(LogFont: PEnumLogFont; TextMetrics: PNewTextMetric;
FontType: integer; Strings: LPARAM): integer; stdcall;
var
FaceName: string;
FontKeeper: TFontKeeper;
begin
// フォント名とフォントタイプをリストに追加
FaceName := TEnumLogFont(LogFont^).elfLogFont.lfFaceName;
if (Copy(FaceName, 1, 1) <> '@') then
begin
FontKeeper := TFontKeeper.Create(FontType, LogFont^, TextMetrics^);
TStrings(Strings).AddObject(FaceName, FontKeeper);
end;
// 列挙継続
Result := 1;
end;
//-----------------------------------------------------------------------------
// フォント一覧更新
procedure TScreenFonts.Refresh();
var
DesktopDC: HDC;
begin
FUpdating := true;
Clear();
DesktopDC := GetDC(GetDesktopWindow);
EnumFontFamilies(DesktopDC, nil, @FontEnumProc, LPARAM(FFonts));
ReleaseDC(GetDesktopWindow, DesktopDC);
FFonts.Sort();
if Assigned(RefreshProc) then RefreshProc();
FUpdating := false;
end;
//-----------------------------------------------------------------------------
// プロパティアクセス - 1
function TScreenFonts.GetFontKeeper(index: integer): TFontKeeper;
begin
Result := TFontKeeper(FFonts.Objects[index]);
end;
//-----------------------------------------------------------------------------
// プロパティアクセス - 2
function TScreenFonts.GetEnumLogFont(index: integer): TEnumLogFont;
begin
Result := FontKeeper[index].EnumLogFont;
end;
//-----------------------------------------------------------------------------
// プロパティアクセス - 3
function TScreenFonts.GetTextMetric(index: integer): TNewTextMetric;
begin
Result := FontKeeper[index].TextMetrics;
end;
//-----------------------------------------------------------------------------
// プロパティアクセス - 4
function TScreenFonts.GetLogFont(index: integer): TLogFont;
begin
Result := FontKeeper[index].EnumLogFont.elfLogFont;
end;
//-----------------------------------------------------------------------------
// 勝手に作る
initialization
ScreenFonts := TScreenFonts.Create(true);
//-----------------------------------------------------------------------------
// 勝手にやめる
finalization
ScreenFonts.Free;
end.
| サンプル | TOP |
モウヒトツなサンプルです。とりあえずフォントの切り替えを選択するとちゃんとCharSetも同時に比較的簡単に切り替えることができるので、正しくそのフォントで指定することができています。
ScreenFont.zip(197,720bytes)
| EOF | TOP |