プライベートフォント

参照元


redball.gif目次へ戻る

ここでは、アプリケーションにフォントファイルをリソースとして持ち、それを使う例を示す。自分が作ったアプリケーションで使用しているフォントが配布先にあるとは限らないので、そういう場合は Windows 標準のフォントで我慢するか、または、アプリケーション自身がフォントを持つ必要がある。なお、一般にフォントは著作物であり、Free のものでも配布に条件があるものが多いので、その点には十分考慮する必要がある。

フォントファイルを指定してシステムに登録するには、

function AddFontResource(p1: PChar): Integer; stdcall;

を実行する。パラメータには、フォントファイルのフルパスを設定する。成功するとシステムフォントテーブルに追加されたフォントの数が返される。失敗するとゼロが返る。指定できるフォントファイルの拡張子は、MSDN から引用すると以下のようなものである。

.fon    Font resource file.  
.fnt    Raw bitmap font file.  
.ttf    Raw TrueType file.  
.ttc    East Asian Windows: TrueType font collection.  
.fot    TrueType resource file.  
.otf    PostScript OpenType font. 
.mmm    multiple master Type1 font resource file. It must be used with .pfm and .pfb files. 
.pfb    Type 1 font bits file. It is used with a .pfm file. 
.pfm    Type 1 font metrics file. It is used with a .pfb file.

次にしなければならないことは、フォントテーブルが更新されたことをすでに実行中のアプリケーションに知らせることである。これは以下のようにして WM_FONTCHANGE をブロードキャストすることでできる。

SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);

プライベートにしたいときは、これを省略できる。しかし、以降に起動されたワープロなどのアプリには列挙されてしまうので、省略することにはあまり意味はない。Delphi の Screen.Fonts は、このメッセージを受け取って更新されるようだ。アプリケーションを終了するときは、以下の API を実行して、システムフォントテーブルから削除できる。

function RemoveFontResource(p1: PChar): BOOL; stdcall;

パラメータには、AddFontResource() で設定したのと同じファイル名を設定する。この場合も、 WM_FONTCHANGE をブロードキャストする必要がある。RemoveFontResource() を実行しなければ、以降、このフォントはシステムにインストールされたままになる。

以上のように、AddFontResource() してから、RemoveFontResource() するまでの間、このフォントを完全にプライベートにすることはできない。Win2000/XP では、AddFontResourceEx() と RemoveFontResourceEx() を使うと、他のアプリケーションには知られないようにすることができる。しかし、すべてのウィンドウズのバージョンを対象としたアプリケーションでは、このペアは使えない。

それでは試してみよう。ここでは、マイクロソフトの

http://www.microsoft.com/typography/links/default.aspx

から辿って、

Nick's Fonts

の 'Airstream' というフリーフォントをダウンロードして使ってみよう。使用条件は、改変しなければ自分のアプリケーションで使う限りはＯＫのようである。解凍したファイルをアプリケーションを保存しているディレクトリに入れておく。

n02401.gif

最初は、リソースではなく、フォントファイルそのものを使ってみよう。右図のように、Form1 に Label1 と ListBox1、ListBox2 とボタンを二つ置く。そして以下のようにする。



List 1

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ListBox1: TListBox;
    ListBox2: TListBox;
    btnAdd: TButton;
    btnRemove: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure DispFonts(LB:TListBox);
var
  i:integer;
begin
  LB.Clear;
  for i := 0 to Screen.Fonts.Count-1 do
    LB.Items.Add(Screen.Fonts[i]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DispFonts(ListBox1);
end;

procedure TForm1.btnAddClick(Sender: TObject);
begin
  AddFontResource(PChar(ExtractFilePath(ParamStr(0))+'AIRSTREA.TTF'));
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
  DispFonts(ListBox2);

  Label1.Font.Charset:= DEFAULT_CHARSET;
  Label1.Font.Size:=36;
  Label1.Font.Name:= 'Airstream';
  Label1.Caption := 'Airstream';
end;

procedure TForm1.btnRemoveClick(Sender: TObject);
begin
  Label1.Font.Name:= Self.Font.Name;

  RemoveFontResource(PChar(ExtractFilePath(ParamStr(0))+'AIRSTREA.TTF'));
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
  DispFonts(ListBox2);
end;

end.
n02402.gif

実行直後は右図のようになる。


n02403.gif

そして、btnAdd を押すと右図のようになり、Screen.Fonts が更新されていることと、追加したフォントを実際に使用できることが分かるだろう。


n02404.gif

最後に、btnRemove を押すと右図のようになる。やはり、Screen.Fonts が更新され、'Airstream' フォントが使用できなくなっているのが分かる。



最後に、フォントファイルをリソースにしてみよう。008 EXE に埋め込む - リソースの使い方 でやったようにリソーススクリプトファイルを以下のようにする。

MyFont MYFONT "AIRSTREA.TTF"

Form1 に Label1 を置いただけのアプリである。以下に全リストを示す。

List 2

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function GetTempFolderPath:string;
var
  len:integer;
begin
  SetLength(result,MAX_PATH);
  len := GetTempPath(MAX_PATH,PChar(result));
  SetLength(result,len);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  RS:TResourceStream;
begin
  RS := TResourceStream.Create(hInstance,'MyFont','MYFONT');
  RS.SaveToFile(GetTempFolderPath+'AIRSTREA.TTF');
  RS.Free;

  AddFontResource(PChar(GetTempFolderPath+'AIRSTREA.TTF'));

  Label1.Font.Charset:= DEFAULT_CHARSET;
  Label1.Font.Size:=36;
  Label1.Font.Name:= 'Airstream';
  Label1.Caption := 'Halbow''s Home Page';
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  RemoveFontResource(PChar(GetTempFolderPath+'AIRSTREA.TTF'));
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
  DeleteFile(GetTempFolderPath+'AIRSTREA.TTF');
end;

end.
n02405.gif

実行すると右図のようになる。ここでは、ResourceStream で取り出して、Temp フォルダに保存し、それをシステムに登録している。また、アプリケーションを終了するとき、登録を解除し、フォントファイルを削除している。





以上、ここではフォントファイルをリソースにして exe に取り込み、実行時にそれを取り出して使ってみることを試した。

redball.gif目次へ戻る