Delphi10.4.2のTEdgeBrowserでface-api.jsを使って写真から顔領域を取得する ~Delphiでお手軽プログラミング

Delphi10.4.2のTEdgeBrowserでface-api.jsを使って写真から顔領域を取得する ~Delphiでお手軽プログラミング

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

(1)はじめに

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

(2)プロジェクトの作成と保存

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

(3)フォームの設計

フォームに、TEdgeBrowser×1個と、TButton×1個、TImage×2個をドラッグ&ドロップします
Image1のプロパティ「Picture」に、顔領域を抽出したい写真を設定します。
写真は「ぱくたそ(https://www.pakutaso.com/)」さまの素材を使用させていただきました。

(4)ソースコードの記述

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.

(5)「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

(6)実行する

「実行」⇒「実行」をクリックすると実行します
Button1をクリックすると、写真から顔領域を取得して表示します。
写真は「はくたそ(https://www.pakutaso.com/)」さまの素材を使用させていただきました。