Source Code My sample to Use my Android 7.0 Nougat CAM device as my VideoCAM "live" - including Permissions procedure

emailx45

emailx45

Staff member
Premium
Joined
May 5, 2008
Messages
2,477
Reaction score
2,211
Location
here and there
My sample to Use my Android 7.0 Nougat CAM device as my VideoCAM "live" - including Permissions procedure
[SHOWTOGROUPS=4,20]
thanks to Fernando Rizzato for the stones path!

  • The purpose is to use the device's camera as a meant of capturing my ambient image (video) and showing it on the device throught the aid of a TImage and the TVideoCaptureDevice class.
  • This project should works in Android, MSWindows and macOS if it have a CAM device enabled.
  • RAD Studio 10.3.3
  • Firemonkey project
  • No action to save the video is taken!

Delphi-And-Video-Cam-Android.png


Code: 
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.
[/SHOWTOGROUPS]
 
You must log in or register to reply here.
Top