Search code examples
androiddelphifiremonkey

Firemonkey TCameraComponent quality change when reactivated


I'm building a barcode reader application in Delphi 10.1 Berlin with firemonkey for Android. Based on the CameraComponent sample and using the ZXing library, it was possible to read the barcode.

To initialize the camera, I'm using this code:

procedure TfrmMain.btnOpenReaderClick(Sender: TObject);
begin
  CameraComponent.Active := False;
  CameraComponent.FocusMode := FMX.Media.TFocusMode.ContinuousAutoFocus;
  CameraComponent.Quality := TVideoCaptureQuality.MediumQuality;
  CameraComponent.Active := True;
  CameraComponent.SampleBufferToBitmap(imgCamera.Bitmap, True);
end;

To scan the barcode, I'm running this:

procedure TfrmMain.GetImage;
var
  ReadResult: TReadResult;
begin
  CameraComponent.SampleBufferToBitmap(imgCamera.Bitmap, True);

  if (FScanInProgress) then
    Exit;

  { This code will take every 4 frames. }
  inc(FFrameTake);
  if (FFrameTake mod 4 <> 0) then
    Exit;

  ReadResult := nil;

  ITask(TTask.Create(
    procedure
    begin
      try
        FScanInProgress := True;

        ReadResult := FScanManager.Scan(imgCamera.Bitmap);

        TThread.Synchronize(nil,
          procedure
          begin
          try
            if (ReadResult <> nil) then
            begin
              Label1.Text := ReadResult.text;
              CameraComponent.Active := False;
            end;
          except
            on E: Exception do
              ShowMessage(E.Message);
          end;
        end);
      finally
        ReadResult.Free;
        imgCamera.Bitmap.Free;
        FScanInProgress := false;
      end;
    end)).Start;
end;

After reading the barcode, when I set CameraComponent.Active := True; to start reading a new barcode, the CameraComponent quality is automatically set to high quality, even if the property is set as medium quality when starting the component. This causes the preview of the camera to show at low frame rate. Is there a way to set the default capture setting to medium when reactivating the CameraComponent?


Solution

  • Yes you have to setup the camera before you activate it. Like:

    CameraComponent1.Quality := TVideoCaptureQuality.MediumQuality;
    CameraComponent1.Active := true;
    

    btw: I only stop the camera on Android and not with IOS. That's too slow. I'll close the camera with IOS on application stop. The canvas is not updated anymore then.

    procedure TdmGetBarcodeStatus.StopCamera();
    begin
        CameraIsActivated := false;
    {$IFDEF ANDROID}
        CameraComponent1.Active := false;
    {$ENDIF}
    end;
    

    Also implement the camera optimization technique in the link provided by Dave. Its speeds up the camera frame rate tremendously.

    For a little, I think better scan strategy you can run the image scan progress in a continuous Task.

    This is how it can be done:

    FParseImagesInProgress is a flag which controls the parsing of the images coming from a TRectangle (RectImage.Fill.Bitmap.Bitmap). Before you stop the camera you set FParseImagesInProgress to false.

    procedure TFormCamera.StartParseImageTaskService();
    var
        ReadResult: TReadResult;
    begin
    
        if FParseImagesInProgress then
            Exit;
    
        FParseImagesInProgress := true;
    
        TTask.Run(
            procedure
            var
                hints: TDictionary<TDecodeHintType, TObject>;
                PossibleFormats: TList<TBarcodeFormat>;
                ScanManager: TScanManager;
                scanBitmap: TBitmap;
            begin
                PossibleFormats := TList<TBarcodeFormat>.Create();
                PossibleFormats.Add(TBarcodeFormat.QR_CODE);
    
                hints := TDictionary<TDecodeHintType, TObject>.Create();
                hints.Add(TDecodeHintType.POSSIBLE_FORMATS, PossibleFormats);
    
                ScanManager := TScanManager.Create(TBarcodeFormat.CODE_128, hints);
                scanBitmap := TBitmap.Create();
    
                try
    
                    while (FParseImagesInProgress) do
                    begin
    
                        ReadResult := nil;
    
                        try
    
                            TThread.Synchronize(nil,
                                procedure
                                begin
                                    scanBitmap.Assign(RectImage.Fill.Bitmap.Bitmap);
                                end);
    
                            ReadResult := ScanManager.Scan(scanBitmap);
    
                        except
                            if Assigned(ReadResult) then
                                FreeAndNil(ReadResult);
                        end;
    
                        if Assigned(ReadResult) then
                        begin
                            TThread.Synchronize(nil,
                                procedure
                                begin
                                    // PlaySound(TATSounds.Good);
                                    MarkBarcode(ReadResult, TalphaColors.Deepskyblue);
    
                                    if WasNotLastBarcodeInTimeWindow(ReadResult.Text) then
                                        FBarcodeRequestManager.RequestBarcodeStatus(ReadResult.Text, HotMember, 'myDevice', HotUser,
                                            HotPassword);
    
                                    FLastBarcode := ReadResult.Text;
    
                                end);
    
                            FreeAndNil(ReadResult);
                        end;
    
                        Sleep(MS_BETWEEN_SCAN_FRAMES);
    
                    end; // while
    
                finally
    
                    if Assigned(scanBitmap) then
                        scanBitmap := nil;
    
                    FreeAndNil(ScanManager);
    
                    if Assigned(PossibleFormats) then
                    begin
                        PossibleFormats.Clear;
                        PossibleFormats := nil;
                    end;
    
                    if Assigned(ReadResult) then
                        FreeAndNil(ReadResult);
    
                end;
    
            end); // end TTask
    
    end;
    

    It is really fast.

    Anyway, hope it helps!