Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2018年07月29日] [更新 2018年08月15日] Delphi 一般・その他
   
Emoji ( 絵文字 ) の描画
動作確認等 Windows 10.0.17134 Pro-32 bit + Delphi 10.2.3 Tokyo Community
Windows 7 U64(SP1) + Delphi 10.2.3 Tokyo Community
[整理番号 - 0890]







記号フォントと Emoji ( 絵文字 )


Windows 8.1 でカラーの絵文字が使用可能になりました.本ページは主にこのカラーの絵文字の描画に関するテストの記事です.

Windows では文字を表示するフォント (フォント名あるいはフォントファミリー) に,記号や絵文字が格納されているフォントがあります.それらのフォントを使用すると下図のように記号や絵文字等を表示することができます.



図1
一般的な文字用と記号や絵文字用フォント
  • 上が一般的な文字フォントによる描画
    フォント名は Meiryo
  • 下が記号や絵文字用フォントによる描画
    フォント名は Wingdings

リスト1
一般的な文字用と記号や絵文字用フォントよる TEdit への描画
//=============================================================================
//  フォーム生成時の処理
//  Edit1, Edit2 とのフォント名を異なるものにする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Font.Size := 20;
  Edit2.Font.Size := 20;

  Edit1.Font.Name := 'Meiryo';
  Edit2.Font.Name := 'Wingdings';
end;

//=============================================================================
//  TEdit の OnChange イベント処理
//  Edit1, Edit2 の文字(コードポイント)を同じにする
//=============================================================================
procedure TForm1.Edit1Change(Sender: TObject);
begin
  if Sender = Edit1 then begin
    Edit2.Text := Edit1.Text;
  end else begin
    Edit1.Text := Edit2.Text;
  end;
end;


本ページで扱っているのはこの記号フォントによる文字ではなく,Unicode の Emoji (エモジ) という規格の文字です.
絵文字は日本独特の文化として携帯電話等のモバイル端末で使用されてきましたが,現在は世界中で日常的に使用されています.Unicode でも Emoji という日本語の読み名の規格にもなっています.
Unicode では例えば以下のコードポイントが絵文字として登録されています.

  • U + 2600 〜 U + 27BF
  • U + 1F300 〜 U + 1F5FF
  • U + 1F600 〜 U + 1F64F
  • U + 1F680 〜 U + 1F6FF

Emoji については以下のリンクの記事等を参考にしてください.
Emoji の中でカラー表示可能な絵文字のことを Color Emoji, あるいはカラー絵文字と書くことがありますが,マイクロソフトでは Color Font という用語を使用しています.

Windows では Windows 8 で絵文字フォントが提供され,Windows 8.1 でカラーの絵文字の表示が可能になりました.






01_TEdit にカラーの絵文字を表示してもモノクロの絵文字になる
EmojiSurrogatePair.zip [866 KB] 2020年12月24日版 (EXEのみ)


TEdit に絵文字を表示するテストです.
下の 3 つ文字はカラーの絵文字です (ブラウザの種類とバージョンによってはモノクロ表示).その右側がそれらの文字のコードポイントです.U + 10000 以降の値となっています.U
+ 10000 以降はサロゲートペアな文字です.


   🚺 🚫 🔯   #$1F6BA#$1F6AB#$1F52F


TEdit の Text プロパティにコードポイントの値を直接代入すればこれらの文字を表示できますが,ここではコードポイントの値を変数として扱えるようにして,コードポイントの値をサロゲートペアに分解して表示するようにしています.また,コンボボックスで表示に使用するフォントを変更できるようにしてみました.

下図は上の 3 つの絵文字を表示した結果ですが,モノクロの絵文字になっています.
Delphi の TEdit や TMemo は Windows の Edit コントロールをカプセル化したテキストの入力編集用コントロールです.つまり,文字等のテキストの実際の描画は Windows の Edit コントロールが行っています.Windoows の Edit コントロールはカラー絵文字をカラーで描画する機能を実装していません.したがって,Delphi の TEdit や TMemo ではカラーの絵文字であってもモノクロの絵文字として表示されることになります.



[備考]
Windows 7 にインストールされているフォントには,Segoe UI Symbol フォントも含めてカラー情報はありません.Windows 7 にはフォントのカラー情報を処理する機能も実装されていません.



図2
コードポイントの値を指定して TEdit にカラーの絵文字を描画
  • Windows 10 での実行結果
  • フォントはメイリオ

  • フォームに以下を配置している
    一番上は TButton と TComboBox
    その下に TEdit を 3 つ.順番に
    Edit1, Edit2, Edit3
図3
コードポイントの値を指定して TEdit にカラーの絵文字を描画
  • Windows 10 での実行結果
  • フォントは Segoe UI Emoji

下図は Windows 7 での実行結果です.フォントは Windows 10 と同じメイリオを使用していますが四角形が表示されいます.Windows 7 でもフォントを Segoe UI Symbol (シーゴー・ユーアイ・シンボル) にすれば絵文字が表示できます.

絵文字の描画機能は Windows 8 で実装されました.Windows 8.1 ではカラーの絵文字の描画にも対応になっています.Segoe UI Symbol フォントは,Windows 7 でも絵文字の描画ができるように Windows の更新プログラム KB2729094 でインストールされています.もし KB2729094 をインストールしていない場合は,以下のマイクロソフトのサイトからダウンロードしてインストールできます.



図4
コードポイントの値を指定して TEdit にカラーの絵文字を描画
  • Windows 7 では使用するフォントによっては絵文字にならない
    フォントがメイリオの場合
図5
コードポイントの値を指定して TEdit にカラーの絵文字を描画
  • Windows 7 で Segoe UI Symbol フォントにした場合

リスト2
コードポイントを指定して TEdit に絵文字を表示,コードポイントをサロゲートペアに分解
uses に MECSUtils が必要
implementation

uses
  MECSUtils;

{$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(Self.Font.Name);
    ComboBox1.ItemIndex := LIndex;
  finally
    ReleaseDC(Handle, LDC);
  end;
  Edit2.Font.Name := ComboBox1.Text;
  Edit1.Text := '#$1F6BA#$1F6AB#$1F52F';
end;

//=============================================================================
//  Edit1に入力したコードポイントの値を実際の文字にして表示
//  サロゲートペアな文字の場合はサロゲートペアに分解してそのコードを表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
  LText    : string;
  LText16  : string;
  LoopCnt  : Integer;
begin
  Edit2.Text := '';

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

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

  //対象の文字列
  LText := Edit2.Text;

  LText16 := '';
  for LoopCnt := 1 to Length(LText) do begin
    LText16 := LText16 + '#' + Format('$%.4x', [Ord(LText[LoopCnt]), 4]);
  end;
  Edit3.Text := LText16;
end;

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




02_Direct2D を使用してカラーの絵文字を TCanvas に描画


マイクロソフトでは,カラー絵文字の描画に関して,Direct2D を使用する方法,XAML (ザムル) アプリケーションではその設定方法について説明しています.
下のリンクの記事に Direct2D を使用するサンプルが掲載されています.このコードは,コピペすればそのまま動作しますが,ここでは元のコードを少し変更しています.



下図が実行結果です.絵文字は参考にしたサンプルコードと全く同じ絵文字を使用しています.

Windows 7 では D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT フラグを指定しても無効です.このフラグを指定すると何も描画しません.Windows 7 にインストールされているフォントはカラー情報を待っていません.Windows 7 にはフォントのカラー情報を処理する機能も実装されていません.
フォントのカラー情報を処理する機能が実装されたのは Windows 8.1 からです.



図6
Direct2D によるカラーの絵文字描画
  • Windows 10 の場合
図7
Direct2D によるカラーの絵文字描画
  • Windows 7 の場合はモノクロの絵文字となる
  • 正しく表示できない絵文字がある

[備考 1]
本サンプルでは Windows のバージョン判定に CheckWin32Version 関数を使用しています.
Delphi 10 Seattle より前のジージョンでは,アプリケーションマニフェストの確認が必要です.


リスト3
Direct2D を使用したカラーの絵文字の描画
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

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

var
  Form1: TForm1;

implementation

uses
  Winapi.D2D1,
  System.Win.ComObj,
  Vcl.Direct2D;

{$R *.dfm}

type
  TMyCanvas = class(TDirect2DCanvas)
  public
    procedure TextOut(X, Y: Integer; const Text: string); override;
  end;

procedure TForm1.FormPaint(Sender: TObject);
var
  FD2DCanvas: TDirect2DCanvas;
begin
  FD2DCanvas := TMyCanvas.Create(Canvas.Handle, ClientRect);
  try
    FD2DCanvas.BeginDraw;
    FD2DCanvas.TextOut(10, 10, '絵文字テスト ' + sLineBreak
                             + '😍😀😊😜😐😅😎💖😘😂😃💋💖😋😭😇🙄💩🙈🙉🙊🔞');
    FD2DCanvas.EndDraw;
  finally
    FD2DCanvas.Free;
  end;
end;

{ TMyCanvas }

procedure TMyCanvas.TextOut(X, Y: Integer; const Text: string);
const
  D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT = $00000004;
var
  TextRange: TDwriteTextRange;
  TextLayout: IDWriteTextLayout;
begin
  OleCheck(DWriteFactory.CreateTextLayout(PWideChar(Text),
                                   Length(Text),
                                   Font.Handle,
                                   0,
                                   0,
                                   TextLayout));
  TextRange.startPosition := 0;
  TextRange.length := Length(Text);
  TextLayout.SetWordWrapping(DWRITE_WORD_WRAPPING_NO_WRAP);

  RequiredState([csHandleValid, csFontValid, csBrushValid]);
  if CheckWin32Version(6, 3) then begin
    TextLayout.SetFontFamilyName('Segoe UI Emoji', TextRange);
    TextLayout.SetFontSize(11.5, TextRange);
    RenderTarget.DrawTextLayout(D2D1PointF(x - 0.5, y - 0.5),
                                TextLayout,
                                Font.Brush.Handle,
                                D2D1_DRAW_TEXT_OPTIONS_ENABLE_COLOR_FONT);
  end else begin
    TextLayout.SetFontFamilyName('Segoe UI Symbol', TextRange);
    TextLayout.SetFontSize(15.5, TextRange);
    RenderTarget.DrawTextLayout(D2D1PointF(x - 0.5, y - 0.5),
                                TextLayout,
                                Font.Brush.Handle,
                                D2D1_DRAW_TEXT_OPTIONS_NONE);
  end;
end;

end.


上のコード中の絵文字はカラーで表示されていますが (ブラウザの種類とバージョンによってはモノクロ表示),それらの絵文字は,Delphi 10.2.3 Tokyo Community の IDE のコードエディタでは,下図のように表示されます.



図8
Delphi の IDE のコードエディタでの表示
  • Windows 10 の場合

下図は Direct2D を使用して,前項のテストで使用したカラー絵文字を TLabel に描画した結果です.モノクロではなくカラーの絵文字として表示されています.TEdit や TMemo はテキストの入力用コントロールです.一方,TLabel や TPanel はテキストの表示専用のコントロールですから,この方法よる描画でも十分実用になります.
絵文字のデザインあるいは色がウェブブラウザでの表示と違いますが,筆者にはこの現象に関する知識はありません.


[備考 2]
このようなテストでは,フォームに配置した TLabel のサイズを十分な大きさにして AutoSize プロパティの値を False にしておきます.TLabel.Caption プロパティの値を設定するわけではないので,描画する内容に応じて TLabel のサイズが自動的に変わることはありません.


図9
Direct2D によるカラーの絵文字の描画
  • コードポイントの値を指定して描画
  • Windows 7 ではモノクロでの描画になる
図10
同じコードポイントの文字をブラウザで表示した結果
  • Windows 7(SP1) のFireFox 61.0.1 における表示

リスト4
Direct2D で TLabel の Canvas にカラーの絵文字を描画
procedure TForm1.Button1Click(Sender: TObject);
var
  FD2DCanvas: TDirect2DCanvas;
begin
  FD2DCanvas := TMyCanvas.Create(Label1.Canvas.Handle, ClientRect);
  try
    FD2DCanvas.BeginDraw;
    FD2DCanvas.RenderTarget.Clear (D2D1ColorF(clWhite));
    FD2DCanvas.TextOut(0, 0, #$1F6BA#$1F6AB#$1F52F);
    FD2DCanvas.EndDraw;
  finally
    FD2DCanvas.Free;
  end; 
end;




03_ブラウザコントロールを使用したカラー絵文字の表示と編集


ウェブブラウザコントロールに絵文字を描画するテストです.使用したのは Chrome ブラウザコントロール CEF4Delphi ですが,以下のリンクのサンプルをそのまま使用してテストしてみました.
ただし,表示している HTML コードは,結果の図の下のコードです.HTML コードを表示した後にページを編集モードにして文字を入力しています.
下図で表示している絵文字は,下の絵文字をコピーして貼り付けています.これは前項のテストで使用したものと全く同じです.

😍😀😊😜😐😅😎💖😘😂😃💋💖😋😭😇🙄💩🙈🙉🙊🔞

このブラウザコントロール自身には独自のフォントのレンダリング機能はありません.フォントのレンダリングは Windows のフォントレンダリングの機能が使われます.したがって,文字の表示デザインは,前項の Direct2D による描画と同じになります.当然 Windows 7 ではモノクロ表示です.



図11
ブラウザコントロールを編集モードにしてカラー絵文字を表示
  • 文字の挿入,削除,選択,コピーや貼り付けの操作が可能
  • Windows 7 の環境ではモノクロの絵文字となる

リスト5
テストに使用した test.html ファイルの HTML コード
<!doctype HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<html lang="ja">
<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP">
</head>
<body>
</body>
</html>


TWebBrowser コンポーネントでも以下のようにすれば編集モードの切り換えができます.
ただし,TWebBrowser の場合,レンダリングモードを IE 11 にしても,Windows 10 でもカラーの絵文字はモノクロ表示となります.



リスト6
TWebBrowser で編集モードを切り換える方法
implementation

uses
  MSHTML;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := ExpandFileName('test.html');
  WebBrowser1.Navigate(Edit1.Text);
end;

//=============================================================================
//  designMode開始
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  (WebBrowser1.Document as IHTMLDocument2).designMode := 'on';
end;

//=============================================================================
//  designMode終了
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  (WebBrowser1.Document as IHTMLDocument2).designMode := 'off';
end;




04_ワードパッドを使用して文字のコードポイントを調べる


Windows 10 に付属のワードパッドで文字を入力すると,その文字のコードポイントの値を容易に調べることができます.Windows 10.0.1713 のワードパッドはカラー絵文字には対応していません.カラーの絵文字はモノクロで表示されます.
Windows 7 に付属のワードパッドは,絵文字を表示できませんが,同じ操作で入力した文字のコードポイントを調べることが可能です.
Microsoft word 2010 でも同じ手順でコードポイントを調べることができます.

コードポイントの値を変更すれば,文字を変更することができます.



図12
ワードパッドを使用して文字のコードポイントを知る
  • [Alt] + [X] でキャレットの左側の文字がコードポイントの値に変る
  • 再度 [Alt] + [X] で文字の表示に戻る
  • Windows 7 のワードパッドは絵文字が表示できないので□となる




05_Windows 10 のタッチキーボードを使用して Emoji を入力


Windows 10.0.17134 で使用可能な絵文字は,日本語 IME の変換候補のリストから選択できますが,下図のようなタッチキーボードからもマウス操作で入力できます. クリックした絵文字は,現在アクティブな入力コントロールに貼り付けされます.
タスクバーにタッチキーボードのアイコンがない場合は,タスクバーのポップアップメニューから [タッチキーボードボタンを表示] をクリックします.



図13
タッチキーボードのアイコンをクリック
図14
左下の赤枠位置のキーをクック
  • 表示直後は英語キーボード




06_カラー絵文字の描画にはフォントのレンダリングが必要


本ページのテストでも確認しましたが,Windows 8 以前の Windows ではカラーの絵文字をカラーでは描画できません.Windows 8 以前でカラー絵文字をカラーで描画するには,フォントに格納されている情報を解析して,人が理解可能な「文字」という画像にして出力するフォントのレンダリングを行わなけれなりません.
カラー絵文字フォントには以下のような種類があります.フォントのデータからこれらの種類を判定して処理を分けることになります.本ページのテストで使用した Segoe UI Emoji は (3) の方式のフォントです.


  • (1) フォントに SVG 画像データとして格納する方式
  • (2) フォントに PNG 画像データとして格納する方式
  • (3) 色数分のレイヤー画像の情報をフォントに格納する方式


下図は,そのようなフォントの描画エンジンを実装したテキストエディタの例です.上の参考リンクの最後のリンクの記事は,このテキストエディタ TATEditor の作者が書いた記事です.
下図は Windows 7 での実行結果です.Windows 7 にインストールされているフォントにはカラー絵文字としての情報はありません.Windows 10 の Segoe UI Emoji フォントを Windows 7 にインストールして,そのフォントで表示しています.



図15
カラーの絵文字が描画できるテキストエディタの例




07_フォントレンダリング用のライブラリ FreeType
plFreeType_Test.zip [44.1 MB] 2018年08月15日版 (EXE 同梱.説明なし)
マイクロソフトの COLR / CPAL 仕様のカラー絵文字の描画テスト


前項で紹介したテキストエディタ TATEditor の作者が書いた記事の中の FreeType は,フォントのレンダリング用のライブラリです.このライブラリは以下のサイトが提供しています. このライブラリの Windows 用のソースコードは C++ 用です.Delphi で使用するためには以下のリンクから DLL をダウンロードしてその DLL 内の関数を使用します.32 ビットの EXE で使用する時は [Win32] フォルダ内の freetype.dll を使用します.64 ビットの EXE で使用する時は [Win64] フォルダ内の freetype.dll を使用します.この DLL はシステム的にパスが通った場所に置きます.今回は EXE があるフォンダ内に置いてテストしています.
その下のリンクはソースコードのダウンロードのページへのリンクです.どちらも FreeType のサイトからのリンクです.2018年08月12日現在の FreeType のバージョンは 2.9.1 です.

図16
FreeType ライブラリの DLL
  • 使用するのは feeetype.dll だけ

ダウンロードしたバージョン 2.9.1 の DLL を使用するには Visual C++ 2017 のランタイムライブラリが必要です.マイクロソフトの以下のページからダウンロードできます.
32 ビットの EXE で使用する時は [x86] を選択してダウンロードしてインストールします.64 ビットの EXE で使用する時は [x64] を選択してからダウンロードしてインストールします.

このリンクは,正確には,最新の Visula Studio のバージョンの再配布可能パッケージのダウンロード用リンクです.2018年08月12日現在は Visuala Studio 2017 用となっています.


図17
Visual C++ のランタイムライブラリ

FreeType ライブラリを Delphi で利用するためのユニット類が以下のページにあります.
[ctypes] と [freetype] をダウンロードします.[ctypes] 内の ctypes.pas と [freetype] 内の [Demo] フォルダ以外のファイルを,ライブラリのパスが通った場所に置き,uses に FreeType を追加して利用します.
この Delphi 用のライブラリは少し古い FreeType 用です.必要に応じて FreeType.dll 内の関数等の定義コードを追加して利用します.

図18
[ctypes] と [freetype] をダウンロード
  • クリックすれば各々のダウンロードのページに移動できる
図19
ライブラリのパスの通った場所に置く
  • uses に FreeType を追加して利用

FreeType ライブラリを使用した簡単なテストコードとのその実行結果です.
Windows 10 から Segoe UI Emoji フォント (ファイル名は seguiemj.ttf) をコピーして,EXE が生成されるフォルダ内に置いてテストしています.
白い矩形領域がビットマップの領域です.絵文字のフォントはフォントの領域全体に描画されます.そのため,一般の文字と同時に描画する際はバランスを考慮する必要があるかも知れません.



図20
下のコードを Windows 7 で実行した結果
  • TBitmap の描画なのでいろいろな加工が可能


リスト7
FreeType を使用してカラー絵文字のフォントを TLabel の Canvas に描画
uses に FreeType が必要
//=============================================================================
//  FreeTypeライブラリを使用した文字のグリフ(字形)データの取得例
//  1文字だけの簡単な例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFTLibrary    : FT_Library;
  LError        : FT_Error;
  LByteStream   : TBytesStream;
  LFontFilePath : string;
  LLineHeight   : Integer;
  LCodePoint    : FT_ULong;
  LFTFace       : FT_Face;
  LGlyphIndex   : FT_UInt;
  LGlyphSlot    : FT_GlyphSlot;
  LDrawLeft     : Integer;
  LDrawTop      : Integer;
begin
  //文字を描画する背景を塗り潰す
  Label1.Canvas.Brush.Style := bsClear;
  Label1.Canvas.Brush.Color := clSilver;
  Label1.Canvas.FillRect(Label1.Canvas.ClipRect);


  //文字の高さ(ピクセル数)
  LLineHeight := 80;

  //FreeTypeライブラリの初期化
  LError := FT_Init_FreeType(LFTLibrary);
  if LError <> 0 then Exit;


  LByteStream := TBytesStream.Create;
  try
    //フォントファイルのデータをメモリストリームに読み込む
    LFontFilePath := ExpandFileName('.\seguiemj.ttf');
    LByteStream.LoadFromFile(LFontFilePath);

    //そのフォントデータからFT_Fac3オブジェクトを取得
    FT_New_Memory_Face(LFTLibrary,
                       @LByteStream.Bytes[0],
                       LByteStream.Size,
                       0,
                       LFTFace );

    //描画するピクセルのサイズを設定
    FT_Set_Pixel_Sizes(LFTFace, 0, LLineHeight);

    //グリフデータを取得する文字のコードポイント
    LCodePoint := $1F61C;

    //コードポイントの値から文字のグリフ(字形)のインデックスを取得
    LGlyphIndex := FT_Get_Char_Index(LFTFace, LCodePoint);
    //FT_Face.GlyphSlotとしてグリフのデータのポインタを取得
    FT_Load_Glyph(LFTFace, LGlyphIndex, FT_LOAD_DEFAULT);

    //グリフのビットマップデータを取得
    LGlyphSlot := LFTFace.glyph;
    FT_Render_Glyph(LGlyphSlot, FT_RENDER_MODE_NORMAL);

    //描画開始位置を指定
    LDrawLeft := 10;
    LDrawTop  := LLineHeight - LFTFace.glyph.bitmap_top;

    //取得したビットデータをTBitmapにして描画
    DrawFreeTypeBitmap(LGlyphSlot.bitmap, LDrawLeft, LDrawTop);
  finally
    FreeAndNil(LByteStream);
  end;

  //終了処理
  FT_Done_Face(LFTFace);
  FT_Done_FreeType(LFTLibrary) ;
end;

//-----------------------------------------------------------------------------
//  FreeTypeで取得したビットマップデータをTBitmapのデータにして描画
//  AFTBitmap : パレット情報なしの256色のビットマップのバイトデータ
//              データはボトムアップ
//  X         : 描画会開始X座標値
//  Y         : 描画開始Y座標値
//
//  ここでは32ビットのアルファチャンネル付きのビットマプに変換してから描画
//-----------------------------------------------------------------------------
procedure TForm1.DrawFreeTypeBitmap(AFTBitmap: FT_Bitmap; X, Y: Integer);
type
  TRGBQArray = array [0..High(Integer) div 4 - 1] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LBitmap    : TBitmap;
  LBytePos   : Integer;
  LPosX      : Integer;
  LPosY      : Integer;
  LScanArray : PRGBQArray;
  LColorQuad : RGBQUAD;
  LByte      : Byte;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.SetSize(AFTBitmap.width, AFTBitmap.rows);
    LBitmap.PixelFormat := pf32bit;
    LBitmap.AlphaFormat := afDefined;

    LBytePos := 0;
    for LPosY := 0 to LBitmap.Height - 1 do begin
      LScanArray := LBitmap.ScanLine[LPosY];

      for LPosX :=0 to LBitmap.Width - 1 do begin
        LByte := AFTBitmap.buffer[LBytePos];
        if LByte <> $00 then begin
          LByte := $00;
        end else begin
          LByte := $FF;
        end;
        LColorQuad.rgbRed      := LByte;
        LColorQuad.rgbGreen    := LByte;
        LColorQuad.rgbBlue     := LByte;
        LColorQuad.rgbReserved := $FF;

        LScanArray[LPosX] := LColorQuad;

        inc(LBytePos);
      end;
    end;

    Label1.Canvas.Draw(X, y, LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;


上のサンプルでは,マイクロソフトの COLR / CPAL 仕様の Color Emoji フォント (マイクロソフトの用語では Color Font) を使用していますが,FT_LOAD_COLOR にしてもカラーにはなりません.

FreeType 2.9.1 はこの仕様のフォントには対応していません.以下のリンクの記事で,この仕様に対応した FreeType を提供している方がいます.少し分かりにくいのですが「Rebased the patch here」と書かれている部分です.以下の 2 番目のリンクが実際のダウンロードの URL です.
ダウンロードしたファイルは FreeType 2.9 相当ですが,DLL は含まれていません.Visual C++ でコンパイルして DLL を作成してテストしました.Visual Studio Express 2013 for Windows Desktop を使用しました.

Visual C++ 2013 で作成した DLL なので,Visual C++ 2013 のランタイムライブラリが必要です.マイクロソフトの以下のページからダウンロードできます.
32 ビットの EXE を実行する時は x86 のファイルをダウンロードしてインストールします.64 ビットの EXE を実行する時は x64 のファイルをダウンロードしてインストールします.

図21
[builds] [windows] [vc2010] フォルダ
  • freetype.vcxproj を Visual Studio の IDE で開く
  • [ビルド] [構成マネージャ] で [Release] を選択して [Win32] または [x64] を選択
  • [ビルド] [ソリューションのビルド]
図22
[objs] 直下に DLL が作成される

作成した DLL を使用した簡単なテストコードとその実行結果です.Windows 7 の環境でも,カラーの絵文字であればカラーで描画できることが確認できました.
上の手順でビルドした DLL と,Windows 10 からコピーした Segoe UI Emoji フォント (ファイル名は seguiemj.ttf) を,EXE と同じフォルダ内に置いてテストしています.

本項の先頭から plFreeType_Test.zip をダウンロードすると,その中に EXE の作成と実行に必要なファイル類があります.ただしフォントファイルは同梱していません.



図23
下のコードを Windows 7 で実行した結果
  • Windows 7 でも,カラーの絵文字フォントであればカラーで描画できる
  • TBitmap の描画なのでいろいろな加工が可能

リスト8
COLR / CPAL 仕様に対応した FreeType を使用してカラー絵文字のフォントを描画
uses に FreeType が必要
implementation

{$R *.dfm}

const
  FT_LOAD_COLOR = 1 shl 20;


//=============================================================================
//  FreeTypeライブラリを使用してカラー絵文字を描画
//  MicrosoftのEmoji(Color Font)のCOLR/CPAL対応のFreeTypeライブラリを使用
//
//  Windows 10 のSegoe UI Emojiフォントをコピーしてテスト
//  1文字だけの簡単な例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFTLibrary    : FT_Library;
  LError        : FT_Error;
  LByteStream   : TBytesStream;
  LFontFilePath : string;
  LLineHeight   : Integer;
  LCodePoint    : FT_ULong;
  LFTFace       : FT_Face;
  LGlyphIndex   : FT_UInt;
  LGlyphSlot    : FT_GlyphSlot;
  LDrawLeft     : Integer;
  LDrawTop      : Integer;
begin
  //文字を描画する背景を塗り潰す
  Label1.Canvas.Brush.Style := bsClear;
  Label1.Canvas.Brush.Color := clSilver;
  Label1.Canvas.FillRect(Label1.Canvas.ClipRect);


  //文字の高さ(ピクセル数)
  LLineHeight := 80;

  //FreeTypeライブラリの初期化
  LError := FT_Init_FreeType(LFTLibrary);
  if LError <> 0 then Exit;


  LByteStream := TBytesStream.Create;
  try
    //フォントファイルのデータをメモリストリームに読み込む
    LFontFilePath := ExpandFileName('.\seguiemj.ttf');
    LByteStream.LoadFromFile(LFontFilePath);

    //そのフォントデータからFT_Fac3オブジェクトを取得
    FT_New_Memory_Face(LFTLibrary,
                       @LByteStream.Bytes[0],
                       LByteStream.Size,
                       0,
                       LFTFace );

    //描画するピクセルのサイズを設定
    FT_Set_Pixel_Sizes(LFTFace, 0, LLineHeight);

    //グリフデータを取得する文字のコードポイント
    LCodePoint := $1F61C;

    //コードポイントの値から文字のグリフ(字形)のインデックスを取得
    LGlyphIndex := FT_Get_Char_Index(LFTFace, LCodePoint);
    //FT_Face.GlyphSlotとしてグリフのデータのポインタを取得
    FT_Load_Glyph(LFTFace, LGlyphIndex, FT_LOAD_COLOR);

    //グリフのビットマップデータを取得
    LGlyphSlot := LFTFace.glyph;
    FT_Render_Glyph(LGlyphSlot, FT_RENDER_MODE_NORMAL);

    //描画開始位置を指定
    LDrawLeft := 10;
    LDrawTop  := LLineHeight - LFTFace.glyph.bitmap_top;

    //取得したビットデータをTBitmapにして描画
    DrawFreeTypeBitmap(LGlyphSlot.bitmap, LDrawLeft, LDrawTop);
  finally
    FreeAndNil(LByteStream);
  end;

  //終了処理
  FT_Done_Face(LFTFace);
  FT_Done_FreeType(LFTLibrary) ;
end;

//-----------------------------------------------------------------------------
//  FreeTypeで取得したビットマップデータをTBitmapのデータにして描画
//  AFTBitmap : ビットマップのバイトデータ
//              データはボトムアップ
//  X         : 描画会開始X座標値
//  Y         : 描画開始Y座標値
//
//  32ビットのアルファチャンネル付きのビットマプとして描画
//-----------------------------------------------------------------------------
procedure TForm1.DrawFreeTypeBitmap(AFTBitmap: FT_Bitmap; X, Y: Integer);
type
  TRGBQArray = array [0..High(Integer) div 4 - 1] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LIsColor   : Boolean;
  LIncValue  : Integer;
  LBitmap    : TBitmap;
  LBytePos   : Integer;
  LPosX      : Integer;
  LPosY      : Integer;
  LScanArray : PRGBQArray;
  LColorQuad : RGBQUAD;
  LByte      : Byte;
  LBValue    : Byte;
  LGValue    : Byte;
  LRValue    : Byte;
  LAValue    : Byte;
begin
  LBitmap := TBitmap.Create;
  try
    LBitmap.SetSize(AFTBitmap.width, AFTBitmap.rows);
    LBitmap.PixelFormat := pf32bit;
    LBitmap.AlphaFormat := afDefined;

    LIncValue := 1;
    LIsColor := AFTBitmap.width = AFTBitmap.pitch div 4;
    if LIsColor then LIncValue := 4;

    LBytePos := 0;
    for LPosY := 0 to LBitmap.Height - 1 do begin
      LScanArray := LBitmap.ScanLine[LPosY];

      for LPosX :=0 to LBitmap.Width - 1 do begin
        if LIsColor then begin
          LRValue := AFTBitmap.buffer[LBytePos + 0];
          LGValue := AFTBitmap.buffer[LBytePos + 1];
          LBValue := AFTBitmap.buffer[LBytePos + 2];
          LAValue := AFTBitmap.buffer[LBytePos + 3];
        end else begin
          LByte := AFTBitmap.buffer[LBytePos];
          if LByte <> $00 then begin
            LRValue := $00;
            LGValue := $00;
            LBValue := $00;
            LAValue := $FF;
          end else begin
            LRValue := $FF;
            LGValue := $FF;
            LBValue := $FF;
            LAValue := $FF;
          end;
        end;

        LColorQuad.rgbRed      := LRValue;
        LColorQuad.rgbGreen    := LGValue;
        LColorQuad.rgbBlue     := LBValue;
        LColorQuad.rgbReserved := LAValue;

        LScanArray[LPosX] := LColorQuad;

        inc(LBytePos, LIncValue);
      end;
    end;

    Label1.Canvas.Draw(X, y, LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;