fix(sync): QR plus court (adresse du depot, sans sur-echappement) + TRY_HARDER au decodage
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
+47
-5
@@ -348,10 +348,13 @@ type
|
||||
FScanLay: TLayout;
|
||||
FScanImg: TImage;
|
||||
FCam: TCameraComponent;
|
||||
FScanLbl: TLabel;
|
||||
FScanWatch: TTimer;
|
||||
procedure StartScan;
|
||||
procedure BeginScan;
|
||||
procedure StopScan;
|
||||
procedure DoCancelScan(Sender: TObject);
|
||||
procedure OnScanWatch(Sender: TObject);
|
||||
procedure OnCamFrame(Sender: TObject; const ATime: TMediaTime);
|
||||
function ApplySyncLink(const ALink: string): Boolean;
|
||||
{$IFDEF ANDROID}
|
||||
@@ -397,7 +400,7 @@ uses
|
||||
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp,
|
||||
PMA.ScreenGuard, PMA.Clipboard, PMA.Theme, PMA.WebUI, PMA.VaultPatch,
|
||||
PMA.SaveFile, PMA.Favicon, System.JSON, System.Permissions,
|
||||
ZXing.ScanManager, ZXing.BarcodeFormat, ZXing.ReadResult
|
||||
ZXing.ScanManager, ZXing.BarcodeFormat, ZXing.ReadResult, ZXing.DecodeHintType
|
||||
{$IFDEF ANDROID}
|
||||
, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes,
|
||||
Androidapi.Helpers, FMX.Platform.Android, Androidapi.JNI.Os
|
||||
@@ -3290,7 +3293,15 @@ begin
|
||||
LLbl.TextSettings.FontColor := TAlphaColors.White;
|
||||
LLbl.TextSettings.Font.Size := 16;
|
||||
LLbl.TextSettings.HorzAlign := TTextAlign.Center;
|
||||
LLbl.Text := 'Point the camera at the QR shown on the PC';
|
||||
LLbl.WordWrap := True;
|
||||
FScanLbl := LLbl;
|
||||
// AUCUNE IMAGE = CAMERA TENUE AILLEURS. Ouverte par l'appareil photo du
|
||||
// systeme, meme en arriere-plan, elle ne nous est pas donnee - et sans ce
|
||||
// guet l'ecran restait noir sans un mot.
|
||||
FScanWatch := TTimer.Create(Self);
|
||||
FScanWatch.Enabled := False;
|
||||
FScanWatch.Interval := 3000;
|
||||
FScanWatch.OnTimer := OnScanWatch;
|
||||
LBtn := TButton.Create(FScanLay);
|
||||
LBtn.Parent := FScanLay;
|
||||
LBtn.Align := TAlignLayout.Bottom;
|
||||
@@ -3321,7 +3332,9 @@ begin
|
||||
except
|
||||
// Pas d'autofocus continu : l'image restera nette a bonne distance.
|
||||
end;
|
||||
FScanLbl.Text := 'Point the camera at the QR shown on the PC';
|
||||
FCam.Active := True;
|
||||
FScanWatch.Enabled := True;
|
||||
Log('QR scan started');
|
||||
end;
|
||||
|
||||
@@ -3329,6 +3342,7 @@ procedure TForm8.StopScan;
|
||||
begin
|
||||
if not FScanning then Exit;
|
||||
FScanning := False;
|
||||
if FScanWatch <> nil then FScanWatch.Enabled := False;
|
||||
if FCam <> nil then FCam.Active := False;
|
||||
if FScanLay <> nil then FScanLay.Visible := False;
|
||||
FLayWeb.Visible := True;
|
||||
@@ -3339,6 +3353,16 @@ begin
|
||||
StopScan;
|
||||
end;
|
||||
|
||||
procedure TForm8.OnScanWatch(Sender: TObject);
|
||||
begin
|
||||
FScanWatch.Enabled := False;
|
||||
if FScanning and (FScanFrame = 0) then
|
||||
begin
|
||||
FScanLbl.Text := 'Camera busy - close the camera app, then Cancel and scan again';
|
||||
Log('QR scan: no camera frame after 3 s');
|
||||
end;
|
||||
end;
|
||||
|
||||
/// Une image sur quatre part au decodage, jamais deux a la fois : ZXing prend
|
||||
/// quelques dizaines de ms, et empiler les images figerait l'apercu.
|
||||
procedure TForm8.OnCamFrame(Sender: TObject; const ATime: TMediaTime);
|
||||
@@ -3360,17 +3384,30 @@ begin
|
||||
var
|
||||
LMgr: TScanManager;
|
||||
LRes: TReadResult;
|
||||
LText: string;
|
||||
LText, LDiag: string;
|
||||
LHints: TDictionary<TDecodeHintType, TObject>;
|
||||
LW, LH: Integer;
|
||||
begin
|
||||
LText := '';
|
||||
LDiag := '';
|
||||
LRes := nil;
|
||||
LMgr := TScanManager.Create(TBarcodeFormat.QR_CODE, nil);
|
||||
LW := LBmp.Width;
|
||||
LH := LBmp.Height;
|
||||
// TRY_HARDER : le chercheur de motifs balaie chaque ligne au lieu
|
||||
// d'en sauter - indispensable pour un QR photographie sur un ecran.
|
||||
LHints := TDictionary<TDecodeHintType, TObject>.Create;
|
||||
LHints.Add(TDecodeHintType.TRY_HARDER, nil);
|
||||
LMgr := TScanManager.Create(TBarcodeFormat.QR_CODE, LHints); // libere les indices
|
||||
try
|
||||
try
|
||||
LRes := LMgr.Scan(LBmp);
|
||||
if LRes <> nil then LText := LRes.Text;
|
||||
except
|
||||
LText := '';
|
||||
on E: Exception do
|
||||
begin
|
||||
LText := '';
|
||||
LDiag := E.ClassName + ': ' + E.Message;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
LRes.Free;
|
||||
@@ -3381,6 +3418,11 @@ begin
|
||||
procedure
|
||||
begin
|
||||
FScanBusy := False;
|
||||
// DIAG scan (temporaire) : les premiers essais, puis un sur vingt.
|
||||
if (FScanFrame <= 40) or (FScanFrame mod 80 = 0) then
|
||||
Log(Format('QR scan frame %d: %dx%d, %s', [FScanFrame, LW, LH,
|
||||
IfThen(LDiag <> '', LDiag,
|
||||
IfThen(LText = '', 'nothing found', 'read ' + IntToStr(Length(LText)) + ' chars'))]));
|
||||
if (not FScanning) or (LText = '') then Exit;
|
||||
if StartsText('pmserver://sync?', LText) then
|
||||
begin
|
||||
|
||||
Reference in New Issue
Block a user