Delphi × WebView4Delphiで笑顔度解析：face-api.js活用ガイド

Delphiで顔認識を実装したい方へ。この記事では、WebView4Delphiを使ってJavaScriptライブラリ「face-api.js」と連携し、複数画像の笑顔度を解析する方法を紹介します。
画像の並び替えやスコア算出まで、ソースコード付き。DelphiとWeb技術の融合を体験してみましょう。

WebView4Delphiを使うとDelphiからjavascriptライブラリface-api.jsを使用することが出来ます。
https://github.com/justadudewhohacks/face-api.js
このページではこのライブラリを用いて複数の顔写真の笑顔度（複数の顔が検知された場合はその平均値とします）を取得し値の降順にファイル名を並べ替えを行う方法を具体的手順やソースコードで解説します。

webview4delphi(WebView2)のインストールについては以下を参照してください。
https://mam-mam.net/delphi/tedgebrowser_webview4delphi.html

face-api.jsをダウンロードする

https://github.com/justadudewhohacks/face-api.js
の右上にある「code」⇒「Download ZIP」をクリックすると face-api.js-master.zip がダウンロードできます。

画面設計

Delphi IDEを起動し、「ファイル」⇒「Windows VCLアプリケーション -Delphi」をクリックします。
「ファイル」⇒「すべて保存 Ctrl+Shift+S」をクリックして、プロジェクト保存用フォルダを作成してユニット(Unit1)とプロジェクト(Project1)を保存します
次に、「プロジェクト」⇒「Project1をビルト Shift+F9」をクリックして事前に一度コンパイルしておきます。（フォルダが生成される）

フォームに以下のコンポーネントをドラッグ＆ドロップします。

TButton ×2
TActivityIndicator ×1
TApplicationEvents ×1
TStringGrid ×1
TMemo ×1
TWVBrowser ×1
TWVWindowParent ×1
TImage ×1

「WebView2Loader.dll」ファイル

「WebView2Loader.dll」ファイルを、実行ファイルと同じフォルダ内（プロジェクト保存フォルダ\Win32\Debug）にコピーします

(A)「Debug」ビルトで「Windows 32ビット」	プロジェクト保存フォルダ\Win32\Debug
(B)「Debug」ビルトで「Windows 64ビット」	プロジェクト保存フォルダ\Win64\Debug
(C)「Release」ビルトで「Windows 32ビット」	プロジェクト保存フォルダ\Win32\Release
(D)「Release」ビルトで「Windows 64ビット」	プロジェクト保存フォルダ\Win64\Release

HTMLファイル、jsファイルなどの配置

プロジェクト保存フォルダ\Win32\Debug に「htdocs」フォルダを作成します。
プロジェクト保存フォルダ\Win32\Debug\htdocs に、
face-api.js-master.zip ファイルを解凍したフォルダ「face-api.js-master」を丸ごとコピーします。

プロジェクト保存フォルダ\Win32\Debug\htdocs に、以下の index.html ファイルをUTF-8で保存します。
SSD-MobileNetV1を使用して顔検出するように設定しています。
SSD-MobileNetV1はCNN（畳み込みニューラルネットワーク）ベースのモデルでDepthwise Separable Convolution を採用した約28層の構成のようです。

<!DOCTYPE html>
<html lang="ja">
<head>
<meta charset="UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<script src="./face-api.js-master/dist/face-api.min.js"></script>
<script>
//SsdMobilenetv1Modelを使用する(低速、高精度)
faceapi.nets.ssdMobilenetv1.loadFromUri('./face-api.js-master/weights');

//Expressionを使用する
faceapi.nets.faceExpressionNet.loadFromUri("./face-api.js-master/weights"); 

window.addEventListener('load',function(event){
  console.log("Loaded");
});

async function detect(img,no){
  //SsdMobilenetv1Model
  let result = await faceapi.detectAllFaces(img).withFaceExpressions();

  let score=0;
  for(i=0;i<result.length;i++){
    score += result[i].expressions.happy;
  }
  if(result.length>0){
    score = score/result.length;
  }
  document.getElementById("test").innerHTML="顔を"+result.length+"個認識";
  console.log(score+','+no);
}

async function getHappyLevel(data,no){
  //document.getElementById("test").innerHTML=data;
  let img=new Image();
  img.onload=function(){
    detect(img,no);
  }
  img.src=data;
  document.getElementById("img").src=data;
}

</script>
</head>
<body>
  <div id="test"></div>
  <img id="img" style="width:100px;height:auto;">
</body>
</html>

以下のようなフォルダ、ファイル構成になります。

プロジェクト保存フォルダ\Win32\Debug\	WebView2Loader.dll
	htdocs\	index.html
		face-api.js-master\	dist\・・・ examples\・・・ src\・・・ weights\・・・・・・

ソースコードの記述

以下ソースコードをコピー＆ペーストして、IDEから各イベントプロパティを設定します。

オブジェクト	イベント	プロシージャ
Form1	OnCreate	FormCreate
Form1	OnDestroy	FormDestroy
Button1	OnClick	Button1Click
Button2	OnClick	Button2Click
ApplicationEvents1	OnMessage	ApplicationEvents1Message
StringGrid1	OnSelectCell	StringGrid1SelectCell
WVBrowser1	OnAfterCreated	WVBrowser1AfterCreated
WVBrowser1	OnDevToolsProtocolEventReceived	WVBrowser1DevToolsProtocolEventReceived
WVBrowser1	OnDOMContentLoaded	WVBrowser1DOMContentLoaded

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.IOUtils,
  uWVWinControl, uWVWindowParent, uWVTypes, uWVConstants, uWVTypeLibrary,
  uWVLoader, uWVInterfaces, uWVBrowserBase, uWVBrowser, uWVCoreWebView2,
  uWVCoreWebView2Args, uWVLibFunctions,
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Grids, Vcl.AppEvnts,
  Vcl.WinXCtrls,
  System.Generics.Collections, System.Generics.Defaults;

type
  TForm1 = class(TForm)
    WVBrowser1: TWVBrowser;
    WVWindowParent1: TWVWindowParent;
    Memo1: TMemo;
    StringGrid1: TStringGrid;
    Button1: TButton;
    ApplicationEvents1: TApplicationEvents;
    Button2: TButton;
    ActivityIndicator1: TActivityIndicator;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure WVBrowser1AfterCreated(Sender: TObject);
    procedure WVBrowser1DOMContentLoaded(Sender: TObject;
      const aWebView: ICoreWebView2;
      const aArgs: ICoreWebView2DOMContentLoadedEventArgs);
    procedure WVBrowser1DevToolsProtocolEventReceived(Sender: TObject;
      const aWebView: ICoreWebView2;
      const aArgs: ICoreWebView2DevToolsProtocolEventReceivedEventArgs;
      const aEventName: wvstring; aEventID: Integer);
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
  private
    { Private 宣言 }
    //画像ファイルと笑顔度のリスト
    ImageFileList: TList<TPair<string, Single>>;
    procedure SearchImageFiles(path:string);
    procedure SetStringGrid();
  public
    { Public 宣言 }
  end;

  //ブラウザのコンソールに届くjsonメッセージのデコード用構造体の宣言
  TJsonMsg=record
    column:Integer;
    level:String;
    line:Integer;
    source:String;
    text:String;
    url:String;
  end;
  TJsonMessage=record
    message:TJsonMsg;
  end;


var
  Form1: TForm1;
  BrowserCachePath:String;

implementation

{$R *.dfm}

uses Vcl.Imaging.jpeg, Vcl.Imaging.pngimage,
     System.Math, System.NetEncoding, System.JSON.Serializers, Winapi.ShellAPI;


procedure TForm1.SearchImageFiles(path:string);
var ext:String;
    f:TSearchRec;
    ret:Integer;
    i:Integer;
    flag:Boolean;
begin
  if FileExists(path) then
  begin
    ext:=LowerCase(ExtractFileExt(path));
    if (ext='.jpg') or (ext='.jpeg') or (ext='.png') then
    begin
      //既にリストに画像ファイルがあるかを確認する
      flag:=True;
      for i := 0 to ImageFileList.Count-1 do
        if ImageFileList[i].Key=path then
        begin
          flag:=False;
          break;
        end;
      if flag then
        ImageFileList.Add(TPair<string, Single>.Create(path, -1));
    end;
  end
  else if DirectoryExists(path) then
  begin
    ret:=FindFirst(path+'\*',faAnyFile,f);
    while ret=0 do
    begin
      if (f.Name<>'.') and (f.Name<>'..') then
      begin
        SearchImageFiles(path+'\'+f.Name);
      end;
      ret:=FindNext(f);
    end;
    FindClose(f);
  end;
end;

procedure TForm1.SetStringGrid;
var i:Integer;
begin
  StringGrid1.ColCount:=2;
  StringGrid1.RowCount:=2;
  StringGrid1.FixedCols:=0;
  StringGrid1.FixedRows:=1;
  StringGrid1.Rows[0].CommaText:='画像ファイル名,笑顔度';
  StringGrid1.ColWidths[0]:=512;
  StringGrid1.ColWidths[1]:=64;
  if ImageFileList.Count=0 then
  begin
    StringGrid1.Rows[1].CommaText:=',';
  end
  else
  begin
    StringGrid1.RowCount:=ImageFileList.Count+1;
    for i := 0 to ImageFileList.Count-1 do
    begin
      StringGrid1.Cells[0,i+1]:=ImageFileList[i].Key;
      if ImageFileList[i].Value=-1 then
        StringGrid1.Cells[1,i+1]:=''
      else
        StringGrid1.Cells[1,i+1]:=
          FormatFloat('0.0000',ImageFileList[i].Value);
    end;
  end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  Image1.Stretch:=True;
  Image1.Proportional:=True;
  if (StringGrid1.Cells[0,ARow]<>'') and (ARow>0) then
  begin
    Image1.Picture.LoadFromFile(StringGrid1.Cells[0,ARow]);
  end;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
var DropCount:Cardinal;
    i:Cardinal;
    FileName:array[0..4096] of Char;
begin
  Handled:=False;
  if Msg.message=WM_DROPFILES then
  begin
    try
      //ドロップされたファイル、フォルダ数を取得
      DropCount := DragQueryFile(Msg.wParam, Cardinal(-1), nil, 0);
      for i := 0 to DropCount-1 do
      begin
        DragQueryFile(Msg.wParam, i, FileName, Length(FileName));
        SearchImageFiles(FileName);
      end;
    finally
      SetStringGrid();
      DragFinish(Msg.wParam);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:Integer;
    st,ext:string;
    jpg:TJPEGImage;
    png:TPngImage;
    bmp:TBitmap;
    strm:TMemoryStream;
    b:TBytes;
    key:String;
begin
  if ImageFileList.Count=0 then exit;
  Button1.Enabled:=False;
  Button2.Enabled:=False;
  ActivityIndicator1.Animate:=True;

  jpg:=TJpegImage.Create;
  png:=TPngImage.Create;
  bmp:=TBitmap.Create;
  strm:=TMemoryStream.Create;
  try
    for i:=0 to ImageFileList.Count-1 do
    begin
      key:=ImageFileList[i].Key;
      ImageFileList[i]:=TPair<string,Single>.Create(key,-1);

      ext:=LowerCase(ExtractFileExt(ImageFileList[i].Key));
      if (ext='.jpg') or (ext='.jpeg') then
      begin
        jpg.LoadFromFile(ImageFileList[i].Key);
        bmp.Assign(jpg);
        png.Assign(bmp);
      end
      else
        png.LoadFromFile(ImageFileList[i].Key);
      strm.Size:=0;
      png.SaveToStream(strm);
      SetLength(b,strm.Size);
      strm.Position:=0;
      strm.ReadData(@b[0],strm.Size);
      //PNG画像データをData URIスキーム(Base64)形式に変換してJavascript関数へ送る
      st:='data:image/png;base64,'+
        System.NetEncoding.TNetEncoding.Base64.EncodeBytesToString(b);
      st:=StringReplace(st,#13#10,'',[rfReplaceAll]);
      WVBrowser1.ExecuteScript('getHappyLevel("'+st+'",'+IntToStr(i)+')');
      //Javascriptの実行が完了するまで待つ
      while ImageFileList[i].Value=-1 do
      begin
        Application.ProcessMessages;
        sleep(50);
      end;
    end;
    //画像ファイルリストを笑顔度の降順に並べ替える
    ImageFileList.Sort(TComparer<TPair<string, Single>>.Construct(
      function(const L, R: TPair<string, Single>): Integer
      begin
      //笑顔度降順並び替え
        Result := CompareValue(R.Value, L.Value);
      end
    ));
  finally
    jpg.Free;
    png.Free;
    bmp.Free;
    strm.Free;
  end;

  SetStringGrid();
  ActivityIndicator1.Animate:=False;
  Button1.Enabled:=True;
  Button2.Enabled:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ImageFileList.Clear;
  SetStringGrid();
end;

procedure TForm1.FormCreate(Sender: TObject);
var ct:integer;
begin
  Button1.Enabled:=False;
  Button2.Enabled:=False;
  Button1.Caption:='笑顔度測定開始';
  Button2.Caption:='画像リストクリア';

  ActivityIndicator1.Animate:=True;
  ActivityIndicator1.IndicatorSize:=aisXLarge;

  //Form1でファイルのドロップ処理を受け付ける
  DragAcceptFiles(Self.Handle, True);

  ImageFileList:=TList<TPair<string, Single>>.Create();

  WVWindowParent1.Browser:=WVBrowser1;
  if GlobalWebView2Loader.InitializationError then
  begin
    ShowMessage(GlobalWebView2Loader.ErrorMessage);
  end
  else
  begin
    ct:=0;
    while (ct<20) and (not GlobalWebView2Loader.Initialized) do
    begin
      sleep(500);
      Application.ProcessMessages;
      inc(ct);
    end;
    if GlobalWebView2Loader.Initialized then
      WVBrowser1.CreateBrowser(WVWindowParent1.Handle)
    else
      ShowMessage('WebView2初期化失敗');
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ImageFileList.Free;
end;

//-----------------------------------------------------------------------------
//  initialization 部
//  GlobalWebView2Loaderをロードしてグローバル環境を非同期的に初期化
//  UserDataFolder はキャッシュやクッキー等の保存場所
//-----------------------------------------------------------------------------
procedure TForm1.WVBrowser1AfterCreated(Sender: TObject);
begin
  //以下必須
  WVWindowParent1.UpdateSize;

  //「htdocs」ディレクトリを「https://demo/」に割り当てる
  WVBrowser1.CoreWebView2.SetVirtualHostNameToFolderMapping(
    'demo',
    PWideChar(ExtractFilePath(Application.ExeName)+'htdocs'),
    COREWEBVIEW2_HOST_RESOURCE_ACCESS_KIND_ALLOW
  );
  //デフォルトのURLを設定
  WVBrowser1.DefaultURL:='https://demo/index.html';

  //ブラウザのコンソールの使用を申請する
  WVBrowser1.CallDevToolsProtocolMethod(
    'Console.enable',
    '{}', 0
  );
  //コンソールにメッセージが出力された時に aEventID=1 として
  //「OnDevToolsProtocolEventReceived」イベントを発生させる
  WVBrowser1.SubscribeToDevToolsProtocolEvent('Console.messageAdded',1);
end;

procedure TForm1.WVBrowser1DevToolsProtocolEventReceived(Sender: TObject;
  const aWebView: ICoreWebView2;
  const aArgs: ICoreWebView2DevToolsProtocolEventReceivedEventArgs;
  const aEventName: wvstring; aEventID: Integer);
var pwc:PChar;
    JsonSerializer:TJsonSerializer;
    JsonMsg:TJsonMessage;
    ArrStr:TArray<String>;
    key:string;
begin
  if aEventID=1 then
  begin
    aArgs.Get_ParameterObjectAsJson(pwc);
    JsonSerializer:=TJsonSerializer.Create;
    JsonMsg:=JsonSerializer.Deserialize<TJsonMessage>(pwc);
    JsonSerializer.Free;
    ArrStr:=JsonMsg.message.text.Split([',']);
    if ArrStr[0]='Loaded' then
    begin
      //HTMLファイルのロードが完了
      Button1.Enabled:=True;
      Button2.Enabled:=True;
      Memo1.Lines.Add('.jpg .png ファイルをウィンドウにドラッグ＆ドロップしてください');
      ActivityIndicator1.Animate:=False;
    end
    else if Length(ArrStr)=2 then
    begin
      key:=ImageFileList[StrToInt(ArrStr[1])].Key;
      ImageFileList[StrToInt(ArrStr[1])]:=
        TPair<string,Single>.Create(key,StrToFloat(ArrStr[0]));
    end;
  end;
end;

procedure TForm1.WVBrowser1DOMContentLoaded(Sender: TObject;
  const aWebView: ICoreWebView2;
  const aArgs: ICoreWebView2DOMContentLoadedEventArgs);
var pUri:PChar;
begin
  //URL移動した時にURLを取得
  aWebView.Get_Source(pUri);
end;


initialization
begin
  BrowserCachePath:=ExtractFilePath(Application.ExeName) + 'CustomCache';
  //キャッシュを削除する
  if DirectoryExists(BrowserCachePath) then TDirectory.Delete(BrowserCachePath,true);
  GlobalWebView2Loader := TWVLoader.Create(nil);
  GlobalWebView2Loader.UserDataFolder := BrowserCachePath;
  GlobalWebView2Loader.StartWebView2;
end;

end.

実行する

実行し、しばらく待ちます。（face-api.jsのロード待ち）

.jpg 又は .jpg ファイルをドラッグ＆ドロップします。

笑顔度測定開始ボタンをクリックし、しばらく待つと、笑顔度が測定され降順に表示されます。