（fontselect.pas内）
unit fontselect;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
            
            
const
   //デフォルトのフォント名
   DefaultFont : string = 'ＭＳ ゴシック';
var
   //使用するフォント名
   UseFont : string;
            
            
type
            

            
//ダイアログが作成される時に発生するイベント
procedure TFontDialog.FormCreate(Sender: TObject);
            
            
var
   //フォント一覧を呼び出すクラス
   FL : TFontList; ---------------------------------------------(39)
   //フォント一覧を格納するオブジェクト
   AllFont : TStringList;
            
            
begin
            
            
   //デフォルトフォントを通常使用するフォントに設定する
   UseFont := DefaultFont;
   
   //ゲームで使用可能なフォントを取得する
   FL := TFontList.Create;
   AllFont := TStringList.Create;
   try
      FL.GetFontList(AllFont);

      //取得したフォント名一覧をコンボボックスに格納する
      CbxFont.Items := AllFont;
   finally
      //オブジェクトを解放する
      FL.Free;
      AllFont.Free;
   end;
            
            
end;

//-------------------------------------------------------------

//ダイアログが出現したときに呼ばれるイベント
procedure TFontDialog.FormShow(Sender: TObject);
            
            
var
   //ループカウンタ
   i : Integer;
            
            
begin
            
            
   //コンボボックスの中に格納されている
   //フォントの中から、現在選択しているフォントを見つける
   for i := 0 to CbxFont.Items.Count - 1 do
      if CbxFont.Items[i] = UseFont then
      begin
         //選択しているフォント名をコンボボックスに表示
         CbxFont.ItemIndex := i;

         //forループを抜ける
         Break;
      end;
            
            
end;

//-------------------------------------------------------------

//OKボタンを押した時に発生するイベント
procedure TFontDialog.BtnOKClick(Sender: TObject);
begin
            
            
   //選択されているフォント名をUseFontに代入してダイアログを閉じる
   UseFont := CbxFont.Items[Cbxfont.ItemIndex];
            
            
end;
            

procedure TForm1.Button1Click(Sender: TObject);
begin
   ListBox1.Items := Screen.Fonts;
end;

            
(fontlist.pas)
unit fontlist;

interface
            
            
uses
   Windows, Classes;
   
type
   TFontList = class
   public
     procedure GetFontList(p : TStringList);
   end;
            
            
implementation
            
            
//コールバック関数（必要な回数だけWindowsが呼び出す）
function EnumFontFamExProc(var lpelfe : ENUMLOGFONTEX;
                           var lpntme : NEWTEXTMETRIC;
                           FontType : Cardinal;
                           lParam : Integer): Integer; stdcall; ---------(40)
begin
   //True-Typeフォントか
   if (lpntme.tmPitchAndFamily and TMPF_TRUETYPE) > 0 then
      //固定ピッチフォントか
      if (lpelfe.elfLogFont.lfPitchAndFamily and 3) = FIXED_PITCH then
         //横向きのフォントではないか
         if lpelfe.elfLogFont.lfFaceName[0] <> '@' then
            //引数の文字列リストにこのフォント名を追加
            TStrings(lParam).Add(lpelfe.elfLogFont.lfFaceName);

   //関数の戻り値として1を返す
   Result := 1;
end;

procedure TFontList.GetFontList(p : TStringList);
var
   //デバイスコンテキスト
   DC : HDC;
   //フォント情報を指定する構造体
   logfont : TLogFont;
begin

   //取得するフォントの特性を入れる
   logfont.lfCharSet := SHIFTJIS_CHARSET; -------------------------------(41)
   logfont.lfFaceName[0] := #0; -------------|

   //プライマリモニタのデバイスコンテキストを取得する
   DC := GetDC(0);
   try
      //フォントを列挙するAPI関数を呼び出す
      EnumFontFamiliesEx(DC, logfont, @EnumFontFamExProc,
                         Integer(Pointer(p)), 0); -----------------------(42)
   finally
      //デバイスコンテキストを解放する
      ReleaseDC(0, DC);
   end;
end;

            
            
end.
            

            
//フォント変更メニューをクリックしたときに発生するイベント
procedure TMainForm.MnuFontClick(Sender: TObject);
begin
            
            
   //フォント選択ダイアログをモーダル表示し、
   //戻り値がmrOKだったら
   if FontDialog.ShowModal = mrOK then
   begin
      //テキストのフォントを変更する
      TextBmp.Canvas.Font.Name := UseFont;
      //現在のテキストを再描画する
      PutText(TextPoint);
   end;
            
            
end;
            

            
procedure TMainForm.FormCreate(Sender: TObject);
var
   i : Integer;
begin
（中略）
   TextBmp := TBitmap.Create;
   with TextBmp do
   begin
      Width := TEXT_W;
      Height := TEXT_H;
      Canvas.Font.Size := 15;
      Canvas.Brush.Color := clBlack; //塗りつぶし色は黒
      Canvas.Font.Color := clWhite; //文字の色は白
      Transparent := True;
            
            
      Canvas.Font.Name := fontselect.DefaultFont;
            
            
   end;

   AllText := TStringList.Create;
   AllText.LoadFromFile('..\\..\\data\\scenario.txt');
（以下省略）