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