FMX Android using CAM on Mobile to capture video and target to TImage + Permissions use

[Guest]

my sample based on tip by Fernando Rizzato (MVP Embarcadero lead South America)

 

unit uFormMain;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  System.Permissions,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Layouts,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.ListBox,
  FMX.Objects,
  FMX.ScrollBox,
  FMX.Memo,
  FMX.Media;

type
  TfrmFormMain = class(TForm)
    lytFormMain: TLayout;
    lytFormMainToolBar: TLayout;
    lytFormMainClientArea: TLayout;
    tbarFormMainMenu: TToolBar;
    sbtnCAMStartCamera: TSpeedButton;
    cmbboxCAMDevices: TComboBox;
    imgVideoCapture: TImage;
    mmMyLog: TMemo;
    sbtnCAMStopCamera: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure sbtnCAMStartCameraClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure imgVideoCaptureTap(Sender: TObject; const Point: TPointF);
    procedure sbtnCAMStopCameraClick(Sender: TObject);
    procedure cmbboxCAMDevicesChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    procedure prcMyLog(lText: string);
    //
    procedure prcCAMDevicesSetting;
    procedure prcCAMStartCapture;
    //
    {$IF DEFINED(ANDROID)}
    procedure prcPermissionsResulted(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>);
    procedure prcDisplayRationale(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc);
    {$ENDIF}
    //
    procedure prcCAMSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
    procedure prcCAMSampleBufferSync;
  public
  end;

var
  frmFormMain                 : TfrmFormMain;
  FFormTopPositionBeforeResize: integer = 0;

implementation

{$R *.fmx}

{
  This sample, will use the "TVideoCaptureDevice" (class base to "TCameraComponent") directly!!!
  This class is defined in "FMX.Media.pas"
  //
  TDialogService.ShowMessage() used for dont block main-thread!
}
//
uses
  FMX.DialogService
  {$IF DEFINED(ANDROID)}
    ,
  FMX.Helpers.Android,
  Androidapi.JNI.JavaTypes,
  Androidapi.Helpers,
  Androidapi.JNI.OS
  {$ENDIF}
    ;

//
var
  lMyCAMDevice    : TVideoCaptureDevice;
  lMyCAMPermission: string;

function fncMyIIF(lBooleanExpr: boolean; lTextTrue, lTextFalse: string): string;
begin
  result := lTextFalse;
  //
  if lBooleanExpr then
    result := lTextTrue;
end;

procedure TfrmFormMain.prcMyLog(lText: string);
begin
  mmMyLog.Lines.Add(lText);
end;

procedure TfrmFormMain.cmbboxCAMDevicesChange(Sender: TObject);
begin
  {$IF NOT DEFINED(ANDROID)}
  try
    lMyCAMDevice := nil;
    //
    lMyCAMDevice := TVideoCaptureDevice(TCaptureDeviceManager.Current.GetDevicesByName(cmbboxCAMDevices.Selected.Text));
    //
    sbtnCAMStartCamera.Enabled := not(lMyCAMDevice = nil);
    //
  except
    on E: Exception do
      prcMyLog('Error Start CAM' + #13#10 + E.Message);
  end;
  {$ENDIF}
end;

procedure TfrmFormMain.FormActivate(Sender: TObject);
begin
  {$IF NOT DEFINED(ANDROID)}
  FFormTopPositionBeforeResize := Self.Top; { when the user move the forms, needs change it too! }
  {$ENDIF}
end;

procedure TfrmFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not(lMyCAMDevice = nil) then
  begin
    {$IF DEFINED(ANDROID)}
    // if PermissionsService.IsEveryPermissionGranted([lMyCAMPermission]) then;
    if PermissionsService.IsPermissionGranted(lMyCAMPermission) then
    {$ENDIF}
    begin
      if (lMyCAMDevice.State = TCaptureDeviceState.Capturing) then
        lMyCAMDevice.StopCapture;
    end;
    //
    // lMyCAMDevice.Free; // if necessary!!!
  end;
end;

procedure TfrmFormMain.FormCreate(Sender: TObject);
begin
  {$IF NOT DEFINED(ANDROID)}
  FFormTopPositionBeforeResize := Self.Top;
  {$ENDIF}
  //
  //
  // Form.OnCreate is not better place to "critial" procedure!
  // Here, only basic procedures!
  //
  Self.Position          := TFormPosition.ScreenCenter;
  sbtnCAMStopCamera.Text := 'Stop Cam';
  //
  prcCAMDevicesSetting; // if necessary, move it for another place!
  //
  if not(lMyCAMDevice = nil) then
  begin
    prcMyLog(lMyCAMDevice.ToString); // unfortunatelly, dont have Name or Description on Mobile Android
    //
    sbtnCAMStartCamera.Enabled := True;
  end
  else
    prcMyLog('MyCAMDevice = nil');
end;

procedure TfrmFormMain.FormResize(Sender: TObject);
begin
  {$IF NOT DEFINED(ANDROID)}
  if (Self.Height <= 480) then
  begin
    Self.Top    := FFormTopPositionBeforeResize;
    Self.Height := 480;
  end;
  //
  if (Self.Width <= 640) then
    Self.Width := 640; // to avoid that ComboBox is gone...!
  {$ENDIF}
end;

procedure TfrmFormMain.imgVideoCaptureTap(Sender: TObject; const Point: TPointF);
{$IF DEFINED(ANDROID)}
var
  lObject: string;
  {$ENDIF}
begin
  {$IF DEFINED(ANDROID)}
  // for "TAPing" tests!
  //
  lObject := '';
  //
  if not(Sender = nil) then
    lObject := Sender.ClassName;
  //
  TDialogService.ShowMessage(                                            { }
    Format('Object=%s, Point X=%f, Y=%f, V[0]=%f, V[1]=%f, IsZero=%s', [ { }
    lObject, Point.X, Point.Y, Point.V[0], Point.V[1],                   { }
    fncMyIIF(Point.IsZero, 'is zero', 'is not zero')                     { }
    ]));
  {$ENDIF}
end;

procedure TfrmFormMain.prcCAMDevicesSetting;
{$IF NOT DEFINED(ANDROID)}
var
  DeviceList: TCaptureDeviceList;
  i         : integer;
  {$ENDIF}
begin
  {$IF DEFINED(ANDROID)}
  cmbboxCAMDevices.Visible := False;
  try
    // Normally, there is only 1 cam in Mobile!
    //
    // NOTE: any try to read or change any property from CAM, NEEDS "permissions"!!!
    lMyCAMDevice := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
    //
    lMyCAMDevice.OnSampleBufferReady := prcCAMSampleBufferReady; // showing our video on TImage
    //
    // DONT TRY READ or CHANGE any property from CAMDevice here!!!
    // Like: Start or Stop, Quality, IsDefault, etc...
    // Only later your "permissions" to be given by user!!!
  except
    on E: Exception do
      prcMyLog('Error CAM definition' + #13#10 + E.Message);
  end;
  {$ELSE}
  DeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType(TMediaType.Video);
  //
  for i := 0 to (DeviceList.Count - 1) do
    cmbboxCAMDevices.Items.Add(DeviceList[i].Name);
  {$ENDIF}
end;

{$IF DEFINED(ANDROID)}  // DisplayRationale and PermissionsResulted is used only mobile!

procedure TfrmFormMain.prcDisplayRationale(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc);
var
  lRationaleMsg: string;
  i            : integer;
begin
  for i := 0 to high(APermissions) do
  begin
    if APermissions[i] = lMyCAMPermission then
      lRationaleMsg := lRationaleMsg + 'This app needs access your CAM to works' + SLineBreak + SLineBreak;
  end;
  //
  // Show an explanation to the user *asynchronously* - don't block this thread waiting for the user's response!
  // After the user sees the explanation, invoke the post-rationale routine to request the permissions
  //
  TDialogService.ShowMessage(lRationaleMsg,
    procedure(const AResult: TModalResult)
    begin
      // TProc is defined in System.SysUtils
      //
      APostRationaleProc; // used by System to go-back in before function...
    end)
end;

procedure TfrmFormMain.prcPermissionsResulted(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>);
begin
  // verifying if the permissions was granted! - Here, testing only 1 permission = CAM
  if (Length(AGrantResults) = 1) and (AGrantResults[0] = TPermissionStatus.Granted) then
    prcCAMStartCapture { execute your procedure here if all it's ok }
  else
    TDialogService.ShowMessage('The permission <<CAMERA access>> not allowed by user');
end;
{$ENDIF}

procedure TfrmFormMain.prcCAMSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  // ******
  // DONT USE "main thread" to process something "critial" like: process images by Cam
  // or anyother that can "crash" your UI (user interface) or app!!!
  // ***************************************************************
  // If exist images to process, then, put it on a "queue" to execute it!
  // Here, "prcSampleBufferSync" will be called always in a queue from main thread (your app)
  // to "dont paralize it" while the images it's processed!!!
  //
  // .............."main thread".........."method called"
  //
  TThread.Queue(TThread.CurrentThread, prcCAMSampleBufferSync);
  //
end;

procedure TfrmFormMain.prcCAMSampleBufferSync;
begin
  //
  // use your imagination, to redirect this buffer !!! :)
  //
  // in the meantime ... let's write the pictures coming from the camera in the TImage
  lMyCAMDevice.SampleBufferToBitmap(imgVideoCapture.Bitmap, True);
  //
end;

procedure TfrmFormMain.prcCAMStartCapture;
begin
  if not(lMyCAMDevice = nil) then
  begin
    // to Mobile (Android), change properties from CAMERA, needs permission!
    {$IF DEFINED(ANDROID)}
    if PermissionsService.IsPermissionGranted(lMyCAMPermission) then
    {$ENDIF}
    begin
      try
        lMyCAMDevice.StopCapture; // to avoid any error below
        //
        lMyCAMDevice.Quality := TVideoCaptureQuality.PhotoQuality;
        //
        lMyCAMDevice.StartCapture; // starting video capture!
        //
        prcMyLog('CAM device = Capture stated!');
        prcMyLog('CAM ' + fncMyIIF(lMyCAMDevice.IsDefault, 'is', 'is not') + ' Default');
        prcMyLog('CAM ' + fncMyIIF(lMyCAMDevice.HasFlash, 'has', 'has not') + ' Flash');

      except
        on E: Exception do
          prcMyLog('Error Start CAM' + #13#10 + E.Message);
      end;
    end
    {$IF DEFINED(ANDROID)}
    else
      TDialogService.ShowMessage('Then CAM device needs your permission to access it!');
    {$ENDIF}
  end
  else
    TDialogService.ShowMessage('None CAM device defined!');
end;

procedure TfrmFormMain.sbtnCAMStopCameraClick(Sender: TObject);
begin
  if not(lMyCAMDevice = nil) then
  begin
    // Needs "permissions" to read or change CAM properties!
    //
    {$IF DEFINED(ANDROID)}
    if PermissionsService.IsPermissionGranted(lMyCAMPermission) then
    {$ENDIF}
    begin
      if (lMyCAMDevice.State = TCaptureDeviceState.Capturing) then
        lMyCAMDevice.StopCapture
      else
        lMyCAMDevice.StartCapture;
    end
    {$IF DEFINED(ANDROID)}
    else
      TDialogService.ShowMessage('The <<CAMERA access>> permission is necessary');
    {$ENDIF}
  end;
end;

procedure TfrmFormMain.sbtnCAMStartCameraClick(Sender: TObject);
begin
  {$IF DEFINED(ANDROID)}
  PermissionsService.RequestPermissions( { }
  [lMyCAMPermission],                    { }
  prcPermissionsResulted,                { }
  prcDisplayRationale                    { = nil, if you DONT WANT show any message! }
    );
  {$ELSE}
  prcCAMStartCapture; // MSWindows or macOS
  {$ENDIF}
end;

initialization

lMyCAMDevice := nil;
{$IF DEFINED(ANDROID)}
lMyCAMPermission := JStringToString(TJManifest_permission.JavaClass.CAMERA);
{$ENDIF}

finalization

end.

 

hug

Edited December 30, 2020 by Guest

[tiagoom 0]

Congratulations. Very good example. I implemented it in my APP. However, I would like to know how to use the front camera and set other camera properties.

[Guest]

54 minutes ago, tiagoom said:

Congratulations. Very good example.

 

with FMX.Media.TCameraComponent if using iOS you can choice between: Frontal or Back CAM, using "Kind" property! BUT, it is said: "deprecated" on RAD warning!!! then,use "TCameraKind.<< kind here >>

see more on HELP SYSTEM!

 

other way, you can try adapt my code using some like this:

var
  lVideoCaptureDevice: TVideoCaptureDevice;
  lCaptureDevice     : TCaptureDevice;
  i                  : integer;
begin
  lVideoCaptureDevice := nil;
  //
  for i := 0 to (TCaptureDeviceManager.Current.Count - 1) do
  begin
    lCaptureDevice := TCaptureDeviceManager.Current.Devices[i];
    //
    if (lCaptureDevice.MediaType = TMediaType.Video) and (lCaptureDevice is TVideoCaptureDevice) then
    begin
      if TVideoCaptureDevice(lCaptureDevice).Position = TDevicePosition.Front then
        lVideoCaptureDevice := TVideoCaptureDevice(lCaptureDevice);
      break; // jump out looping...
    end;
  end;
  //
  if not(lVideoCaptureDevice=nil) then
    ShowMessage('Hello Frontal CAM...');
end;

NOTE: I dont have tested ok, now is with you!

 

hug