Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2010年02月27日] [更新 2015年10月31日]　Delphi サンプルプログラム集
884_文字フォントやコードページと文字セットの関係
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
884_FontCharSetCodePages.zip　[5,204 KB]　2015年10月31日版 (EXE 同梱)



  • 2014年06月16日
  • TLanguages を使用した言語ロケールの列挙のサンプルを追加
  • 2015年10月31日
  • 日本語のフォント名を英語 (米国) のフォント名に変換するサンプル等を追加



文字フォントや文字セット等の関係


自分のシステムにどんなフォントがインストールされていて，どんな言語で使用可能なの調べてみました．また，文字コード関係のサンプルプログラムで使用している MLang の関数を使用して同様な調査をするテストプログラムを作成してみました．
以下のプログラムで表示されるリスト，内容は Windows，Windows の [地域と言語] の設定でインストールされている言語，またフォントによって違ってくることになります．
このページでもそうですが，サンプルプログラムの他のページの記事でも「文字コード」と「コードページ」を混合して使用している箇所がありますが，文章の流れで判断していただければと思います．文字コードと Unicode との変換テーブルが「コードページ」です．

このページのコードで使用してる MultiLanguage_TLB.pas は，タイプライブラリの取り込みで作成したものですが，一部，筆者が修正しています．この MultiLanguage_TLB.pas を，ライブラリパスの通ったフォルダに置いて，uses に MultiLanguage_TLB を追加して使用します．あるいは，プロジェクトに追加して使用します．
本ページのサンプルプロジェクトでは，プロジェクトに追加して使用しています．





01_システムの全フォントのリスト


システムにインストールされている全てのフォントと文字セットを列挙します．
Windows API の EnumFontFamiliesEx 関数を使用して取得しています．
結果を見ると，MSゴシック (MS Gothic) がいろいろな言語で使用されていることが分かります．当然ですが，日本以外の国では「MS ゴシック」という名前ではありません．


  • 図1
  • 設計時画面
図1

  • 図2
  • タイトルの列をクリックするとその例をソート (整列) する．これはトグル動作となっている
  • この図は FaceName でソートしたもの
図2

リスト1
システムの全フォントをリスト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Grids, ComCtrls;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
  private
    { Private 宣言 }
    SortColumnIndex : Integer;
    SortColum: array of Integer;
    procedure GetFontCharsetList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  EnumFontFamiliesExのコールバック関数
//=============================================================================
function EnumFontFamExProc(lpelf: PEnumLogFontEx; lpntm: PNewTextMetricEx;
  nFontType: Integer; lParam: LParam):Integer; stdcall;
var
  AFontName   : String;
  FontMaskStr : String;
  AItem       : TListItem;
  CharSetStr  : String;
begin
  //フォント名
  AFontName := lpelf.elfLogFont.lfFaceName;

  //縦書きフォントは除外
  if Pos('@', AFontName) = 0 then begin
    FontMaskStr := '';
    if (nFontType and RASTER_FONTTYPE) = RASTER_FONTTYPE then begin
      FontMaskStr := 'RASTER ';
    end;
    if (nFontType and DEVICE_FONTTYPE) = DEVICE_FONTTYPE then begin
      FontMaskStr := 'DEVICE ';
    end;
    if (nFontType and TRUETYPE_FONTTYPE) = TRUETYPE_FONTTYPE then begin
      FontMaskStr := 'TRUETYPE ';
    end;

    AItem         := Form1.ListView1.Items.Add;
    AItem.Caption := FontMaskStr;
    AItem.SubItems.Add(lpelf.elfStyle);
    AItem.SubItems.Add(AFontName);
    AItem.SubItems.Add(lpelf.elfScript);

    case lpelf.elfLogFont.lfCharSet of
        0:  CharSetStr := 'ANSI_CHARSET';
        1:  CharSetStr := 'DEFAULT_CHARSET';
        2:  CharSetStr := 'SYMBOL_CHARSET';
      128:  CharSetStr := 'SHIFTJIS_CHARSET';
      129:  CharSetStr := 'HANGEUL_CHARSET';
      134:  CharSetStr := 'GB2312_CHARSET';
      136:  CharSetStr := 'CHINESEBIG5_CHARSET';
      255:  CharSetStr := 'OEM_CHARSET ';
      130:  CharSetStr := 'JOHAB_CHARSET';
      177:  CharSetStr := 'HEBREW_CHARSET';
      178:  CharSetStr := 'ARABIC_CHARSET';
      161:  CharSetStr := 'GREEK_CHARSET';
      162:  CharSetStr := 'TURKISH_CHARSET';
      163:  CharSetStr := 'VIETNAMESE_CHARSET';
      222:  CharSetStr := 'THAI_CHARSET';
      238:  CharSetStr := 'EASTEUROPE_CHARSET';
      204:  CharSetStr := 'RUSSIAN_CHARSET';
       77:  CharSetStr := 'MAC_CHARSET';
      186:  CharSetStr := 'BALTIC_CHARSET';
    else
      CharSetStr := '';
    end;
    AItem.SubItems.Add(CharSetStr);
  end;

  //列挙を継続
  Result := 1;
end;

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  i : Integer;
begin
  //ListViewの各カラムの幅とタイトルを設定
  ListView1.Column[0].Width   := 80;
  ListView1.Column[0].Caption := 'FontType';
  ListView1.Column[1].Width   := 80;
  ListView1.Column[1].Caption := 'Style';
  ListView1.Column[2].Width   := 140;
  ListView1.Column[2].Caption := 'FaceName';
  ListView1.Column[3].Width   := 130;
  ListView1.Column[3].Caption := 'Script';
  ListView1.Column[4].Width   := 170;
  ListView1.Column[4].Caption := 'CharSet';

  //SortColumはソート用のInteger配列
  //カラムの数だけ配列要素を確保
  SetLength(SortColum, ListView1.Columns.Count);
  //ソート順の値を格納しておく
  //実際には1でも0でOK(ソート後に負の値にする)
  for i := 0 to Length(SortColum) - 1 do begin
    SortColum[i] := 1;
  end;

  //フォントのリスト作成
  GetFontCharsetList;

  StatusBar1.Panels[0].Text := '　列挙数: ' + IntToStr(ListView1.Items.Count);
end;

//=============================================================================
//  システムの全てのフォント名をリストするメソッド
//=============================================================================
procedure TForm1.GetFontCharsetList;
var
  DC       : HDC;
  ALogFont :  TLOGFONT;
begin
  ListView1.Clear;

  DC := GetDC(0);
  try
    //ALogFontの設定
    //ここでは全てのフォントのリストを取得する設定
　　//フォント名だけのリストを取得する関数はEnumFontFamilies
    ALogFont.lfCharSet        := DEFAULT_CHARSET;
    ALogFont.lfFaceName       := '';
    ALogFont.lfPitchAndFamily := 0;

    EnumFontFamiliesEx(DC, ALogFont, @EnumFontFamExProc, 0, 0);
  finally
    ReleaseDC(Handle, DC);
  end;
end;

//=============================================================================
//  OnColumnClickイベント
//  クリックした列のソートを実行
//=============================================================================
procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  SortColumnIndex := Column.Index;
  //AlphaSortメソッドは，OnCompareイベントの定義があればそれを実行する
  ListView1.AlphaSort;

  //次のクリックに備えてソート順番を逆にしておく
  SortColum[SortColumnIndex] := -SortColum[SortColumnIndex];
end;

//=============================================================================
//  OnCompareイベント
//  クリックした列のソートを実行
//
//  本サンプルのListViewは仮想リストビューではないのでこのようにイベントで処理
//  できる
//=============================================================================
procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
var
  Str1   : String;
  Str2   : String;
  AIndex : Integer;
begin
  if SortColumnIndex = 0 then begin
    Str1 := Item1.Caption;
    Str2 := Item2.Caption;
  end else begin
    //SubItemのIndexは0,1,2,...
    AIndex := SortColumnIndex - 1;
    Str1   := Item1.SubItems[AIndex];
    Str2   := Item2.SubItems[AIndex];
  end;
  Compare := SortColum[SortColumnIndex] * CompareText(Str1, Str2);
end;

end.


Charset の定数名の列挙だけであれば，GetCharsetValues メソッドを使用して，以下のように取得できます．


図7 図3
Charset の定数名の列挙		 

var
  CharSetList : TStringList;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CharSetList := TStringList.Create;
  try
    Graphics.GetCharsetValues(AddCharacterSet);
    CharSetList.Sort;
    ListBox1.Items := CharSetList;
  finally
    FreeAndNil(CharSetList);
  end;
end;

procedure TForm1.AddCharacterSet(const S: string);
begin
  CharSetList.Add(S);
end;


Charset の定数の文字列は，CharsetToIdent メソッドを使用して取得できます．
この関数では VIETNAMESE_CHARSET (= 163) が取得できないので，本ページのサンプルでは使用していません．最初のコードのように，コード中で文字列をセットしています．
最初のサンプルコードで使用している CharSet の値と文字列は，Windows SDK 8.1 の wingdi.h に記載されている全てです．


図7 図4
Charset 定数の文字列の取得

  • CharsetToIndent を使用
 

procedure TForm1.Button1Click(Sender: TObject);
var
  i       : Integer;
  SetName : String;
begin
  ListBox1.Items.Clear;
  ListBox1.Sorted := True;

  for i := Low(TFontCharset) to High(TFontCharset) do begin
    if Graphics.CharsetToIdent(i, SetName) then begin
      if Trim(SetName) <> '' then begin
        ListBox1.Items.Add(Format('%3s', [IntToStr(i)]) + '  ' + SetName);
      end;
    end;
  end;
end;


また，システムで使用可能なフォント名を列挙するだけであれば，以下のコードで可能です．


図7 図5
システムで使用可能なフォント名のリスト		 

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



02_システムのコードページリスト


次はシステムがサポートするコードページと，実際にインストールされているコードページを列挙するサンプルです．EnumSystemCodePage 関数を使用しています．
MaxCharSize はその文字コードの 1 文字が使用する最大バイト数です．また DefaultChar は，該当する文字コード (その言語で正常かどうかとは無関係) がない場合等に表示する文字です．


  • 図6
  • 設計時画面
図3

  • 図7
  • 実行結果
  • UTF-8 は最大 4 バイト使用する
図4

リスト2
システムのコードページのリスト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Grids, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ComboBox1: TComboBox;
    StatusBar1: TStatusBar;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure GetSystemCodePageList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//-----------------------------------------------------------------------------
//  EnumSystemCodePagesのコールバック関数
//
//  GetCPInfoEx関数の引数値
//  CP_ACP   システム既定のANSI コードページの情報取得
//  CP_MACCP システム既定のMacintosh コードページの情報取得
//  CP_OEMCP システム既定のOEMコードページの情報取得
//-----------------------------------------------------------------------------
function EnumCodePagesProc(CodeStr: PChar): Integer; stdcall;
var
  Str    : String;
  CpInfo : TCPINFOEX;
  AItem  : TListItem;
begin
  //コールバックが返したコードページ値からコードページの情報を取得
  Str := CodeStr;
  GetCPInfoEx(StrToInt(Str), CP_ACP, CpInfo);

  AItem := Form1.ListView1.Items.Add;

  //コードページの値
  AItem.Caption := Format('%7s', [CodeStr]);
  //コードページ名
  AItem.SubItems.Add(CpInfo.CodePageName);
  //コードページの文字が使用する最大バイト数
  AItem.SubItems.Add(IntToStr(CpInfo.MaxCharSize));
  //デフォルトで表示される文字(?とかドット文字のこと)
  AItem.SubItems.Add(CpInfo.UnicodeDefaultChar);

  //コールバックの呼出し継続
  Result := 1;
end;

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  AColumn : TListColumn;
begin
  ComboBox1.Style := csDropDownList;
  ComboBox1.Items.BeginUpdate;
  ComboBox1.Items.AddObject('CP_INSTALLED', TObject(CP_INSTALLED));
  ComboBox1.Items.AddObject('CP_SUPPORTED', TObject(CP_SUPPORTED));
  ComboBox1.Items.EndUpdate;
  ComboBox1.ItemIndex := 0;

  //カラム(列)の設定
  AColumn := ListView1.Columns.Add;
  AColumn.Width   := 80;
  AColumn.Caption := 'CodePage';

  AColumn := ListView1.Columns.Add;
  AColumn.Width   := 235;
  AColumn.Caption := 'CodePageName';

  AColumn := ListView1.Columns.Add;
  AColumn.Width   := 85;
  AColumn.Caption := 'MaxCharSize';

  AColumn := ListView1.Columns.Add;
  AColumn.Width   := 85;
  AColumn.Caption := 'DefaultChar';

  ListView1.SortType := stText;
  //列挙用メソッド実行
  GetSystemCodePageList;
  ListView1.SetFocus;
end;

//=============================================================================
//  システムのコードページを列挙するメソッド
//  EnumSystemCodePages関数を使用
//
//  EnumSystemCodePagesの第2引数のFlagは
//  CP_INSTALLED インストールされているコードページだけの列挙
//  CP_SUPPORTED システムがサポートするコードページの列挙
//=============================================================================
procedure TForm1.GetSystemCodePageList;
var
  Flag : Cardinal;
begin
  Screen.Cursor := crHourGlass;

  StatusBar1.Panels[0].Text := '';
  StatusBar1.Update;

  ListView1.Clear;
  ListView1.Update;
  ListView1.Items.BeginUpdate;

  //Flagの指定
  Flag := Integer(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
  //コールバック関数を呼出して列挙
  EnumSystemCodePages(@EnumCodePagesProc, Flag);

  StatusBar1.Panels[0].Text := '　列挙数: ' + IntToStr(ListView1.Items.Count);
  Screen.Cursor := crDefault;

  ListView1.Items.EndUpdate;
end;

//=============================================================================
//  コンボボックスで選択したらリストを再取得
//=============================================================================
procedure TForm1.ComboBox1Click(Sender: TObject);
begin
  //列挙用メソッド実行
  GetSystemCodePageList;
  ListView1.SetFocus;
end;

end.



03_MLang がサポートするコードページ


MLang.dll は IE 等の表示関係で使用される DLL です．この MLang の関数を使用して利用可能なコードページのリストを取得するサンプルです．これは MLang を使用するアプリで使用可能なコードページということになります．
IMultiLanguage の IEnumCodePage インターフェイスの EnumCodePages 関数を使用しています．この関数を実行して得られる TMIMECPINFO 構造体から情報を取得しています．


  • 図8
  • 設計時画面
図5

  • 図9
  • 実行結果
  • コンボボックスのリストは列挙タイプの指定
図6

リスト3
MLang がサポートするコードページのリスト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Grids, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ComboBox1: TComboBox;
    StatusBar1: TStatusBar;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure GetMlangCodePageList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MultiLanguage_TLB, ActiveX, ComObj;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  AColumn : TListColumn;
begin
  ComboBox1.Clear;
  ComboBox1.Items.BeginUpdate;

  //列挙タイプの選択項目
  //内容についてはMSDNの記事参照
  ComboBox1.Items.AddObject('dwFlag=0x0000',              TObject($00000000));
  ComboBox1.Items.AddObject('MIMECONTF_MAILNEWS',         TObject($00000001));
  ComboBox1.Items.AddObject('MIMECONTF_BROWSER',          TObject($00000002));
  ComboBox1.Items.AddObject('MIMECONTF_MINIMAL',          TObject($00000004));
  ComboBox1.Items.AddObject('MIMECONTF_IMPORT',           TObject($00000008));
  ComboBox1.Items.AddObject('MIMECONTF_SAVABLE_MAILNEWS', TObject($00000100));
  ComboBox1.Items.AddObject('MIMECONTF_SAVABLE_BROWSER',  TObject($00000200));
  ComboBox1.Items.AddObject('MIMECONTF_EXPORT',           TObject($00000400));
  ComboBox1.Items.AddObject('MIMECONTF_PRIVCONVERTER',    TObject($00010000));
  ComboBox1.Items.AddObject('MIMECONTF_VALID',            TObject($00020000));
  ComboBox1.Items.AddObject('MIMECONTF_VALID_NLS',        TObject($00040000));
  ComboBox1.Items.AddObject('MIMECONTF_MIME_IE4',         TObject($10000000));
  ComboBox1.Items.AddObject('MIMECONTF_MIME_LATEST',      TObject($20000000));
  ComboBox1.Items.AddObject('MIMECONTF_MIME_REGISTRY',    TObject($40000000));

  ComboBox1.ItemIndex := 0;
  ComboBox1.Items.EndUpdate;

  //カラム設定
  //MultiLaunguage_TLB.pas内の記述順
  AColumn := ListView1.Columns.Add;
  AColumn.width   := 90;
  AColumn.Caption := 'CodePage';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 120;
  AColumn.Caption := 'FamilyCodePage';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 200;
  AColumn.Caption := 'Description';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 100;
  AColumn.Caption := 'WebCharset';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 150;
  AColumn.Caption := 'HeaderCharset';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 150;
  AColumn.Caption := 'BodyCharset';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 150;
  AColumn.Caption := 'FixedWidthFont';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 150;
  AColumn.Caption := 'ProportionalFont';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 160;
  AColumn.Caption := 'GDICharset';

  ListView1.SortType := stText;
  GetMlangCodePageList;
end;

//=============================================================================
//  MLangのEnumCodePages関数でコードページ情報の列挙するメソッド
//=============================================================================
procedure TForm1.GetMlangCodePageList;
var
  MLang        : IMultiLanguage;
  EnumCodePage : IEnumCodePage;
  Flags        : DWORD;
  Fetched      : ULONG;
  MIMECPInfo   : TMIMECPINFO;
  CodePageStr  : String;
  CharsetStr   : String;
  AItem        : TListItem;
begin
  Screen.Cursor := crHourGlass;

  StatusBar1.Panels[0].Text := '';
  StatusBar1.Update;

  ListView1.Clear;
  ListView1.Update;
  ListView1.Items.BeginUpdate;

  //列挙タイプを指定するFlagsの設定
  //Flagの内容についてはMSDNの記事参照
  Flags := Integer(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);

  //IMultiLanguageオブジェクトの作成
  MLang := CoCMultiLanguage.Create;
  if MLang <> nil then begin
    //IEnumCodePageインターフェース取得
    MLang.EnumCodePages(Flags, EnumCodePage);

    //コードページを1個づつ列挙
    while EnumCodePage.Next(1, MIMECPInfo, Fetched) = S_OK do begin
      //MultiLaunguage_TLB.pas内の記述順
      AItem := ListView1.Items.Add;
      CodePageStr   := IntToStr(MIMECPInfo.uiCodePage);
      AItem.Caption := Format('%7s', [CodePageStr]);

      AItem.SubItems.Add(IntToStr(MIMECPInfo.uiFamilyCodePage));
      AItem.SubItems.Add(MIMECPInfo.wszDescription);
      AItem.SubItems.Add(MIMECPInfo.wszWebCharset);
      AItem.SubItems.Add(MIMECPInfo.wszHeaderCharset);
      AItem.SubItems.Add(MIMECPInfo.wszBodyCharset);
      AItem.SubItems.Add(MIMECPInfo.wszFixedWidthFont);
      AItem.SubItems.Add(MIMECPInfo.wszProportionalFont);

      //Charset
      //リストはDelphi2010のWindows.pas内で定義のもの
      case MIMECPInfo.bGDICharset of
          0:  CharSetStr := 'ANSI_CHARSET';
          1:  CharSetStr := 'DEFAULT_CHARSET';
          2:  CharSetStr := 'SYMBOL_CHARSET';
        128:  CharSetStr := 'SHIFTJIS_CHARSET';
        129:  CharSetStr := 'HANGEUL_CHARSET';
        134:  CharSetStr := 'GB2312_CHARSET';
        136:  CharSetStr := 'CHINESEBIG5_CHARSET';
        255:  CharSetStr := 'OEM_CHARSET ';
        130:  CharSetStr := 'JOHAB_CHARSET';
        177:  CharSetStr := 'HEBREW_CHARSET';
        178:  CharSetStr := 'ARABIC_CHARSET';
        161:  CharSetStr := 'GREEK_CHARSET';
        162:  CharSetStr := 'TURKISH_CHARSET';
        163:  CharSetStr := 'VIETNAMESE_CHARSET';
        222:  CharSetStr := 'THAI_CHARSET';
        238:  CharSetStr := 'EASTEUROPE_CHARSET';
        204:  CharSetStr := 'RUSSIAN_CHARSET';
         77:  CharSetStr := 'MAC_CHARSET';
        186:  CharSetStr := 'BALTIC_CHARSET';
      else
        CharSetStr := '';
      end;
      AItem.SubItems.Add(CharsetStr);
    end;
  end;
  MLang := nil;

  StatusBar1.Panels[0].Text := '　列挙数: ' + IntToStr(ListView1.Items.Count);
  Screen.Cursor := crDefault;

  ListView1.Items.EndUpdate;
  ListView1.SetFocus;
  if ListView1.Items.Count > 0 then ListView1.ItemIndex := 0;
end;

//=============================================================================
//  列挙タイプのリストを選択したら，列挙を再取得
//=============================================================================
procedure TForm1.ComboBox1Click(Sender: TObject);
begin
  GetMlangCodePageList;
end;

end.



04_RFC 1766 のリスト


HTML コードで，言語名を識別するための <HTML> タグの lang 属性を規定する RFC1766 の一覧を取得するサンプルプログラムです．
IMultiLanguage の IEnumRfc1766 インターフェイスを使用しています．各項目値は TRFC1766INFO 構造体から取得しています．


図7 図10
設計時画面
図8 図11
実行結果

  • 日本語は ja だけ

リスト4
RFC1766 の言語識別タグ文字リスト 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Grids, ComCtrls;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MultiLanguage_TLB, ActiveX, ComObj;

{$R *.dfm}

//=============================================================================
//  フォーム表示開始時の処理
//  表示開始と同時に言語名識別タグRfc1766(Request For Comments 1766)を列挙
//  現在はRFC 3066(BCP47),RFC 3282
//
//  1次言語タグ
//  ISO 639で規定される2文字の言語コード
//  -に続く)2次タグ
//  国名コード．1次タグがxの場合は任意実装
//
//  lcidはwindows内部定義の値
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  AColumn      : TListColumn;
  MLang        : IMultiLanguage;
  EnumCodePage : IEnumRfc1766;
  Fetched      : ULONG;
  Rfc1766Info  : TRFC1766INFO;
  AItem        : TListItem;
begin
  Screen.Cursor := crHourGlass;

  StatusBar1.Panels[0].Text := '';
  StatusBar1.Update;

  ListView1.Clear;
  ListView1.Update;
  ListView1.Items.BeginUpdate;

  //カラムの設定
  AColumn := ListView1.Columns.Add;
  AColumn.width   := 60;
  AColumn.Caption := 'lcid';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 220;
  AColumn.Caption := 'LocaleName';

  AColumn := ListView1.Columns.Add;
  AColumn.width   := 70;
  AColumn.Caption := 'Rfc1766';

  //IMultiLanguageオブジェクトの作成
  MLang := CoCMultiLanguage.Create;
  //インターフェースの実装を確認
  if MLang <> nil then begin
    //IEnumCodePageインターフェース取得
    MLang.EnumRfc1766(EnumCodePage);

    //コードページを1個づつ列挙
    while EnumCodePage.Next(1, Rfc1766Info, Fetched) = S_OK do begin
      AItem := ListView1.Items.Add;
      AItem.Caption := IntToStr(Rfc1766Info.lcid);
      AItem.SubItems.Add(Rfc1766Info.wszLocaleName);
      AItem.SubItems.Add(Rfc1766Info.wszRfc1766);
    end;
  end;
  MLang := nil;

  StatusBar1.Panels[0].Text := '　列挙数: ' + IntToStr(ListView1.Items.Count);
  Screen.Cursor := crDefault;

  ListView1.Items.EndUpdate;
  ListView1.SetFocus;
  if ListView1.Items.Count > 0 then ListView1.ItemIndex := 0;
end;

end.



05_コードページと文字セットと


各々の文字が，どんな言語または文字セット (Charset) で使用できるのか，またサポートしているのかを確認するためのテストプログラムです．使用可能なフォント名は，面倒ですが最初のサンプルプログラムを使用すると確認することができます．こんなテストも Unicode 化されたからこそ意味があるのかも知れません．
何かのテストで利用可能なように (必要性はともかく)，文字のコピー機能を付けてみました．


  • 図12
  • 設計時画面
  • 左端は文字一覧表示用の ListView
  • 中央はその文字が使用可能な言語と文字セットの一覧表示用の ListView
  • 右端は文字の拡大表示用の Label
図9

  • 図13
  • ひらがなの「あ」は中国語と韓国語でも使用可能となっている

  • 図14
  • 半角のカタカナはさすがに日本語だけ
図11

  • 図15
  • いわゆる○囲み数字もほとんど漢字使用圏だけ
図11

  • 図16
  • アルファベットの A は多くの言語で使用されている
図12

  • 図17
  • 現システムでコードページがサポートされていない (?)．代替フォントで表示される例
図13

他の国のテキストを表示した場合，現在設定中のフォントでは表示できないと，少し字体が潰れた様に表示されることがあります．こは代替フォントを使用して表示するためです．上の図もそうです．
このことを再確認したのが以下の図です．全く表示できない場合は，DefaultChar の文字で表示されることになります．
文書作成用アプリでは，代替フォントを使用しないものもあります．もっとも，代替フォントを使用されてしまうと，フォント名指定の意味がなくなってしまう気もします．


図14 図18
現在のフォント Tahoma では表示できない文字

  • Tahoma はゴシック体であるが，明朝体のようになっている．これは代替フォント
  • しかも上が少し空いている
図15 図19
表示用フォントを SimHei に変更

  • Description (この図では非表示) の値で言語を推測
  • Simhei フォントを使用するには，Charset を CHINESE_GB2312 にする
  • システムにインストールされている全フォントのリストから知ることができる

上の 2 つの図の内，最初の図は，表示コントロールの TFont.Charset の値を DEFAULT_CHARSET にした場合です．TFont.Charset の値を SHIFTJIS_CHARSET すると下図のようになります．
下図のように，フォントセットを明示的に設定した場合は，指定したフォントで表示できない文字は DefaulChar で表示されます．代替フォントでの表示はしません．



図14 図20
代替フォントを使用しない場合

  • 文字コードは上の図と同じ U+FADD
  • TFont.Charset が SHIFTJIS_CHARSET の場合

以上の文字の他，例えば「𠮷野家」という文字が，フォントによってどのように違うかを，次のコードで確認してみるといいのではないかと思います．𠮷野家の「𠮷」はサロゲートペアな文字です．冠が「土」と同じで，下が長くなっています．
また，「#$00020BB7 + '野家'」 と「吉野家」との違いを試してみるのもいいかも知れません．		 


procedure TForm1.Button2Click(Sender: TObject);
var
  StrText : String;
begin
  StrText := #$00020BB7 + '野家';

  Panel1.Font.Name := 'メイリオ';  //このフォント名を変更してみる
  Panel1.Font.Size := 25;
  Panel1.Caption   := StrText;
  Label1.Caption   := Panel1.Font.Name;
  Label2.Caption   := IntToStr(Length(StrText));

  //サロゲートペアの文字を含む上の結果は4
  //MECSUtilsのMecsLengthを使用すれば，実際の表示の文字数である3となる
  Label3.Caption := IntToStr(MecsLength(StrText));
end;


リスト5
文字とコードページと文字セット 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Grids, ComCtrls, Generics.Collections,
  Menus;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    ListView1: TListView;
    ListView2: TListView;
    ComboBox1: TComboBox;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    PopupMenu1: TPopupMenu;
    popupCopy: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure ComboBox1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure popupCopyClick(Sender: TObject);
  private
    { Private 宣言 }
    ItemList : TList<WORD>;
    procedure ShowCodePagesList;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses MultiLanguage_TLB, ActiveX, ComObj, Clipbrd;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  EnumFontFamiliesのコールバック関数
//-----------------------------------------------------------------------------
function EnumFontFamProc(lpelf: PEnumLogFont; lpntm: PNewTextMetric;
  nFontType: Integer; lParam: LParam):Integer; stdcall;
var
  AFontName  : String;
begin
  Result := 1;

  AFontName := lpelf.elfLogFont.lfFaceName;
  //縦書き用フォントは除外
  if Pos('@', AFontName) = 0 then begin
    Form1.ComboBox1.Items.Add(AFontName);
  end;
end;

//=============================================================================
//  フォーム表示開始時の処理
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  DC     : HDC;
  AIndex : Integer;
  i      : Integer;
begin
  CheckBox1.Checked := True;

  //文字コードポイント格納用リスト
  ItemList := TList<WORD>.Create;

  //文字ポイント表示用のListViewの設定
  //カラムは設計時に設定すみ
  ListView1.Column[0].Width   := ListView1.ClientWidth
                                 - GetSystemMetrics(SM_CXHSCROLL);
  ListView1.Column[0].Caption := 'CodePoint';

  //コードページ一覧表示用ListViewの設定
  //カラムは設計時に設定すみ
  ListView2.Column[0].Width   := 70;
  ListView2.Column[0].Caption := 'CodePage';
  ListView2.Column[1].Width   := 160;
  ListView2.Column[1].Caption := 'Description';
  ListView2.Column[2].Width   := 150;
  ListView2.Column[2].Caption := 'GDICharset';

  //フォント名リストの作成
  //全フォントのリストを取得する関数はEnumFontFamiliesEx
  ComboBox1.Clear;
  ComboBox1.Sorted := True;
  DC := GetDC(Handle);
  try
    EnumFontFamilies(DC, nil, @EnumFontFamProc, 0);
    AIndex := ComboBox1.Items.IndexOf(Label1.Font.Name);
    ComboBox1.ItemIndex := AIndex;
  finally
    ReleaseDC(Handle, DC);
  end;

  //文字(コードポイント)一覧の作成
  //このサンプルでは文字一覧表示のListViewを仮想リストビューとしているので
  //このメソッドではItemListというリストに格納するだけ
  //実際の描画はListViewのOnDataイベント内で行っている
  Screen.Cursor := crHourGlass;
  ListView1.Clear;

  Label1.Caption := '';
  Label1.Update;

  for i := 0 to $FFFF -1 do begin
    ItemList.Add(WORD(i));
  end;
  //ListViewに表示数を通知する
  //仮想リストビューではこの通知で実際の描画が行われる
  ListView1.Items.Count := ItemList.Count;

  Screen.Cursor := crDefault;
  ListView1.SetFocus;

  StatusBar1.Panels[0].Text := '　列挙数: ' + IntToStr(ItemList.Count);
end;

//=============================================================================
//  オブジェクトの破棄
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(ItemList);
end;

//=============================================================================
//  ListView1のOnDataイベント
//  文字コードポイント値とその文字をItemのCaptionに表示
//
//  ListViewの各Itemの描画が必要となった場合に発生
//  このイベントはListView1.OwnerData:=Trueでないと機能しない
//=============================================================================
procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
var
  dwCode : WORD;
begin
  if Item.Index > ItemList.Count then exit;

  dwCode := ItemList[Item.Index];
  Item.Caption := Format('U+%4.4x  ', [dwCode]) + Chr(dwCode);
end;

//=============================================================================
//  ListView1のOnSelectItemイベント
//  選択した文字をLabelに表示
//=============================================================================
procedure TForm1.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if Item = nil then exit;

  Label1.Caption := Chr(ItemList[Item.Index]);
  //その文字をサポートしているコードページ一覧を表示
  ShowCodePagesList;
end;

//=============================================================================
//  CheckBox1のOnClickイベント
//  チェックボックスのチェックを外したらコードページを非表示
//
//  サイトの記事作成用(文字コードポイントとその表示文字の確認用)
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  ListView2.Visible := CheckBox1.Checked;
  if ListView2.Visible then begin
    Self.Width  := 646;
    Self.Height := 350;
  end else begin
    Self.Width  := 250;
    Self.Height := 240;
  end;
end;

//=============================================================================
//  ComboBox1のOnClickイベント
//  コンボボックスでフォント名を選択したらそのフォントで文字を再表示
//
//  サイトの記事作成用．なくても動作そのものに関係なし
//=============================================================================
procedure TForm1.ComboBox1Click(Sender: TObject);
begin
  Label1.Font.Name := ComboBox1.Items[ComboBox1.ItemIndex];
  ListView1.SetFocus;
end;

//=============================================================================
//  文字を拡大表示しているLabelのポップアップメニュー
//  文字をクリップボードにコピー
//  コピーしても，貼り付け先のアプリによつては正常に表示されるとは限らない
//  CharSeetから，そのCharsetに応じたフォントを選択しなければならない場合もある
//
//  筆者のテスト用．なくても動作そのものには関係なし
//=============================================================================
procedure TForm1.popupCopyClick(Sender: TObject);
var
  AClipbrd : TClipboard;
begin
  AClipbrd := TClipboard.Create;
  try
    AClipbrd.SetTextBuf(PChar(Label1.Caption));
  finally
    AClipbrd.Free;
  end;
end;

//=============================================================================
//  ListView1で選択した文字をサポートするコードページの一覧表示用メソッド
//=============================================================================
procedure TForm1.ShowCodePagesList;
var
  AIndex         : Integer;
  MLang          : IMultiLanguage;
  MLangCodePages : IMLangCodePages;
  dwCode         : DWORD;
  pdwCodePages   : DWORD;
  CodePage       : UINT;
  TempCodePages  : UINT;
  MIMECPInfo     : TMIMECPINFO;
  CharsetStr     : String;
  AItem          : TListItem;
begin
  ListView2.Clear;
  ListView2.Update;
  ListView2.Items.BeginUpdate;

  AIndex := ListView1.Selected.Index;
  if AIndex < 0 then exit;

  //iMultiLanguageオブジェクトの作成
  MLang := CoCMultiLanguage.Create;
  //インターフェースの実装を確認
  if MLang <> nil then begin
    if MLang.QueryInterface(IID_IMLangCodePages, MLangCodePages) = S_OK then begin
      dwCode := ItemList[AIndex];
      MLangCodePages.GetCharCodePages(dwCode, pdwCodePages);

      while pdwCodePages > 0 do begin
        MLangCodePages.CodePagesToCodePage(pdwCodePages, CP_ACP, CodePage);
        //取り出されたコードページの情報を取得
        MLang.GetCodePageInfo(CodePage, MIMECPInfo);
        //取得した情報を表示
        AItem := ListView2.Items.Add;
        AItem.Caption := IntToStr(MIMECPInfo.uiCodePage);

        AItem.SubItems.Add(MIMECPInfo.wszDescription);

        //Charset
        //Delphi2010のwindows.pas内で定義されているもの
        case MIMECPInfo.bGDICharset of
            0:  CharSetStr := 'ANSI_CHARSET';
            1:  CharSetStr := 'DEFAULT_CHARSET';
            2:  CharSetStr := 'SYMBOL_CHARSET';
          128:  CharSetStr := 'SHIFTJIS_CHARSET';
          129:  CharSetStr := 'HANGEUL_CHARSET';
          134:  CharSetStr := 'GB2312_CHARSET';
          136:  CharSetStr := 'CHINESEBIG5_CHARSET';
          255:  CharSetStr := 'OEM_CHARSET ';
          130:  CharSetStr := 'JOHAB_CHARSET';
          177:  CharSetStr := 'HEBREW_CHARSET';
          178:  CharSetStr := 'ARABIC_CHARSET';
          161:  CharSetStr := 'GREEK_CHARSET';
          162:  CharSetStr := 'TURKISH_CHARSET';
          163:  CharSetStr := 'VIETNAMESE_CHARSET';
          222:  CharSetStr := 'THAI_CHARSET';
          238:  CharSetStr := 'EASTEUROPE_CHARSET';
          204:  CharSetStr := 'RUSSIAN_CHARSET';
           77:  CharSetStr := 'MAC_CHARSET';
          186:  CharSetStr := 'BALTIC_CHARSET';
        else
          CharSetStr := '';
        end;
        AItem.SubItems.Add(CharsetStr);

        MLangCodePages.CodePageToCodePages(CodePage, TempCodePages);
        //処理したpdwCodePagesの値は0にする
        pdwCodePages := pdwCodePages and (not TempCodePages);
      end;
    end;
  end;
  MLang := nil;
  ListView2.Items.EndUpdate;
end;

end.



06_代替フォント


代替フォントですが，MLang に IMLangFontLink というインターフェイスがあり，MapFont という関数があります．これを使用すると知ることができるかも知れません．
今回はこの動作については確認しませんでした．他のサンプルプログラムの記事でも書いていますが，文字コードの違うテキスト等は，適切なコードページとフォントを指定して処理する方がいいのではないかと思います．全く文字コードが不明な場合の完全な対処方法は，現在のところ困難なのではないでしょうか．





07_TLanguages を使用した言語ロケールの列挙


アプリケーションによっては，コードページと言語ロケールの情報が必要な場合があります．
ここまでのサンプルで，コードページを列挙するテストをしました．本サンプルは，現在のシステムがサポートしている言語ロケールを列挙します．
SysUtils の TLanguages クラスを利用したサンプルです．TLanguages を使用すると，言語ロケールや言語名等が取得できます．

MSDN オンイランでは，言語ロケールとコードページ関係の記事は，下記の MSDN のリンクの [国別言語サポート (National Language Support)] のページにあります．



  • 図21
  • 設計時画面

  • 図22
  • 実行結果

リスト6
システムがサポートしている言語ロケールの情報を列挙		 
unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TListViewのカラムを作成して，各カラムの設定を行う
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.ViewStyle := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  ListView1.Columns.Add;

  //ListViewの各カラムの幅とタイトルを設定
  ListView1.Column[0].Caption := 'Name';
  ListView1.Column[0].Width   := 280;
  ListView1.Column[1].Caption := 'ID';
  ListView1.Column[1].Width   := 80;
  ListView1.Column[2].Caption := 'LocaleName';
  ListView1.Column[2].Width   := 70;
  ListView1.Column[3].Caption := 'LocaleID';
  ListView1.Column[3].Width   := 70;
  ListView1.Column[4].Caption := 'Ext';
  ListView1.Column[4].Width   := 50;

  Label1.Caption := '';
end;

//=============================================================================
//  TLanguagesを使用して，システムがサポートしている言語ロケールを列挙
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LangList : TLanguages;
  i        : Integer;
  AItem    : TListItem;
begin
  ListView1.SortType := stText;
  ListView1.Items.Clear;
  ListView1.Items.BeginUpdate;

  LangList := TLanguages.Create;
  try
    Label1.Caption := 'Count : ' + IntToStr(LangList.Count);
    for i := 0 to LangList.Count - 1 do begin
      AItem := ListView1.Items.Add;

      AItem.Caption := LangList.Name[i];
      AItem.SubItems.Add(LangList.ID[i]);
      AItem.SubItems.Add(LangList.LocaleName[i]);
      AItem.SubItems.Add(IntToStr(LangList.LocaleID[i]));
      AItem.SubItems.Add(LangList.Ext[i]);
    end;
  finally
    LangList.Free;
  end;
  ListView1.Items.EndUpdate;
end;

end.


現在のユーザの言語ロケールの情報は，下のコードで取得できます．
まず，GetUserDefaultLCID で，現在のユーザの既定の言語ロケール識別子を取得します．その値を元にしてその他の値を取得します．上のコードと同じく，TLanguages クラスを使用しています．

指定した言語のロケール名を取得する方法は，この後のサンプルを参考にしてください．



図15 図23
実行結果

リスト7
現在のユーザの，既定の言語ロケールの情報を取得		 
//=============================================================================
//  ユーザーの既定ロケール識別子を取得して，それを元に言語名等を取得する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LangList     : TLanguages;
  LangListNo   : Integer;
  UserLocaleID : Cardinal;
  AItem        : TListItem;
begin
  LangList := TLanguages.Create;
  try
    UserLocaleID := GetUserDefaultLCID;
    LangListNo   := LangList.IndexOf(UserLocaleID);

    ListView1.Items.Clear;
    AItem := ListView1.Items.Add;

    //LangList.NameFromLocaleID[UserLocaleID];でも同じ
    AItem.Caption := LangList.Name[LangListNo];

    AItem.SubItems.Add(LangList.ID[LangListNo]);
    AItem.SubItems.Add(LangList.LocaleName[LangListNo]);
    AItem.SubItems.Add(IntToStr(LangList.LocaleID[LangListNo]));
    AItem.SubItems.Add(LangList.Ext[LangListNo]);
  finally
    LangList.Free;
  end;
end;



08_IDWriteFontCollection を使用したフォント名の列挙 - Direct2D


Direct2D に実装されている IDWriteFontCollection インターフェイスを使用して，システムにインストールされているフォント名を列挙します． また，指定した言語ロケールだけのフォント名を列挙して表示します．
本サンプルは，Windows Vista 以降，Delphi 2010 以降専用です．



図15 図24
設計時画面
図15 図25
システムにインストールされているフォント名
図15 図26
日本語ロケールのフォント名のリスト
図15 図27
英語 (米国) ロケールのフォント名のリスト

リスト8
Direct2D の IDWriteFontCollection を使用したシステムフォント名の列挙
指定ロケール名のフォント名の列挙		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Direct2D,
  D2D1;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Font.Name  := 'ＭＳ ゴシック';
  Memo1.Font.Size  := 10;
  Memo1.ScrollBars := ssVertical;
end;

//=============================================================================
//  システムにインストールされているフォント名を全て列挙
//
//  usesにDirect2D,D2D1が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LIDWriteFontCollection   : IDWriteFontCollection;
  LIDWriteFontFamily       : IDWriteFontFamily;
  LIDWriteLocalizedStrings : IDWriteLocalizedStrings;
  LstringBurrer            : array[0..LF_FACESIZE-1] of Char;
  i : Integer;
  j : Integer;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;

  //インストールされているフォントセットのオブジェクトを取得
  DWriteFactory.GetSystemFontCollection(LIDWriteFontCollection);

  //取得したオブジェクトからフォント情報を順番に取得
  for i := 0 to LIDWriteFontCollection.GetFontFamilyCount - 1 do begin
    LIDWriteFontCollection.GetFontFamily(i, LIDWriteFontFamily);
    LIDWriteFontFamily.GetFamilyNames(LIDWriteLocalizedStrings);

    for j := 0 to LIDWriteLocalizedStrings.GetCount - 1 do begin
      LIDWriteLocalizedStrings.GetString(j, LstringBurrer, Length(LstringBurrer));
      Memo1.Lines.Add(FormatFloat('000', i) + '  ' + LstringBurrer);
    end;
  end;

  Memo1.Lines.EndUpdate;
end;

//=============================================================================
//  システムにインストールされているフォント名を列挙
//  ロケール名が日本語のフォントのみの列挙
//
//  usesにDirect2D,D2D1が必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
const
  SUBLANG_JAPANESE_JAPAN = $01;
var
  LLangId                  : WORD;
  Llcid                    : DWORD;
  LIDWriteFontCollection   : IDWriteFontCollection;
  LIDWriteFontFamily       : IDWriteFontFamily;
  LIDWriteLocalizedStrings : IDWriteLocalizedStrings;
  LBuffer                  : array[0..LOCALE_NAME_MAX_LENGTH-1] of Char;
  LlocaleName : string;
  LIndex      : Cardinal;
  Lexists     : LongBool;
  i           : Integer;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;

  //ロケール名を取得
  LLangId := MAKELANGID(LANG_JAPANESE, SUBLANG_JAPANESE_JAPAN);
  Llcid   := MAKELCID(LLangId, SORT_DEFAULT);
  //現システムのロケールの場合は以下で取得可能
  //LCIDToLocaleName(GetUserDefaultLangID, LBuffer, Length(LBuffer), 0);
  LCIDToLocaleName(Llcid, LBuffer, Length(LBuffer), 0);
  LlocaleName := LBuffer;  //ja-JPになる

  //インストールされているフォントセットのオブジェクトを取得
  DWriteFactory.GetSystemFontCollection(LIDWriteFontCollection);

  //取得したオブジェクトからフォント情報を順番に取得
  for i := 0 to LIDWriteFontCollection.GetFontFamilyCount - 1 do begin
    LIDWriteFontCollection.GetFontFamily(i, LIDWriteFontFamily);

    LIDWriteFontFamily.GetFamilyNames(LIDWriteLocalizedStrings);
    LIDWriteLocalizedStrings.FindLocaleName(LlocaleName[1], LIndex, Lexists);
    if not Lexists then Continue;

    LIDWriteLocalizedStrings.GetString(LIndex, LBuffer, Length(LBuffer));
    Memo1.Lines.Add(FormatFloat('000', i) + '  ' + LBuffer);
  end;

  Memo1.Lines.EndUpdate;
end;

//=============================================================================
//  システムにインストールされているフォント名を列挙
//  ロケール名が英語(米国)のフォントのみの列挙
//
//  usesにDirect2D,D2D1が必要
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LLangId                  : WORD;
  Llcid                    : DWORD;
  LIDWriteFontCollection   : IDWriteFontCollection;
  LIDWriteFontFamily       : IDWriteFontFamily;
  LIDWriteLocalizedStrings : IDWriteLocalizedStrings;
  LBuffer                  : array[0..LOCALE_NAME_MAX_LENGTH-1] of Char;
  LlocaleName : string;
  LIndex      : Cardinal;
  Lexists     : LongBool;
  i           : Integer;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;

  //ロケール言語名を取得
  LLangId := MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US);
  Llcid   := MAKELCID(LLangId, SORT_DEFAULT);
  LCIDToLocaleName(Llcid, LBuffer, Length(LBuffer), 0);
  LlocaleName := LBuffer;   //en-USになる

  //インストールされているフォントセットのオブジェクトを取得
  DWriteFactory.GetSystemFontCollection(LIDWriteFontCollection);

  //取得したオブジェクトからフォント情報を順番に取得
  for i := 0 to LIDWriteFontCollection.GetFontFamilyCount - 1 do begin
    LIDWriteFontCollection.GetFontFamily(i, LIDWriteFontFamily);

    LIDWriteFontFamily.GetFamilyNames(LIDWriteLocalizedStrings);
    LIDWriteLocalizedStrings.FindLocaleName(LlocaleName[1], LIndex, Lexists);
    if not Lexists then Continue;

    LIDWriteLocalizedStrings.GetString(LIndex, LBuffer, Length(LBuffer));

    Memo1.Lines.Add(FormatFloat('000', i) + '  ' + LBuffer);
  end;

  Memo1.Lines.EndUpdate;
end;

end.



09_日本語フォント名に対応する英語フォント名を列挙 - Direct2D


日本語フォント名に対応する英語 (米国) フォント名を列挙するサンプルです．
Direct2D に実装されている機能を使用しています．
本サンプルは，Windows Vista 以降，Delphi 2010 以降専用です．



図15 図28
設計時画面
図15 図29
日本語フォント名と英語フォント名

リスト9
日本語フォント名に対応する英語フォント名を列挙		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Direct2D,
  D2D1,
  MECSUtils;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  この関数はTMemoに表示する際の体裁を整えているだけなので本質的には不要
//
//  指定した長さの文字列を作成する関数
//  文字列が指定長さより短い場合は半角の空白で埋める
//  文字列の長さのチェックはしていないので注意
//
//  ASrcText : 対象の文字列
//  ALen     : 設定する文字列の半角単位での長さ
//  AJustify : 左寄せの時はtaLeftJustify(デフォルト).それ以外は右寄せ
//
//  usesにMECSUtilsが必要
//-----------------------------------------------------------------------------
function CreateFixedLengthText(ASrcText: String; ALen: Integer;
  AJustify: TAlignment=taLeftJustify): String;
var
  LSpcLen : Integer;
begin
  if Length(ASrcText) = 0 then begin
    Result := StringOfChar(' ', ALen);
  end else begin
    LSpcLen := ALen - MecsStringWidth(ASrcText);
    if LSpcLen > 0 then begin
      if AJustify = taLeftJustify then begin
        Result  := ASrcText + StringOfChar(' ', LSpcLen);
      end else begin
        Result  := StringOfChar(' ', LSpcLen) + ASrcText;
      end;
    end else begin
      Result  := ASrcText;
    end;
  end;
end;

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Font.Name  := 'ＭＳ ゴシック';
  Memo1.Font.Size  := 10;
  Memo1.ScrollBars := ssBoth;
end;

//=============================================================================
//  日本語名のフォントに対応する英語表記のフォント名の一覧
//
//  usesにDirect2D,D2D1が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  SUBLANG_JAPANESE_JAPAN = $01;
var
  LLangId                  : WORD;
  Llcid                    : DWORD;
  LIDWriteFontCollection   : IDWriteFontCollection;
  LIDWriteFontFamily       : IDWriteFontFamily;
  LIDWriteLocalizedStrings : IDWriteLocalizedStrings;
  LBuffer_JP     : array[0..LOCALE_NAME_MAX_LENGTH-1] of Char;
  LBuffer_EN     : array[0..LOCALE_NAME_MAX_LENGTH-1] of Char;
  LlocaleName_JP : string;
  LlocaleName_EN : string;
  LIndex         : Cardinal;
  Lexists        : LongBool;
  LFormatText    : string;
  i              : Integer;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;

  //日本語のロケール名を取得
  //LlocaleName_JP := 'ja-JP';の1行だけでも同じ
  LLangId := MAKELANGID(LANG_JAPANESE, SUBLANG_JAPANESE_JAPAN);
  Llcid   := MAKELCID(LLangId, SORT_DEFAULT);
  LCIDToLocaleName(Llcid, LBuffer_JP, Length(LBuffer_JP), 0);
  LlocaleName_JP := LBuffer_JP;  //ja-JPになる

  //英語(米国)のロケール名を取得
  //LlocaleName_EN := 'en-US';の1行だけでも同じ
  LLangId := MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_US);
  Llcid   := MAKELCID(LLangId, SORT_DEFAULT);
  LCIDToLocaleName(Llcid, LBuffer_EN, Length(LBuffer_EN), 0);
  LlocaleName_EN := LBuffer_EN;  //en-USになる

  //インストールされているフォントセットのオブジェクトを取得
  DWriteFactory.GetSystemFontCollection(LIDWriteFontCollection);

  //取得したオブジェクトからフォント情報を順番に取得
  for i := 0 to LIDWriteFontCollection.GetFontFamilyCount - 1 do begin
    LIDWriteFontCollection.GetFontFamily(i, LIDWriteFontFamily);

    LIDWriteFontFamily.GetFamilyNames(LIDWriteLocalizedStrings);
    LIDWriteLocalizedStrings.FindLocaleName(LlocaleName_JP[1], LIndex, Lexists);
    if not Lexists then Continue;

    //日本語のフォント名を取得
    LIDWriteLocalizedStrings.GetString(LIndex, LBuffer_JP, Length(LBuffer_JP));

    //英語のフォント名を取得
    LIDWriteLocalizedStrings.FindLocaleName(LlocaleName_EN[1], LIndex, Lexists);
    LIDWriteLocalizedStrings.GetString(LIndex, LBuffer_EN, Length(LBuffer_EN));

    //書式を整えて結果を出力
    LFormatText := FormatFloat('000', i) + '   '
                 + CreateFixedLengthText(LBuffer_JP, 19)
                 + CreateFixedLengthText(LBuffer_EN, 20);
    Memo1.Lines.Add(LFormatText);
  end;

  Memo1.Lines.EndUpdate;
end;

end.



10_指定フォント名を英語フォント名に変換 - Direct2D


指定したフォント名を，英語フォント名に変換するサンプルです．

Button2 のクリックイベントでは，専用の関数を作成して，英語フォント名以外のフォント名を英語フォント名に変換します．また，フォントダイアログで選択したフォント名を英語フォント名に変換します．この英語フォント名の言語ロケールは英語 (米国) です．
Button1, Button2 クリックでも，縦書きフォントの場合の処理はしていません．

Direct2D に実装されている機能を使用しています．
本サンプルは，Windows Vista 以降，Delphi 2010 以降専用です．



図15 図30
設計時画面
図15 図31
フォント名 [ＭＳ Ｐ明朝] を英語のフォント名に
  • Button1 は日本語フォント名の変換専用
図15 図32
ハングルフォント名を英語のフォント名に変換
  • Button2 は日本語フォント名以外も英語のフォント名に変換する
図15 図33
中国のフォント名を英語のフォント名に変換

下図は，フォントダイアログで選択したフォント名を英語フォント名に変換したところです．
英語名のフォントの場合は変換しません．



図15 図34
フォントダイアログで選択したフォントのフォント名を英語フォント名に変換

リスト10
指定した英語フォント名以外を，英語フォント名に変換		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    FontDialog1: TFontDialog;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Direct2D,
  D2D1;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;
  Memo1.Font.Name  := 'ＭＳ ゴシック';
  Memo1.Font.Size  := 10;

  Edit1.Text := 'ＭＳ Ｐ明朝';
end;

//=============================================================================
//  日本語のフォント名を英語表記のフォント名に変換
//
//  usesにDirect2D,D2D1が必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LIDWriteFontCollection   : IDWriteFontCollection;
  LIDWriteFontFamily       : IDWriteFontFamily;
  LIDWriteLocalizedStrings : IDWriteLocalizedStrings;
  LBuffer        : array[0..LOCALE_NAME_MAX_LENGTH-1] of Char;
  LlocaleName_JP : string;
  LlocaleName_EN : string;
  LIndex         : Cardinal;
  Lexists        : LongBool;
  i              : Integer;
begin
  Memo1.Lines.Clear;

  //言語のロケール名
  LlocaleName_JP := 'ja-JP';
  LlocaleName_EN := 'en-US';

  //インストールされているフォントセットのオブジェクトを取得
  DWriteFactory.GetSystemFontCollection(LIDWriteFontCollection);

  //取得したオブジェクトからフォント情報を順番に取得
  for i := 0 to LIDWriteFontCollection.GetFontFamilyCount - 1 do begin
    LIDWriteFontCollection.GetFontFamily(i, LIDWriteFontFamily);

    LIDWriteFontFamily.GetFamilyNames(LIDWriteLocalizedStrings);
    LIDWriteLocalizedStrings.FindLocaleName(LlocaleName_JP[1], LIndex, Lexists);
    if not Lexists then Continue;

    //日本語のフォント名を取得
    LIDWriteLocalizedStrings.GetString(LIndex, LBuffer, Length(LBuffer));

    //目的の日本語フォント名だったら英語表記のフォント名を取得
    if Edit1.Text = LBuffer then begin
      LIDWriteLocalizedStrings.FindLocaleName(LlocaleName_EN[1], LIndex, Lexists);
      LIDWriteLocalizedStrings.GetString(LIndex, LBuffer, Length(LBuffer));
      Memo1.Lines.Add(LBuffer);

      break;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  引数のフォント名が英語フォント名でない場合,英語のフォント名を返す関数
//  引数のフォント名が英語フォント名の場合はそのままの値を返す
//
//  usesにDirect2D,D2D1が必要
//-----------------------------------------------------------------------------
function GetUSEnglishFontName(AFontName: string): string;
var
  LIDWriteFontCollection   : IDWriteFontCollection;
  LIDWriteFontFamily       : IDWriteFontFamily;
  LIDWriteLocalizedStrings : IDWriteLocalizedStrings;
  LstringBuffer : array[0..LF_FACESIZE-1] of Char;
  LResultName   : string;
  i : Integer;
  j : Integer;
begin
  Result := '';

  //インストールされているフォントセットのオブジェクトを取得
  DWriteFactory.GetSystemFontCollection(LIDWriteFontCollection);

  //取得したオブジェクトからフォント情報を順番に取得
  for i := 0 to LIDWriteFontCollection.GetFontFamilyCount - 1 do begin
    LIDWriteFontCollection.GetFontFamily(i, LIDWriteFontFamily);
    LIDWriteFontFamily.GetFamilyNames(LIDWriteLocalizedStrings);

    LResultName := '';
    for j := 0 to LIDWriteLocalizedStrings.GetCount - 1 do begin
      LIDWriteLocalizedStrings.GetString(j, LstringBuffer, Length(LstringBuffer));
      //最初のフォント名は英語名
      if j = 0 then begin
        if AFontName = LstringBuffer then begin
          Result := LstringBuffer;
          break;
        end else begin
          LResultName := LstringBuffer;
        end;
      //もし2番目以降があれば英語名以外のフォント名
      end else begin
        if AFontName = LstringBuffer then begin
          Result := LResultName;
          Break;
        end;
      end;
    end;
    if Result <> '' then Break;
  end;
end;

//=============================================================================
//  フォント選択ダイアログを表示
//  選択した日本語フォント名等を英語フォント名に変換
//  Edit1に直接入力したフォント名も変換可能
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LFontName : string;
begin
  if CheckBox1.Checked then begin
    if FontDialog1.Execute(Handle) then begin
      Edit1.Text := FontDialog1.Font.Name;
      LFontName  := GetUSEnglishFontName(Edit1.Text);
      Memo1.Text := LFontName;
    end;
  end else begin
    LFontName  := GetUSEnglishFontName(Edit1.Text);
    Memo1.Text := LFontName;
  end;
end;

end.