Delphi 10.3.3 使用Android手机的摄像机来捕获环境图像（视频截图）

目标是使用安卓手机设备的摄像机来捕获环境图像（视频），并借助TImage和TVideoCaptureDevice类将其显示在设备上。
如果启用了CAM设备，则该项目应可在Android，MSWindows和macOS中运行。欢迎加入Delphi开发局QQ群:32422310
泰山老父开发工具：RAD Studio Delphi 10.3.3

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.