unit Demos.FindFaces.Forms.Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  System.Types, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ExtDlgs,
  Vcl.Graphics, System.Actions, Vcl.ActnList, System.ImageList, Vcl.ImgList,
  Vcl.ComCtrls, Vcl.ToolWin, Vcl.Imaging.JPEG,
  Azure.CognitiveServices.Core.Entities,
  Azure.CognitiveServices.FindFaces.Types;

type

  TMainForm = class(TForm)
    PhotoScrollBox: TScrollBox;
    PhotoImage: TImage;
    MarkerBox: TPaintBox;
    PhotoOpenDialog: TOpenPictureDialog;
    MainActionList: TActionList;
    MainImageList: TImageList;
    LoadPhotoAction: TAction;
    FindFaceAction: TAction;
    MainToolbar: TToolBar;
    LoadPhotoButton: TToolButton;
    FindFaceButton: TToolButton;
    ClearDataAction: TAction;
    ClearDataButton: TToolButton;
    AppExitAction: TAction;
    MainStatusBar: TStatusBar;
    AppExitButton: TToolButton;
    procedure LoadPhotoActionExecute(Sender: TObject);
    procedure FindFaceActionExecute(Sender: TObject);
    procedure MainActionListUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure MarkerBoxPaint(Sender: TObject);
    procedure AppExitActionExecute(Sender: TObject);
    procedure ClearDataActionExecute(Sender: TObject);
  private
    const
      FaceColors: array [0..StandardColorsCount - 1] of TColor = (
        clRed, clLime, clYellow, clBlue, clFuchsia, clAqua, clDkGray, clWhite,
        clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clGray);
    var
      FPhotoData: TBytes;
      FLastResponse: TAcsFindFacesResponse;
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  System.IOUtils,
  Azure.CognitiveServices.FindFaces.HTTP;

constructor TMainForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ClearDataAction.Execute;
end;

procedure TMainForm.AppExitActionExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.ClearDataActionExecute(Sender: TObject);
begin
  FLastResponse.Result := False;
  MarkerBox.Invalidate;
end;

procedure TMainForm.FindFaceActionExecute(Sender: TObject);
var
  LBroker: TAcsFindFacesHttpBroker;
  LConfig: IAcsConfiguration;
  LRequest: TAcsFindFacesRequest;
begin
  LConfig := LoadAcsConfiguration();
  LBroker := TAcsFindFacesHttpBroker.Create(LConfig);
  try
    LBroker.Endpoint := 'https://???.cognitiveservices.azure.com/contentmoderator/moderate/v1.0/ProcessImage/FindFaces';
    with LRequest do
    begin
      CacheImage := False;
      ImageData := FPhotoData;
      ImageType := 'image/jpeg';
    end;
    FLastResponse := LBroker.Execute(LRequest);
    Application.MessageBox(
      PChar(Format('Sono stati trovati %d visi nella foto.', [FLastResponse.Count])),
      PChar(Application.Title), MB_ICONINFORMATION or MB_OK);
  finally
    LBroker.Free;
  end;
  MarkerBox.Invalidate;
end;

procedure TMainForm.LoadPhotoActionExecute(Sender: TObject);
var
  LStream: TMemoryStream;
begin
  if not PhotoOpenDialog.Execute then
    Exit;

  FPhotoData := TFile.ReadAllBytes(PhotoOpenDialog.FileName);

  LStream := TMemoryStream.Create;
  try
    LStream.Write(FPhotoData, Length(FPhotoData));
    LStream.Position := 0;
    PhotoImage.Picture.LoadFromStream(LStream);
    PhotoImage.Left := 0;
    PhotoImage.Top := 0;
    PhotoImage.AutoSize := True;
    MarkerBox.Left := 0;
    MarkerBox.Top := 0;
    MarkerBox.Height := PhotoImage.Height;
    MarkerBox.Width := PhotoImage.Width;
  finally
    LStream.Free;
  end;

  ClearDataAction.Execute;
end;

procedure TMainForm.MainActionListUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  ClearDataAction.Enabled := FLastResponse.Result;
  FindFaceAction.Enabled := Length(FPhotoData) > 0;
  Handled := True;
end;

procedure TMainForm.MarkerBoxPaint(Sender: TObject);
var
  LCanvas: TCanvas;
  LFaceIndex: Integer;
  LFaceItem: TAcsFindFacesItem;
begin
  if not FLastResponse.Result then
    Exit;

  LCanvas := MarkerBox.Canvas;

  LCanvas.Lock;
  try
    LCanvas.Pen.Style := psSolid;
    LCanvas.Pen.Width := 2;
    LCanvas.Brush.Style := bsClear;

    for LFaceIndex := Low(FLastResponse.Faces) to High(FLastResponse.Faces) do
    begin
      LFaceItem := FLastResponse.Faces[LFaceIndex];
      LCanvas.Pen.Color := FaceColors[LFaceIndex];
      LCanvas.Rectangle(LFaceItem.GetAsRect);
    end;
  finally
    LCanvas.Unlock;
  end;
end;

end.
