QR-Code scannen

[DaCoda]

Hallo,

da ZXing veraltet ist und unter aktuellen Android nicht mehr geht, suche ich eine Alternative die ich unter FMX nutzen kann.

[Amanda]

Das kann ich nicht bestätigen. Ich verwende ZXing unter Android (neueste Version), IOS neueste Version und Windows ohne Probleme.

[DaCoda]

Mir wird im Playstore gesagt das es für meine Version kein ZXing gibt.

Wie machst du das mit QR-Code in Android genau ?

Ich habe Android V13 und bekomme immer eine Fehlermeldung:

[PAClient Fehler] Fehler: E8712 android:exported needs to be explicitly specified for element <activity#com.embarcadero.firemonkey.FMXNativeActi vity>. Apps targeting Android 12 and higher are required to specify an explicit value for `android:exported` when the corresponding component has an intent filter defined. See https://developer.android.com/guide/...ement#exported for details.

[Neumann]

Das muss man im Manifest eingeben. Da gab's hier schon mal was; bitte suchen habe das jetzt nicht parat.

[Amanda]

Du hast die aktuelle Version Delphi 12.2 ?

[DaCoda]

Ja, Delphi 12.2

Ich habe nun mal ein Demo in ein neues Projekt kopiert, funktioniert "fast". Nur QR-Code liest er nicht
Manche Barcodes aber schon (?)

Source:

Code:

unit MainForm;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  System.Math.Vectors,
  System.Actions,
  System.Threading,
  System.Permissions,

  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Objects,
  FMX.StdCtrls,
  FMX.Media,
  FMX.Platform,
  FMX.MultiView,
  FMX.ListView.Types,
  FMX.ListView,
  FMX.Layouts,
  FMX.ActnList,
  FMX.TabControl,
  FMX.ListBox,
  FMX.Controls.Presentation,
  FMX.ScrollBox,
  FMX.Memo,
  FMX.Memo.Types,
  FMX.Controls3D,

  ZXing.BarcodeFormat,
  ZXing.ReadResult,
  ZXing.ScanManager;

type
  TfrmMain = class(TForm)
    Rectangle1: TRectangle;
    Camera: TCameraComponent;
    btnStartStop: TButton;
    lblScanStatus: TLabel;
    Memo1: TMemo;
    imgCamera: TImage;
    procedure btnStartStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CameraSampleBufferReady(Sender: TObject;
      const ATime: TMediaTime);
  private
  { Private declarations }
    fPermissionCamera: string;
    fScanInProgress: Boolean;
    fFrameTake: Integer;
    fScanBitmap: TBitmap;

    procedure ParseImage();
{$IF CompilerVersion >= 35.0}
    // after Delphi 11 Alexandria
    procedure CameraPermissionRequestResult(Sender: TObject;
      const APermissions: TClassicStringDynArray;
      const AGrantResults: TClassicPermissionStatusDynArray);
    procedure ExplainReason(Sender: TObject; const APermissions: TClassicStringDynArray;
      const APostRationaleProc: TProc);
{$ELSE}
    // before Delphi 11 Alexandria
    procedure CameraPermissionRequestResult(Sender: TObject;
      const APermissions: TArray<string>;
      const AGrantResults: TArray<TPermissionStatus>);
    procedure ExplainReason(Sender: TObject; const APermissions: TArray<string>;
      const APostRationaleProc: TProc);
{$ENDIF}

  public

  end;

var
  frmMain: TfrmMain;

implementation

{$R *.fmx}
{$R *.NmXhdpiPh.fmx ANDROID}
{$R *.LgXhdpiPh.fmx ANDROID}

uses
{$IFDEF ANDROID}
  Androidapi.Helpers,
  Androidapi.JNI.JavaTypes,
  Androidapi.JNI.Os,
{$ENDIF}
  FMX.DialogService;

procedure TfrmMain.btnStartStopClick(Sender: TObject);
begin
  if btnStartStop.Tag = 0 then begin
    PermissionsService.RequestPermissions([fPermissionCamera], CameraPermissionRequestResult, ExplainReason);

    btnStartStop.Text := 'Stop';
    btnStartStop.Tag := 1;
  end else begin
    Camera.Active := False;

    btnStartStop.Text := 'Start';
    btnStartStop.Tag := 0;
  end;

end;

procedure TfrmMain.CameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  TThread.Synchronize(TThread.CurrentThread,
  procedure
  begin
    Camera.SampleBufferToBitmap(imgCamera.Bitmap, True);

    if (fScanInProgress) then
    begin
      exit;
    end;

    { This code will take every 4 frame. }
    inc(fFrameTake);
    if (fFrameTake mod 4 <> 0) then
    begin
      exit;
    end;

    if Assigned(fScanBitmap) then
      FreeAndNil(fScanBitmap);

    fScanBitmap := TBitmap.Create();
    fScanBitmap.Assign(imgCamera.Bitmap);

    ParseImage();
  end);
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  AppEventSvc: IFMXApplicationEventService;
begin
  lblScanStatus.Text := '';
  fFrameTake := 0;
  fScanBitmap := nil;

{$IFDEF ANDROID}
  fPermissionCamera := JStringToString(TJManifest_permission.JavaClass.CAMERA);
{$ENDIF}
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
    Camera.Active := False;
  if Assigned(fScanBitmap) then
    FreeAndNil(fScanBitmap);
end;

{$IF CompilerVersion >= 35.0}
    // after Delphi 11 Alexandria
procedure TfrmMain.CameraPermissionRequestResult(Sender: TObject;
  const APermissions: TClassicStringDynArray;
  const AGrantResults: TClassicPermissionStatusDynArray);

{$ELSE}
    // before Delphi 11 Alexandria
procedure TMainForm.CameraPermissionRequestResult(Sender: TObject;
  const APermissions: TArray<string>;
  const AGrantResults: TArray<TPermissionStatus>);
{$ENDIF}
begin
  if (Length(AGrantResults) = 1) and
  (AGrantResults[0] = TPermissionStatus.Granted) then begin
    Camera.Active := false;
    Camera.Quality := FMX.Media.TVideoCaptureQuality.MediumQuality;
    Camera.Kind := FMX.Media.TCameraKind.BackCamera;
    Camera.FocusMode := FMX.Media.TFocusMode.ContinuousAutoFocus;
    Camera.Active := True;
    lblScanStatus.Text := '';
    Memo1.Lines.Clear;
  end else
    TDialogService.ShowMessage('Cannot scan for barcodes because the required permissions is not granted');
end;

{$IF CompilerVersion >= 35.0}
    // after Delphi 11 Alexandria
procedure TfrmMain.ExplainReason(Sender: TObject;
  const APermissions: TClassicStringDynArray; const APostRationaleProc: TProc);

{$ELSE}
    // before Delphi 11 Alexandria
procedure TMainForm.ExplainReason(Sender: TObject;
  const APermissions: TArray<string>; const APostRationaleProc: TProc);
{$ENDIF}
begin
  TDialogService.ShowMessage('The app needs to access the camera to scan codes ...', procedure(const AResult: TModalResult)
    begin
      APostRationaleProc;
    end);
end;

procedure TfrmMain.ParseImage();
begin

  TThread.CreateAnonymousThread(
    procedure
    var
      ReadResult: TReadResult;
      ScanManager: TScanManager;

    begin
      fScanInProgress := True;
      ScanManager := TScanManager.Create(TBarcodeFormat.Auto, nil);

      try

        try
          ReadResult := ScanManager.Scan(fScanBitmap);
        except
          on E: Exception do
          begin
            TThread.Synchronize(TThread.CurrentThread,
              procedure
              begin
                lblScanStatus.Text := E.Message;
              end);
            exit;
          end;
        end;

        TThread.Synchronize(TThread.CurrentThread,
          procedure
          begin

            if (Length(lblScanStatus.Text) > 10) then
            begin
              lblScanStatus.Text := '*';
            end;

            lblScanStatus.Text := lblScanStatus.Text + '*';
            if (ReadResult <> nil) then
            begin
              Memo1.Lines.Insert(0, ReadResult.Text);
            end;

          end);

      finally
        if ReadResult <> nil then
          FreeAndNil(ReadResult);

        ScanManager.Free;
        fScanInProgress := false;
      end;

    end).Start();

end;

end.

[Rollo62]

Hilft vielleicht nicht direkt für deine letzte Frage, aber ich würde den Guard etwas früher vorziehen,
so dass es nicht erst in den Thread laufen muss, um dann da rauszufliegen.

Siehe Kommentare

Delphi-Quellcode:

procedure TfrmMain.CameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin

  // Direkt hier abblocken, sollte alle Frames ignorieren, bis der Image-Process abgeschlossen wurde
  if (fScanInProgress) then
  begin
      exit;
  end;


  TThread.Synchronize(TThread.CurrentThread,
  procedure
  begin
    Camera.SampleBufferToBitmap(imgCamera.Bitmap, True);

//    if (fScanInProgress) then
//    begin
//      exit;
//    end;

    { This code will take every 4 frame. }
    inc(fFrameTake);
    if (fFrameTake mod 4 <> 0) then
    begin
      exit;
    end;

    if Assigned(fScanBitmap) then
      FreeAndNil(fScanBitmap);

    fScanBitmap := TBitmap.Create();
    fScanBitmap.Assign(imgCamera.Bitmap);

    ParseImage();
  end);
end;

...

procedure TfrmMain.ParseImage();
begin

  TThread.CreateAnonymousThread(
    procedure
    var
      ReadResult: TReadResult;
      ScanManager: TScanManager;

    begin
//Das wird hier dann nicht mehr benötigt     
//      fScanInProgress := True;
      ScanManager := TScanManager.Create(TBarcodeFormat.Auto, nil);

      try

        try
          ReadResult := ScanManager.Scan(fScanBitmap);
        except
          on E: Exception do
          begin
            TThread.Synchronize(TThread.CurrentThread,
              procedure
              begin
                lblScanStatus.Text := E.Message;
              end);
            exit;
          end;
        end;

        TThread.Synchronize(TThread.CurrentThread,
          procedure
          begin

            if (Length(lblScanStatus.Text) > 10) then
            begin
              lblScanStatus.Text := '*';
            end;

            lblScanStatus.Text := lblScanStatus.Text + '*';
            if (ReadResult <> nil) then
            begin
              Memo1.Lines.Insert(0, ReadResult.Text);
            end;

          end);

      finally
        if ReadResult <> nil then
          FreeAndNil(ReadResult);

        ScanManager.Free;

        //Das sollte OK sein, und den ganzen Scan-Prozess wieder freigeben, ab dem nächsten Frame
        //aber sicherheitshalber auch in einem Queue       
        TThread.Queue(TThread.CurrentThread,
          procedure
          begin
              fScanInProgress := false;
          end);



      end;

    end).Start();

end;

[Amanda]

constructor TfQRScanThread.create;
begin
inherited create(false);

starten := TEvent.create(nil, false, false, '');
fertig := TEvent.create(nil, true, true, '');
qrcode := TEvent.create(nil, true, false, '');

iBMP := TBitmap.Create;

iScanmanager := TScanManager.Create(TBarcodeFormat.QR_CODE, nil);

FreeOnTerminate := true;
end;

procedure TfQRScanThread.Execute ;
var
ReadResult : TReadResult;
str : string;
begin
while not Terminated do begin

if (starten.WaitFor(INFINITE) = wrSignaled) and assigned(iBMP) then begin
try
ReadResult := iScanManager.Scan(iBmp);
if assigned(readResult)then begin
qrcode.SetEvent;

str := readResult.Text;
freeAndNil(ReadResult);

queue(
procedure
begin
fQRCode.CameraComponent1.OnSampleBufferReady := nil;
fQRCode.CameraComponent1.Active := false;
fQRCode.imgCamera.Visible := false;
fQRCode.aScan.Checked := false;

pruefeQRCode(str);
//fQRCode.bild(iBMP, TAlphaColors.Green);
end);

end; // if

except
end; // try
end; // if

fertig.SetEvent;
end; // while

end;

[DaCoda]

Vielen Dank für Eure Vorschläge

Ich habe nun rausgefunden, das wenn ich weissen Hintergrund habe und schwarzen QR-Code, dann geht es. Wenn aber schwarzer Hintergrund und weissen QR-Code, dann nicht (warum weiss ich nun nicht)

[TurboMagic]

Was machen andere QRCode apps aus dem Fall weißer QR Code auf schwarzem Grund?
Können die das?