סורק קוד QR ב־Delphi FMX: סריקת מצלמה יציבה, בטוחה להרצה מרובת-פתילים וללא רעידות בממשק המשתמש

unit UQrScanner;

interface

uses
  System.SysUtils, System.Classes, System.Types, System.UITypes, System.SyncObjs,
  System.Diagnostics, System.Threading,
  FMX.Types, FMX.Graphics, FMX.Media,
  ZXing.BarcodeFormat, ZXing.ReadResult, ZXing.ScanManager;

type
  TQrScanResultEvent = reference to procedure(const AText: string);

  /// <summary>
  /// בקר לסורק QR עבור FMX (Android/iOS).
  /// מטפל ב-frame-gating של המצלמה, בדיקודינג ברקע והפעלה/עצירה מסודרת.
  /// </summary>
  TQrScannerController = class
  private
    FCamera: TCameraComponent;
    FScanManager: TScanManager;
    FBitmap: TBitmap;
    FLock: TObject;

    FOnResult: TQrScanResultEvent;

    // הגבלת קצב (Gating/Throttle)
    FIsRunning: Boolean;
    FIsDecoding: Integer; // 0/1 כ-דגל Interlocked
    FLastDecodeTick: Int64;
    FMinIntervalMs: Cardinal;

    // Debounce נגד חזרתיות של אותם קודים
    FLastText: string;
    FLastTextTick: Int64;
    FDebounceMs: Cardinal;

    // ROI: חלק התמונה שנסרק (0..1)
    FEnableRoi: Boolean;
    FRoiScale: Single;

    procedure CameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
    function ShouldDecodeNow(const ANowTick: Int64): Boolean;
    function IsDebounced(const AText: string; const ANowTick: Int64): Boolean;
    function ExtractRoiBitmap(const ASrc: TBitmap): TBitmap;

    procedure DoResultOnMainThread(const AText: string);

  public
    constructor Create(const ACamera: TCameraComponent);
    destructor Destroy; override;

    procedure Start;
    procedure Stop;

    property MinIntervalMs: Cardinal read FMinIntervalMs write FMinIntervalMs; // למשל 120
    property DebounceMs: Cardinal read FDebounceMs write FDebounceMs;         // למשל 1200
    property EnableRoi: Boolean read FEnableRoi write FEnableRoi;
    property RoiScale: Single read FRoiScale write FRoiScale;                 // למשל 0.6

    property OnResult: TQrScanResultEvent read FOnResult write FOnResult;
  end;

implementation

uses
  System.Math;

{ TQrScannerController }

constructor TQrScannerController.Create(const ACamera: TCameraComponent);
var
  Formats: TArray<TBarcodeFormat>;
begin
  inherited Create;
  FLock := TObject.Create;

  FCamera := ACamera;
  FCamera.OnSampleBufferReady := CameraSampleBufferReady;

  // אתחול ScanManager והגבלה ל-QR (ביצועים + פחות False Positives)
  Formats := TArray<TBarcodeFormat>.Create(TBarcodeFormat.QR_CODE);
  FScanManager := TScanManager.Create(Formats);

  FBitmap := TBitmap.Create;
  FMinIntervalMs := 120;
  FDebounceMs := 1200;
  FEnableRoi := True;
  FRoiScale := 0.6;

  FLastDecodeTick := 0;
  FLastText := '';
  FLastTextTick := 0;
  FIsDecoding := 0;
  FIsRunning := False;
end;

destructor TQrScannerController.Destroy;
begin
  Stop;
  FBitmap.Free;
  FScanManager.Free;
  FLock.Free;
  inherited;
end;

procedure TQrScannerController.Start;
begin
  if FIsRunning then
    Exit;
  FIsRunning := True;

  // הפעלת מצלמה: באפליקציות אמיתיות יש לבדוק הרשאות קודם (Android) ולשקול את זרימת ה-UI.
  if Assigned(FCamera) then
    FCamera.Active := True;
end;

procedure TQrScannerController.Stop;
begin
  if not FIsRunning then
    Exit;
  FIsRunning := False;

  // כיבוי פעיל בצורה מסודרת
  if Assigned(FCamera) then
    FCamera.Active := False;

  // איפוס הדגל של הדקודר, למקרה שה-Stop קרה בשלב לא רצוי
  TInterlocked.Exchange(FIsDecoding, 0);
end;

function TQrScannerController.ShouldDecodeNow(const ANowTick: Int64): Boolean;
begin
  // הגבלת קצב: לא לדקוד כל פריים
  Result := (ANowTick - FLastDecodeTick) >= FMinIntervalMs;
  if Result then
    FLastDecodeTick := ANowTick;
end;

function TQrScannerController.IsDebounced(const AText: string; const ANowTick: Int64): Boolean;
begin
  Result := False;
  if AText = '' then
    Exit(True);

  // אותו טקסט בתוך חלון Debounce - להתעלם
  if SameText(AText, FLastText) and ((ANowTick - FLastTextTick) <= FDebounceMs) then
    Exit(True);

  FLastText := AText;
  FLastTextTick := ANowTick;
end;

procedure TQrScannerController.CameraSampleBufferReady(Sender: TObject; const ATime: TMediaTime);
var
  NowTick: Int64;
  LocalCopy: TBitmap;
begin
  if not FIsRunning then
    Exit;

  NowTick := TThread.GetTickCount64;
  if not ShouldDecodeNow(NowTick) then
    Exit;

  // רק דקוד אחד בו-זמנית (אחרת עומס בתור במכשירים חלשים)
  if TInterlocked.CompareExchange(FIsDecoding, 1, 0) <> 0 then
    Exit;

  // העתקת דגימת מצלמה ל-FBitmap. נעילה, כי אותו באפר Bitmap לא צריך לשמש במקביל.
  TMonitor.Enter(FLock);
  try
    FCamera.SampleBufferToBitmap(FBitmap, True);
    LocalCopy := TBitmap.Create;
    try
      LocalCopy.Assign(FBitmap);
    except
      LocalCopy.Free;
      raise;
    end;
  finally
    TMonitor.Exit(FLock);
  end;

  // דקודינג ברקע
  TTask.Run(
    procedure
    var
      ScanBmp: TBitmap;
      Res: TReadResult;
      Text: string;
      Tick: Int64;
    begin
      try
        Tick := TThread.GetTickCount64;

        if FEnableRoi then
          ScanBmp := ExtractRoiBitmap(LocalCopy)
        else
          ScanBmp := LocalCopy;

        try
          Res := FScanManager.Scan(ScanBmp);
          if Assigned(Res) then
            Text := Res.Text
          else
            Text := '';
        finally
          if ScanBmp <> LocalCopy then
            ScanBmp.Free;
        end;

        if (Text <> '') and (not IsDebounced(Text, Tick)) then
          DoResultOnMainThread(Text);

      finally
        LocalCopy.Free;
        TInterlocked.Exchange(FIsDecoding, 0);
      end;
    end);
end;

function TQrScannerController.ExtractRoiBitmap(const ASrc: TBitmap): TBitmap;
var
  R: TRectF;
  W, H: Single;
  RoiW, RoiH: Single;
  X, Y: Single;
begin
  // חיתוך ROI במרכז: מקטין עומס חישובי ומכוון את המשתמש.
  // תשומת לב: בקודי QR מאוד קטנים ה-ROI עלול להיות צר מדי.
  W := ASrc.Width;
  H := ASrc.Height;

  RoiW := Max(16, W * EnsureRange(FRoiScale, 0.2, 1.0));
  RoiH := Max(16, H * EnsureRange(FRoiScale, 0.2, 1.0));

  X := (W - RoiW) / 2;
  Y := (H - RoiH) / 2;
  R := TRectF.Create(X, Y, X + RoiW, Y + RoiH);

  Result := TBitmap.Create(Round(RoiW), Round(RoiH));
  Result.Canvas.BeginScene;
  try
    Result.Canvas.Clear(TAlphaColors.Black);
    Result.Canvas.DrawBitmap(ASrc, R, TRectF.Create(0, 0, Result.Width, Result.Height), 1.0, True);
  finally
    Result.Canvas.EndScene;
  end;
end;

procedure TQrScannerController.DoResultOnMainThread(const AText: string);
begin
  if not Assigned(FOnResult) then
    Exit;

  // Thread ה-UI: ניווט, צפצוף, מילוי שדה וכו'.
  TThread.Queue(nil,
    procedure
    begin
      if FIsRunning and Assigned(FOnResult) then
        FOnResult(AText);
    end);
end;

end.