TEdgeBrowserからface-api.jsで写真から顔領域を取得～Delphiソースコード集

TEdgeBrowserでアプリWebViewが使えるのでインターネットにある様々なJavascriptライブラリを使うことが出来る。
EdgeBrowserからface-api.jsを使って、写真から顔領域（x,y座標、幅,高さ）を取得し、領域を四角形で描画する。

（１）はじめに

Microsoft WebView2 ランタイムのインストールや、「WebView2Loader.dll」については、 https://mam-mam.net/delphi/tedgebrowser.html を参照してください。

（２）プロジェクトの作成と保存

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

プロジェクトフォルダ内に、以下の「index.html」ファイルを置きます。

<!DOCTYPE html>
<html>
<head>
<meta charset="UTF-8">
<script src="https://cdn.jsdelivr.net/npm/@vladmandic/face-api@1/dist/face-api.js"></script>
<script>
  //TinyFaceDetectorModelを使用する
  faceapi.nets.tinyFaceDetector.loadFromUri('https://cdn.jsdelivr.net/npm/@vladmandic/face-api@1.6.1/model');

  var elm=null;
  window.addEventListener('load',function(){
    elm=document.getElementById('result');
  });

  async function promiseLoadImage(img,src){
    return new Promise(function(resolve,reject){
      img.onload=function(){
        resolve(img);
      };
      img.onerror=function(err){
        reject(err);
      };
      img.src=src;
    });
  }

  async function Scan(src){
    elm.innerHTML='';
    let img=new Image();
    promiseLoadImage(img,src).then(function(img){
      //TinyFaceDetectorModelを使用する
      faceapi.detectAllFaces(img, new faceapi.TinyFaceDetectorOptions()).then(function(result){
        elm.innerHTML=JSON.stringify(result);
      });
    });
  }
</script>
</head>
<body>
  <div id="result" style="overflow-wrap:break-word;"></div>
</body>
</html>

（３）フォームの設計

フォームに、TEdgeBrowser×1個と、TButton×1個、TImage×２個をドラッグ＆ドロップします
Image1のプロパティ「Picture」に、顔領域を抽出したい写真を設定します。

写真は「ぱくたそ（https://www.pakutaso.com/）」さまの素材を使用させていただきました。

（４）ソースコードの記述

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, WebView2, Winapi.ActiveX, Vcl.StdCtrls,
  Vcl.ExtCtrls, Vcl.Edge, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage;

type
  T_imageDims=record
    _width:Integer;
    _height:Integer;
  end;
  T_box=record
    _x:single;
    _y:single;
    _width:single;
    _height:single;
  end;
  TFace=record
    _imageDims:T_imageDims;
    _score:single;
    _classScore:single;
    _className:string;
    _box:T_Box;
  end;
  TFaces=TArray<Tface>;

  TForm1 = class(TForm)
    EdgeBrowser1: TEdgeBrowser;
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure EdgeBrowser1ExecuteScript(Sender: TCustomEdgeBrowser;
      AResult: HRESULT; const AResultObjectAsJson: string);
  private
    { Private 宣言 }
    ResultString:string;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses System.NetEncoding, System.JSON.Serializers;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Proportional:=True;
  Image1.Stretch:=True;
  Image2.Proportional:=True;
  Image2.Stretch:=True;

  ResultString:='';
  EdgeBrowser1.Navigate(
    ExtractFilePath(Application.ExeName)+'..\..\index.html'
  );
end;


procedure TForm1.Button1Click(Sender: TObject);
var png:TPngImage;
    bmp:TBitmap;
    strm:TMemoryStream;
    b:TBytes;
    st:string;

    JsonS:TJsonSerializer;
    faces:TFaces;
    i:Integer;
begin
  Button1.Enabled:=False;

  bmp:=TBitmap.Create;
  png:=TPngImage.Create;
  strm:=TMemoryStream.Create;
  try
    bmp.Assign(Image1.Picture.Graphic);
    png.Assign(bmp);
    png.SaveToStream(strm);
    strm.Position:=0;
    SetLength(b,strm.size);
    strm.ReadData(@b[0],strm.Size);
    st:='data:image/png;base64,'+
        System.NetEncoding.TNetEncoding.Base64.EncodeBytesToString(b);
    st:=StringReplace(st,#13#10,'',[rfReplaceAll]);
  finally
    bmp.free;
    png.Free;
    strm.free;
  end;
  ResultString:='';
  EdgeBrowser1.ExecuteScript('Scan("'+st+'");');

  while (ResultString='') do
  begin
    EdgeBrowser1.ExecuteScript('document.getElementById("result").innerHTML');
    Sleep(100);
    Application.ProcessMessages;
  end;

  JsonS:=TJsonSerializer.Create;
  try
    faces:=JsonS.Deserialize<TFaces>(ResultString);
    Image2.Picture.Bitmap.Assign(Image1.Picture.Graphic);
    //顔領域に四角形を描画する
    for i := 0 to Length(faces)-1 do
    begin
      Image2.Picture.Bitmap.Canvas.Pen.Color:=clRed;
      Image2.Picture.Bitmap.Canvas.pen.Width:=4;
      Image2.Picture.Bitmap.Canvas.Brush.Style:=bsClear;
      Image2.Picture.Bitmap.Canvas.Rectangle(
        trunc(faces[i]._box._x),
        trunc(faces[i]._box._y),
        trunc(faces[i]._box._x+faces[i]._box._width),
        trunc(faces[i]._box._y+faces[i]._box._height)
      );
    end;
  finally
    JsonS.Free;
  end;
  Button1.Enabled:=True;
end;


procedure TForm1.EdgeBrowser1ExecuteScript(Sender: TCustomEdgeBrowser;
  AResult: HRESULT; const AResultObjectAsJson: string);
var st:string;
begin
  //戻り値が無い関数(例えばScan)を呼出した場合AResultObjectAsJsonの値は'{}'
  if AResultObjectAsJson='{}' then
  begin
    ResultString:='';
  end
  else if AResultObjectAsJson<>'null' then
  begin
    st:=AResultObjectAsJson;
    if st.Substring(0,1)='"' then
      st:=st.Substring(1,Length(st)-1);
    if st.Substring(Length(st)-1,1)='"' then
      st:=st.Substring(0,Length(st)-1);
    st:=StringReplace(st,'\"','"',[rfReplaceAll]);
    ResultString:=st;
  end
  else
  begin
    ResultString:='';
  end;
end;

end.

（５）「WebView2Loader.dll」ファイルを実行ファイルと同じフォルダ内にコピーする

「C:\Program Files (x86)\Embarcadero\Studio\21.0\Redist\win32\WebView2Loader.dll」
ファイルを、(2)でビルトした実行ファイルと同じフォルダ内（プロジェクト保存フォルダ\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

（６）実行する

「実行」⇒「実行」をクリックすると実行します
Button1をクリックすると、写真から顔領域を取得して表示します。

写真は「ぱくたそ（https://www.pakutaso.com/）」さまの素材を使用させていただきました。