Вот кусок кода из боевого приложения, достаточно разрешения на доступ к камере, больше никаких разрешений не надо. Надеюсь вам поможет.
FScanCamera : TCameraComponent;
FScanManager - не обращайте внимания, это распознавание QR кодов.
ImageCamera : TImage; - картинка на форме где отображаются кадры с камеры
Работа начинается с ScanStart()
{$IFDEF MOBILE}
// ***************************************************************
// ****** Сканирование QR кода ******
// ***************************************************************
procedure TFormMain.ScanStart();
var AppEventSvc: IFMXApplicationEventService;
APermissionCamera : String;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(AppEventSvc)) then
AppEventSvc.SetApplicationEventHandler(AppEvent);
FScanFrameTake := 0;
CButtonScan.Text:='Отменить сканирование';
{$IFDEF IOS}
ScanStarting();
{$ENDIF IOS}
{$IFDEF ANDROID}
APermissionCamera := JStringToString(TJManifest_permission.JavaClass.CAMERA);
PermissionsService.RequestPermissions([APermissionCamera], CameraPermissionRequestResult, ExplainReason);
{$ENDIF ANDROID}
end;
procedure TFormMain.ScanStop();
begin
if Assigned(FScanCamera) then
begin
if FScanCamera.Active then
FScanCamera.Active:=False;
FScanCamera.Free;
end;
{
if Assigned(FScanManager) then
begin
FScanManager.Free;
end;
}
FScanInProgress := false;
LayoutCamera.Height:=0;
CButtonScan.Text:='Сканировать QR-код';
end;
{$IFDEF ANDROID}
procedure TFormMain.CameraPermissionRequestResult(Sender: TObject; const APermissions: TArray<string>; const AGrantResults: TArray<TPermissionStatus>);
begin
if (Length(AGrantResults) = 1) and (AGrantResults[0] = TPermissionStatus.Granted) then
begin
ScanStarting();
end
else
TDialogService.ShowMessage('Сканирование QR-кода не возможно, требуемое разрешение не было дано')
end;
procedure TFormMain.ExplainReason(Sender: TObject; const APermissions: TArray<string>; const APostRationaleProc: TProc);
begin
TDialogService.ShowMessage('Приложению нужен доступ к камере для сканирования QR-кода ...',
procedure(const AResult: TModalResult)
begin
APostRationaleProc;
end)
end;
{$ENDIF ANDROID}
procedure TFormMain.ScanStarting();
begin
FScanInProgress := false;
if Not Assigned(FScanManager) then
FScanManager:= TScanManager.Create(TBarcodeFormat.QR_CODE, nil);
if Not Assigned(FScanCamera) then
FScanCamera:=TCameraComponent.Create(Self);
FScanCamera.OnSampleBufferReady:=ScanCameraSampleBufferReady;
FScanCamera.Quality := FMX.Media.TVideoCaptureQuality.MediumQuality;
FScanCamera.Active := false;
FScanCamera.Kind := FMX.Media.TCameraKind.BackCamera;
FScanCamera.FocusMode := FMX.Media.TFocusMode.ContinuousAutoFocus;
FScanCamera.Active := True;
LayoutCamera.Height:=LayoutCamera.Width;
end;
{
procedure TFormMain.btnStopCameraClick(Sender: TObject);
begin
end;
}
procedure TFormMain.ScanCameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
TThread.Synchronize(TThread.CurrentThread, GetImageCamera);
end;
procedure TFormMain.GetImageCamera;
var scanBitmap: TBitmap;
ReadResult: TReadResult;
begin
FScanCamera.SampleBufferToBitmap(ImageCamera.Bitmap, True);
if (FScanInProgress) then
exit;
{ This code will take every 4 frame. }
Inc(FScanFrameTake);
if (FScanFrameTake mod 4 <> 0) then
exit;
scanBitmap := TBitmap.Create();
scanBitmap.Assign(ImageCamera.Bitmap);
ReadResult := nil;
// There is bug in Delphi Berlin 10.1 update 2 which causes the TTask and
// the TThread.Synchronize to cause exceptions.
// See: https://quality.embarcadero.com/browse/RSP-16377?jql=project%20%3D%20RSP%20AND%20issuetype%20%3D%20Bug%20AND%20affectedVersion%20%3D%20%2210.1%20Berlin%20Update%202%22%20AND%20status%20%3D%20Open%20ORDER%20BY%20priority%20DESC
TTask.Run(
procedure
begin
try
FScanInProgress := True;
try
ReadResult := FScanManager.Scan(scanBitmap);
except
on E: Exception do
begin
TThread.Synchronize(nil,
procedure
begin
LabelAPIKey.Text := 'Ключ доступа : ' + E.Message;
end);
exit;
end;
end;
TThread.Synchronize(nil,
procedure
begin
if (ReadResult <> nil) then
begin
if ProcessingAPIKeyHex(ReadResult.Text) then
begin
ScanStop();
end;
end;
end);
finally
ReadResult.Free;
scanBitmap.Free;
FScanInProgress := false;
end;
end);
end;
{ Make sure the camera is released if you're going away. }
function TFormMain.AppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
begin
case AAppEvent of
TApplicationEvent.WillBecomeInactive,
TApplicationEvent.EnteredBackground,
TApplicationEvent.WillTerminate:
if Assigned(FScanCamera) then
FScanCamera.Active := false;
end;
Result:=True;
end;
Тема: "Сравнение возможностей кроссплатформенных мобильных библиотек нативных приложений FMX и FGX Native"
Дата и время: 20 декабря 2018 года в 12:00 (по московскому времени)
Участники: @Brovin Yaroslav, Андрей Совцов
Регистрация: ссылка
Ссылка на официальный телеграмм канал: https://t.me/fgx_native
Участие бесплатное
Под конец уходящего нового года сравним текущие возможности кроссплатформенной библиотеки мобильной разработки FGX Native и FMX. Поговорим о перспективах развития и ознакомимся с ближайшим планом до выпуска публичной бета версии. Посмотрим в живую на новый функционал библиотеки, разработанный за последнее время. У вас будет возможность задать любые вопросы автору. Не пропусти эту возможность!
