[ 881_全角の英数字を半角に変換等 ]

Delphi Programming / Object Pascal

[掲載 2009年12月12日] [更新 2018年12月06日]　Delphi サンプルプログラム集

881_全角の英数字を半角に変換等
動作確認等	Windows 7 U64(SP1) + Delphi XE(UP1) Pro Delphi 2009 以降用

881_ToHankakuKana.zip　[4,516 KB]　2018年12月06日版 (EXE 同梱)

01_全角の英数字を半角英数字に変換
02_ひらがなをカタカナに変換
03_全角カタカナを半角カタカナに変換
04_LCMapString 関数のテスト
05_半角と全角文字の判定 - MECSUtils 使用
06_文字の値 (コードポイント) を取得する Ord 関数
07_コードポイントから文字を取得する Chr と Char 関数
08_Unicode の 32 ビットの文字符号を文字に変換

01_全角の英数字を半角の英数字に変換

文字列中の全角の英数字の文字だけを半角の英数字に変換するテストプログラムです．

実際のアプリでは，文字の入力の際に入力文字を制限することもできますが，後で必要になった場合に利用できるかも知れません．逆に半角の英数字だけを全角にするとか，英字だけを小文字に，あるいは大文字 (UpperCase と LowerCase 関数と同じ動作) にするのも，コードを少し修正すれば可能です．

文字のコードポイント (CodePoint : 文字コード) を調べる方法は，後述の Ord 関数と Chr 関数のサンプルを参考にしてください．

参考リンク
[13_全角の英数字のコードポイントと全角と半角への変換]

[備考]
全角と半角の変換ではなく，大文字あいは小文字への変換には，以下の記事にある TCharacter のメソッド，あるいは TCharHelper のメソッド類が使用できます．

	図1 設計時画面
	図2 実行して Button1 クリック全角の英数字を半角に変換

リスト1
全角の英数字だけを半角に (Unicode 版)．Unicode は文字単位で文字列が扱えるので簡単

unit ToHankakuUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  対象文字列をEdit1にセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Font.Size := 11;
  Edit1.Font.Name := 'ＭＳ ゴシック';
  Edit1.Text      := '你好Ｄｅｌｐｈｉ２０１０안녕하세요叱鮭';

  Edit2.Font.Size := 11;
  Edit2.Font.Name := 'ＭＳ ゴシック';
  Edit2.Text      := '';
end;

//=============================================================================
//  文字列中の全角英数字だけを半角の英数字に変換
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
const
  Dis = $FEE0;
var
  Str   : String;
  i     : Integer;
  AChar : Cardinal;
begin
  Edit2.Text := '';
  Str := '';

  for i := 1 to Length(Edit1.Text) do begin
    AChar := Ord(Edit1.Text[i]);
    if (AChar >= $FF10) and (AChar <= $FF5A) then begin
      Str := Str + Chr(AChar - Dis);
    end else begin
      Str := Str + Edit1.Text[i];
    end;
  end;

  Edit2.Text := Str;
end;

end.

02_ひらがなをカタカナに変換

文字列中の全角のカタカナまたはひらがなをひらがなまたはカタカナに変換します．

実際のアプリでは，文字の入力の際にカタカナだけ，あるいはひらがなだけの入力に制限することもできますが，後で必要になった場合に利用できるかも知れません．
これだけの変換であれば LCMapString 関数が使えますが，英数字の全角半角変換と合わせて変換を行う場合の参考用です．

	図3 設計時画面
	図4 実行して Button1 クリック全角のひらがなをカタカナに変換
	図5 実行して Button2 クリック全角のカタカナをひらがなに変換

リスト2
ひらがな <-> カタカナ変換 (Unicode 版)

unit ToKanaUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  対象文字列をEdit1にセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Font.Size := 11;
  Edit1.Font.Name := 'ＭＳ ゴシック';
  Edit1.Text := '你好でるふぁい＝デルファイ鮭';

  Edit2.Font.Size := 11;
  Edit2.Font.Name := 'ＭＳ ゴシック';
  Edit2.Text := '';
end;

//=============================================================================
//  文字列中のひらがなだけをカタカナに変換
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Dis   : Cardinal;
  Str   : String;
  i     : Integer;
  AChar : Cardinal;
begin
  Dis        := $30A1 - $3041;
  Edit2.Text := '';
  Str        := '';

  for i := 1 to Length(Edit1.Text) do begin
    AChar := Ord(Edit1.Text[i]);
    if (AChar >= $3041) and (AChar <= $3093) then begin
      Str := Str + Chr(AChar + Dis);
    end else begin
      Str := Str + Edit1.Text[i];
    end;
  end;

  Edit2.Text := Str;
end;

//=============================================================================
//  文字列中のカタカナだけをひらがなに変換
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  Dis   : Cardinal;
  Str   : String;
  i     : Integer;
  AChar : Cardinal;
begin
  Dis        := $30A1 - $3041;
  Edit2.Text := '';
  Str        := '';

  for i := 1 to Length(Edit1.Text) do begin
    AChar := Ord(Edit1.Text[i]);
    if (AChar >= $30A1) and (AChar <= $30F6) then begin
      Str := Str + Chr(AChar - Dis);
    end else begin
      Str := Str + Edit1.Text[i];
    end;
  end;

  Edit2.Text := Str;
end;

end.

03_全角カタカナを半角カタカナに変換

半角のカタカナに変換する必要があるのは，おそらく，古いデータベースへ氏名等のデータを転送する場合ではないかと思います．
これは少し面倒です．例えば全角の 'ガ 'は 1 文字ですが，半角では 'カ' と '"' (濁点) の 2 文字で構成されています．このように濁点，半濁点は，個別に判定をする必要があります．変換用のテーブルを使用する例が参考リンクにあります．

もし，対象の文字列が全角のカタカナだけであれば，次項でテストしている LCMapString 関数がそのまま利用できます．漢字は半角にできませんから，文字列全てを LCMapString 関数で半角にした後，英数字だけを全角に戻す方法も考えられます．

下に示すサンプルは LCMapString 関数を使用して処理する例です．全角のカタカナをコードポイントの値で判定して処理します．変換対象の文字のコードポイントの値については，文字コード表等で確認してください．

[備考 1]
ひらがなの小文字の「ゕ，ゖ」は，コードページが Shift-JIS では表示できません．代替え文字の ? になります．Delphi XE の IDE は UTF-8 なので表示できます．

[備考 2]
一般的に，同じ文字であっても，Unicode と AnsiString の文字コード (コードポイント) の値は違います．
JIS の文字を使用することはほんどないと思いますが，JIS のコードページは 50220, 50221, 50222 の 3 つあります，

	図6 実行結果変換後の半角文字 2 文字分のコードポイント (文字コード) の値を表示 Ansi 文字と Unicode 文字のコードポイントの値は違うので注意 () 内が Ansi 文字の場合．Ansi 文字の半角は 1 バイト
	図7 文字コード表変換対象のコードポイントの確認用 %SystemRoot%\system32\charmap.exe でも起動可能

リスト3
全角カタカナを半角カタカナに変換 (Unicode 版)
全角の空白文字は処理の対象外．変換が必要ない全角の空白があるかも知れないので

unit ToHalfwidthKataUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  対象文字列をEdit1にセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Edit1.Font.Size := 11;
  Edit1.Font.Name := 'ＭＳ ゴシック';
  Edit1.Text := '１２３でるふぁいＡＢＣ＝DEFデルファイ';

  Edit2.Font.Size := 11;
  Edit2.Font.Name := 'ＭＳ ゴシック';
  Edit2.Text := '';

  Edit3.Font.Size    := 11;
  Edit3.Font.Charset := ANSI_CHARSET;
  Edit3.Font.Name    := 'ＭＳ ゴシック';
  Edit3.Text := '';
end;

//=============================================================================
//  文字列中の全角のカタカナだけを半角のカタカナに変換
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStr         : string;
  LResultStr   : string;
  LDestStr     : string;
  LFlags       : DWORD;
  LSize        : Integer;
  LHalfKanaStr : string;
  LAnsiStr     : AnsiString;
  LText        : string;
begin
  LResultStr := '';
  LHalfKanaStr   := '';

  LFlags := LCMAP_HALFWIDTH;

  for LStr in Edit1.Text do begin
    if (LStr >= #$30A1) and (LStr <= #$30FA) then begin

      LSize := LCMapString(LOCALE_SYSTEM_DEFAULT,
                           LFlags, PChar(LStr), Length(LStr), nil, 0);
      SetLength(LDestStr, LSize);
      LCMapString(LOCALE_SYSTEM_DEFAULT,
                  LFlags, PChar(LStr), Length(LStr), PChar(LDestStr), LSize);
      if LSize > 0 then begin
        LResultStr   := LResultStr + LDestStr;
        LHalfKanaStr := LHalfKanaStr + LDestStr;
      end else begin
        LResultStr   := LResultStr + LStr;
        LHalfKanaStr := LHalfKanaStr + '?';
      end;
    end else begin
      LResultStr := LResultStr + LStr;
    end;
  end;

  Edit2.Text := LResultStr;
  Edit3.Text := LHalfKanaStr;


  //変換した最初の2文字だけコードポイントの値を表示
  //UnicodeとAnsi文字ではコードポイントの値が違うことに注意
  LAnsiStr := AnsiString(LHalfKanaStr);
  LText := '';

  if Length(LHalfKanaStr) > 0 then begin
    LText := 'U+' + IntToHex(Ord(LHalfKanaStr[1]), 4)
           + ' ($' + IntToHex(Ord(LAnsiStr[1]), 2) + ')';
  end;
  if Length(LHalfKanaStr) >= 2 then begin
    LText := LText + '  '
           + 'U+' + IntToHex(Ord(LHalfKanaStr[2]), 4)
           + ' ($' + IntToHex(Ord(LAnsiStr[2]), 2) + ')';
  end;
  Label1.Caption := LText;
end;

end.

上のサンプルコードでは，Edit2.Text にはカタカナだけを半角にした Unicode の文字列を代入しています．Edit3.Text には AnsiString 型 (Shift_JIS) の文字列を代入していますが，どちらも Unicode に変換されて表示されます．

文字列をデータベースの項目の値として使用する場合，その項目の文字列が Shift_JIS である時は Shift_JIS の文字列を代入します．もし，JIS コードの文字列である時は，JIS コードの文字列型を定義して使用します．そうしないと，文字化け等が発生する可能性があります．
Delphi のコード内の変数であれば，以下の LJISStr := LResultStr のように，代入の際に自動的に文字コードの変換が行われます．

文字列をファイルに保存する場合は，保存の時にコードページを指定すれぱ，自動的に変換 (エンコード) してくれます．以下は，コードページ 50221 の文字列として保存する例です．

参考リンク
Delphi 2009 以降と文字列処理 (1)

procedure TForm1.Button1Click(Sender: TObject);
type
  JIS50221String = type AnsiString(50221);
var
  LResultStr   : string;
  LJISStr      : JIS50221String;
  LStrList     : TStringList;
begin
  ....

  // または LJISStr := JIS50221String(LResultStr)
  LJISStr := LResultStr;
  ....

  // テキストを JIS50221 コードのテキストとして保存する例
  LStrList := TStringList.Create;
  try
    LStrList.Add(LResultStr);
    LStrList.SaveToFile('000.txt', TEncoding.GetEncoding(50221));
  finally
    FreeAndNil(LStrList);
  end;    
end;

保存した文字列を読み込む時は，保存されている文字列のコードページを指定して読み込めば，自動的に Unicode の文字列になります．

procedure TForm1.Button2Click(Sender: TObject);
var
  LStrList : TStringList;
begin
  // JIS50221 コードのテキストを読み込む例
  LStrList := TStringList.Create;
  try
    LStrList.LoadFromFile('000.txt', TEncoding.GetEncoding(50221));
    Edit1.Text := LStrList.Text;
  finally
    FreeAndNil(LStrList);
  end;
end;

04_LCMapString 関数のテスト

LCMapString 関数のテストです．
日本語の場合，'¥' (半角の円記号) は全角にはできないようです．日本語では，'\' はファイルシステムのパス名の区切り文字と解釈するようです．
ReplaceText 関数や StringReplace 関数を使用すれば，'¥' (半角の円記号) を '￥' (全角の円記号) に変換することができます．ReplaceText 関数の使用には，uses に StrUtils が必要です．

  Edit2.Text := ReplaceText(Edit2.Text, '¥', '￥');
  Edit2.Text := StringReplace(Edit2.Text, '¥', '￥', [rfReplaceAll]);

	図8 設計時画面
	図9 実行画面半角に変換ひらがなの半角はない

文字列内の半角文字を全角文字にする例です．
カタカナだけを全角に変換したい場合は，この結果の文字列にたいして，英数字を半角にします．

図10
半角を全角に変換

リスト4
LCMapString 関数のテスト

unit LCMapStringTestUnit;

interface

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

type
  TForm1 = class(TForm)
    RadioGroup1: TRadioGroup;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  テスト用の文字列をセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  //Window Vista, 7 + Delphi 2007以前ではShift-JISを明示的に設定しないと文字化けする
  //ことがある
  Edit1.Font.Charset := SHIFTJIS_CHARSET;
  Edit2.Font.Charset := SHIFTJIS_CHARSET;

  Edit1.Text := 'デルファイDelphi2010￥\でるふぁいＤｅｌ日本２０１０';
  RadioGroup1.Buttons[0].Checked := True;
end;

//=============================================================================
//  LCMapString関数のテスト
//
//  SORT_STRINGSORT,NORM_ というフラグがあるがこれらは無効
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  SrcStr  : String;
  DestStr : String;
  Size    : Integer;
  Flags   : DWORD;
begin
  Edit2.Text := '';
  SrcStr := Edit1.Text;
  Flags := 0;

  if RadioGroup1.Buttons[0].Checked then Flags := LCMAP_FULLWIDTH;
  if RadioGroup1.Buttons[1].Checked then Flags := LCMAP_HALFWIDTH;
  if RadioGroup1.Buttons[2].Checked then Flags := LCMAP_HIRAGANA;
  if RadioGroup1.Buttons[3].Checked then Flags := LCMAP_KATAKANA;

  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,
                      Flags, PChar(SrcStr), Length(SrcStr), nil, 0);
  SetLength(DestStr, Size);
  Size := LCMapString(LOCALE_SYSTEM_DEFAULT,
                      Flags, PChar(SrcStr), Length(SrcStr), PChar(DestStr), Size);
  if Size <= 0 then begin 
    Edit2.Text := SrcStr;
  end else begin
    SetLength(DestStr, Size);
    Edit2.Text := DestStr;
  end;
end;

end.

05_半角と全角文字の判定 - MECSUtils 使用

文字列中の文字が，半角であるか全角であるかを調べるテストです．

Delphi 2009 で，Delphi も Unicoe 化されました．
Delphi 2009 よりも前のバージョンは， Ansi 版の Delphi ということになります．

Ansi 版の Delphi では，半角を 1 バイト文字，全角を 2 バイト文字と言っていました．
例えば，Halbow 資料館の [第５章文字列の操作] の [５－１部分文字列を数える] の関数は，文字が 2 バイト文字として有効かを，LeadBytes 関数で判定して，文字列の中の指定文字列の数を数えています．

Unicode の文字はマルチバイトとなり，バイト数の違いによる半角とか全角の概念はありません．
次のコードは，この Halbow 資料館のコードと同じ動作をする Unicode 版のコードです．文字列中の文字を「文字単位」で扱っています．半角とか全角文字であるかの判定は行っていません．文字単位で扱っていますから，非 Unicode 版，つまり，Ansi 版の Delphi でもこのまま使用できます．

リスト5
テキストの中の指定文字列の数を調べる関数．処理の高速化のためにポインタを使用
Delphi 6 以上で使用可能

//-----------------------------------------------------------------------------
//  文字列検索関数
//
//  引数
//  Str      : この文字列の中を検索する
//  SubStr   : 検索文字列
//  戻り値   : 検索数
//
//  [備考]
//  StrEnd(SysUtils.pas)
//  ヌルで終わる文字列の末尾を指すポインタを返す関数
//-----------------------------------------------------------------------------
function HowManyWords(const Str, SubStr: string): Integer;
var
  PStr    : PChar;
  PSubStr : PChar;
  L       : Integer;
  PStrEnd : PChar;
begin
  Result  := 0;
  L       := Length(SubStr);
  if L = 0 then exit;

  PStr    := @Str[1];
  PSubStr := @SubStr[1];
  PStrEnd := StrEnd(PStr);

  while PStrEnd > PStr do begin
    if StrLIComp(PStr, PSubStr, L) = 0 then
    begin
      //見つかったら検索文字数だけ次へ
      Inc(result);
      Inc(PStr, L);
    end else begin
      //見つからなかったら1文字だけ次へ
      Inc(PStr, 1);
    end;
    Application.ProcessMessages;
  end;
end;

Unicode の東アジア圏における各文字の半角と全角半角の定義は，Unicodeコンソーシアムで策定されている EastAsianWidth 属性を利用することができます．これは文字幅の属性のことです．これを利用するための便利な MECSUtilsユニット (メックス・エムイーシーエス) というのがあります．
このサンプルは，この MECSUtils ユニットを利用して，文字幅としての半角と全角を判定します．

[備考]
もし，Shift-JIS の文字コードの範囲内でよいのであれば，文字列を AnsiString 型にして Ansi 版 Delphi の時と同じ方法で 1 バイト文字か 2 バイト文字かで半角と全角の判定が可能です．
この方法は Unicode な文字が含まれている文字列には利用できません．Shift-JIS にない文字は $3F に変換されるため，全角の文字も 1 バイト文字の判定になります．当然 Shift-JIS には含まれていない他言語の文字も正常に判定できません．

	図11 設計時画面
	図12 実行結果

リスト6
半角と全角の判定

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

uses MECSUtils;

{$R *.dfm}

//=============================================================================
//  テスト用の文字列をセット
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  Memo1.ScrollBars := ssVertical;
  Memo1.Font.Name  := 'ＭＳ ゴシック';
  Memo1.Font.Size  := 10;
  Memo1.ReadOnly   := True;

  Edit1.Text := 'Unicode版です';
end;

//=============================================================================
//  EditFont 使用フォント(ここではEdit1のフォント)
//  ここでは意識的にUnicodeString型を定義しているが，String型にすれば，Ansi版
//  のDelphiでも動作する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  UnicodeStr : UnicodeString;
  EditFont   : TFontCharset;
  i          : Integer;
begin
  UnicodeStr := Edit1.Text;
  EditFont   := Edit1.Font.CharSet;

  Memo1.Lines.Clear;

  for i := 0 to MecsLength(UnicodeStr) do begin
    //全角の場合
    if MecsIsFullWidth(UnicodeStr, i, IsFarEastCharSet(EditFont)) then begin
      Memo1.Lines.Add(UnicodeStr[i] + '  全角')
    //半角の場合
    end else begin
      Memo1.Lines.Add(UnicodeStr[i] + '   半角')
    end;
  end;
end;

end.

06_文字の値 ( コードポイント ) を取得する Ord 関数

本ページの最初のサンプルで Ord 関数を使用しています．Ord 関数は，引数の文字のコードポイントを取得する関数です．本サンプルはそのテストプログラムです．
コードポイントは，その文字の数値ですから，文字コードと言う言い方もありますが，コードページを文字コードと言うこともあります．

このサンプルでは，入力した文字列を 1 文字づつコードポイントの値を取得して，10 進数と 16 進数で表示します．HTML の文字参照にも使用可能なテキストも出力できるようにしています．

[備考]
当サイトのウェブページの文字コードは全て Shift-jis です．したがって，中国簡体字はそのままでは表示できません．中国簡体字を含めて，ユニコードな文字は，本項のサンプルで取得したテキストを HTML のコードに書いて表示するようにしています．

	図13 設計時画面
	図14 「你好」の各文字のコードポイントを取得 Edit1 に調査対象の文字列を入力 Button1 をクリック Edit2 に，コードポイントの値が 10 進数で表示される Edit3 に，コードポイントの値が 16 進数で表示される
	図15 HTML をチェックした場合文字参照用のテキストが表示されるこれを HTML コードに書けば「你好」と表示される

上の実行例と同じ中国簡体字ですが，「载模块」という文字列の場合です．
フォントが Tahoma の場合，一部の文字が代替えフォントで表示されていますが，コードポイントは正しく取得できています．フォントを ShimHei にすると全て ShimHei で表示されます．

	図16 フォントが Tahoma の場合一部が代替えフォントで表示されている
	図17 フォントが SimHei の場合

リスト7
文字の数値 (コードポイント) を取得する Ord 関数のテスト (Unicode 版)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    CheckBox1: TCheckBox;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

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

//=============================================================================
//  フォーム生成時の処理
//  コンボボックスにフォント名のリストをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LDC    : HDC;
  LIndex : Integer;
begin
  //フォント名リストの作成
  //全フォントのリストを取得する関数はEnumFontFamiliesEx
  ComboBox1.Clear;
  ComboBox1.Sorted := True;
  LDC := GetDC(Handle);
  try
    EnumFontFamilies(LDC, nil, @EnumFontFamProc, LPARAM(ComboBox1.Items));
    LIndex := ComboBox1.Items.IndexOf(Edit1.Font.Name);
    ComboBox1.ItemIndex := LIndex;
  finally
    ReleaseDC(Handle, LDC);
  end;
end;

//=============================================================================
//  文字の数値(コードポイント)を調べる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LString : string;
  LText10 : string;
  LText16 : string;
  i       : Integer;
begin
  //対象の文字列
  LString := Edit1.Text;

  LText10 := '';
  LText16 := '';
  for i := 1 to Length(LString) do begin
    if CheckBox1.Checked then begin
      //HTMLの文字参照用
      LText10 := LText10 + '&#' + IntToStr(Ord(LString[i])) + ';';
      LText16 := LText16 + '&#' + Format('x%.4x', [Ord(LString[i]), 4]) + ';';
    end else begin
      LText10 := LText10 + '#' + IntToStr(Ord(LString[i]));
      LText16 := LText16 + '#' + Format('$%.4x', [Ord(LString[i]), 4]);
    end;
  end;

  Edit2.Text := LText10;
  Edit3.Text := LText16;
end;

//=============================================================================
//  ComboBox1のOnClickイベント
//  コンボボックスでフォント名を選択したらそのフォントで文字を再表示
//=============================================================================
procedure TForm1.ComboBox1Click(Sender: TObject);
begin
  Edit1.Font.Name := ComboBox1.Items[ComboBox1.ItemIndex];
end;

end.

07_コードポイントから文字を取得する Chr と Char 関数

Chr 関数も，本ページの最初のサンプルで使用しています．Chr 関数は，文字の数値表現であるコードポイントの値 (文字コード) から，文字を取得します．
前項のサンプルで取得した値の確認用にも利用できます．

	図18 設計時画面
	図19 「#$4F60#$597D」は「你好」

リスト8
文字の数値 ( コードポイント ) から文字を取得する Chr 関数のテスト (Unicode 版)

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit2: TEdit;
    Edit1: TEdit;
    ComboBox1: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  コンボボックスにフォント名のリストをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LIndex : Integer;
begin
  //フォント名リストの作成
  ComboBox1.Items.Assign(Screen.Fonts);
  for LIndex := ComboBox1.Items.Count - 1 downto 0 do begin
    //縦書き用フォントは除外
    if Pos('@', ComboBox1.Items[LIndex]) > 0 then begin
      ComboBox1.Items.Delete(LIndex);
    end;
  end;
  LIndex := ComboBox1.Items.IndexOf(Edit2.Font.Name);
  ComboBox1.ItemIndex := LIndex;

  //テスト用の文字コードをセット
  //Edit1.Text := #$4F60#$597D; だと該当する文字列そのものが表示されてしまう
  Edit1.Text := '#$4F60#$597D';
end;

//=============================================================================
//  文字の数値(コードポイント)から文字を取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  i        : Integer;
begin
  Edit2.Text := '';

  LStrList := TStringList.Create;
  try
    //デリミタの設定して文字列をセット
    LStrList.Delimiter       := '#';
    LStrList.StrictDelimiter := True;
    LStrList.DelimitedText   := Edit1.Text;

    //1文字分のコードポイントの値を取り出して順番に文字列に追加
    LText := '';
    for i := 0 to LStrList.Count - 1 do begin
      if Trim(LStrList[i]) <> '' then begin
        LText := LText + Chr(StrToInt(LStrList[i]));
      end;
    end;
  finally
    FreeAndNil(LStrList);
  end;

  Edit2.Text := LText;
end;

//=============================================================================
//  ComboBox1のOnClickイベント
//  コンボボックスでフォント名を選択したらそのフォントで文字を再表示
//=============================================================================
procedure TForm1.ComboBox1Click(Sender: TObject);
begin
  Edit2.Font.Name := ComboBox1.Items[ComboBox1.ItemIndex];
end;

end.

Char も以下のように，コードポイントを引数にする関数として使用できます．
このコードの実行結果は，上のサンプルと同じになります．

procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  i        : Integer;
begin
  Edit2.Text := '';

  LStrList := TStringList.Create;
  try
    //デリミタの設定して文字列をセット
    LStrList.Delimiter       := '#';
    LStrList.StrictDelimiter := True;
    LStrList.DelimitedText   := Edit1.Text;

    //1文字分のコードポイントの値の文字を順番に追加
    LText := '';
    for i := 0 to LStrList.Count - 1 do begin
      if Trim(LStrList[i]) <> '' then begin
        LText := LText + Char(StrToInt(LStrList[i]));
      end;
    end;
  finally
    FreeAndNil(LStrList);
  end;

  Edit2.Text := LText;
end;

08_Unicode の 32 ビットの文字符号を文字に変換

前項のサンプルでは Unicode の 32 ビット文字符号は文字に変換できません．
Delphi の String 型の文字列と Char 型の文字は UTF-16 です．UTF-16 では 1 つのエレメントに 2 バイトのデータしか格納できません．
例えばサロゲートペアの文字である「𠮷」は U + 20BB7 です．サロゲートペアに変換して，2 つのエレメントにすれば前項のサンプルでも文字に変換できます．

MECSUtils の CodePointToUTF16 関数を使用すれば U + 10000 以上の符号をサロゲートペアに変換してくれます．以下はその関数を使用したサンプルコードです．
サロゲートペアな文字の表示には，フォントに注意します．フォントによっては，代替えフォントで表示される場合があります．下図ではメイリオで表示しています．

参考リンク
MECSUtils リファレンス - CodePointToUTF16 関数

図20
Unicode の 32 ビット符号値を文字に変革

1 番目の TEdit の値は入力した値
20BB7 は Unicode における「𠮷」のコードポイント
一番下はコードポイントに相当する文字例

リスト9
Unicode の 32 ビットの文字符号も文字に変換

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit2: TEdit;
    Edit1: TEdit;
    ComboBox1: TComboBox;
    Edit3: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  MECSUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  コンボボックスにフォント名のリストをセット
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LIndex : Integer;
begin
  //フォント名リストの作成
  ComboBox1.Items.Assign(Screen.Fonts);
  for LIndex := ComboBox1.Items.Count - 1 downto 0 do begin
    //縦書き用フォントは除外
    if Pos('@', ComboBox1.Items[LIndex]) > 0 then begin
      ComboBox1.Items.Delete(LIndex);
    end;
  end;
  LIndex := ComboBox1.Items.IndexOf(Edit2.Font.Name);
  ComboBox1.ItemIndex := LIndex;

  //テスト用の文字コードを文字列でセット
  Edit1.Text := '#$4F60#$20BB7';
end;

//=============================================================================
//  文字の数値(コードポイント)から文字を取得
//  サロゲートペア等,Unicodeの32ビット符号にも対応したコード
//
//  usesにMECSUtilsが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  LCode    : Cardinal;
  LResText : string;
  LLoopCnt : Integer;
begin
  Edit2.Text := '';

  LStrList := TStringList.Create;
  try
    //デリミタの設定して文字列をセット
    LStrList.Delimiter       := '#';
    LStrList.StrictDelimiter := True;
    LStrList.DelimitedText   := Edit1.Text;

    //1文字分のコードポイントの値を取り出して順番に文字列に追加
    LText := '';
    for LLoopCnt := 0 to LStrList.Count - 1 do begin
      if Trim(LStrList[LLoopCnt]) <> '' then begin
        LText := LText + CodePointToUTF16(StrToInt64(LStrList[LLoopCnt]));
      end;
    end;
  finally
    FreeAndNil(LStrList);
  end;

  //文字のコードポイントを確認表示
  //サロゲートペアに分割されているのを表示
  LResText := '';
  for LLoopCnt := 1 to Length(LText) do begin
    LCode := Ord(LText[LLoopCnt]);
    LResText := LResText + '#$' + IntToHex(LCode, 4);
  end;
  Edit3.Text := LResText;

  Edit2.Text := LText;
end;

//=============================================================================
//  ComboBox1のOnClickイベント
//  コンボボックスでフォント名を選択したらそのフォントで文字を再表示
//=============================================================================
procedure TForm1.ComboBox1Click(Sender: TObject);
begin
  Edit2.Font.Name := ComboBox1.Items[ComboBox1.ItemIndex];
end;

end.