feat(apk): scanner le QR du poste depuis l'app (ZXing.Delphi, Apache 2.0)

Le scanner du systeme demandait avec quoi ouvrir le lien. L'app ouvre la camera arriere, decode une image sur quatre et remplit URL + jeton des qu'un lien pmserver://sync est lu. Rien n'est enregistre avant Save. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-09-17 18:38:41 +01:00
parent 780eecc11b
commit dd9fd62dcb
81 changed files with 22141 additions and 19 deletions
@@ -0,0 +1,468 @@
+unit ZXing.Common.BitArrayImplementation;
+
+interface
+uses ZXing.Common.BitArray;
+
+function NewBitArray:IBitArray; overload;
+function NewBitArray(const Size: Integer):IBitArray; overload;
+
+implementation
+uses
+  System.SysUtils,
+  ZXing.Common.Detector.MathUtils,
+  Math;
+
+
+type
+  /// <summary>
+  /// A simple, fast array of bits, represented compactly by an array of ints internally.
+  /// </summary>
+  TBitArrayImplementation = class(TInterfacedObject, IBitArray)
+  strict private
+    _lookup: TArray<Integer>;
+    Fbits: TArray<Integer>;
+    Fsize: Integer;
+    procedure InitLookup();
+    function GetBit(i: Integer): Boolean;
+    procedure SetBit(i: Integer; Value: Boolean);
+    function makeArray(Size: Integer): TArray<Integer>;
+    procedure ensureCapacity(size: Integer);
+
+
+    function numberOfTrailingZeros(num: Integer): Integer;
+    function GetBits: TArray<Integer>;
+
+  private
+    constructor Create(); overload;
+    constructor Create(const Size: Integer); overload;
+
+  public
+    function Size: Integer;
+    function SizeInBytes: Integer;
+
+    property Self[i: Integer]: Boolean read GetBit write SetBit; default;
+    property Bits: TArray<Integer> read Fbits;
+
+    destructor Destroy; override;
+    function getNextSet(from: Integer): Integer;
+    function getNextUnset(from: Integer): Integer;
+
+    procedure setBulk(i, newBits: Integer);
+   	procedure setRange(start, ending: Integer);
+    procedure appendBit(bit: Boolean);
+    procedure Reverse();
+    procedure clear();
+
+    function isRange(start, ending: Integer;
+      const value: Boolean): Boolean;
+  end;
+
+
+constructor TBitArrayImplementation.Create;
+begin
+  Fsize := 0;
+  SetLength(Fbits, 1);
+  InitLookup();
+end;
+
+constructor TBitArrayImplementation.Create(const Size: Integer);
+begin
+  if (Size < 1)
+  then
+     raise EArgumentException.Create('size must be at least 1.');
+
+  Fsize := Size;
+  Fbits := makeArray(Size);
+  InitLookup();
+end;
+
+procedure TBitArrayImplementation.ensureCapacity(size: Integer);
+var
+  newBits : TArray<Integer>;
+begin
+  if (size > TMathUtils.Asr(Length(Fbits), 5)) then
+  begin
+    newBits := makeArray(size);
+    Move(Fbits[0], newBits[0], Length(Fbits) * SizeOf(Fbits[0]));
+    Fbits := newBits;
+  end;
+end;
+
+destructor TBitArrayImplementation.Destroy;
+begin
+  Fbits := nil;
+  _lookup := nil;
+  inherited;
+end;
+
+function TBitArrayImplementation.GetBit(i: Integer): Boolean;
+begin
+  Result := ((Fbits[TMathUtils.Asr(i, 5)]) and (1 shl (i and $1F))) <> 0;
+end;
+
+function TBitArrayImplementation.GetBits: TArray<Integer>;
+begin
+   result := FBits;
+end;
+
+/// <summary>
+/// Gets the next set.
+/// </summary>
+/// <param name="from">first bit to check</param>
+/// <returns>index of first bit that is set, starting from the given index, or size if none are set
+/// at or beyond this given index</returns>
+function TBitArrayImplementation.getNextSet(from: Integer): Integer;
+var
+  bitsOffset,
+  currentBits : Integer;
+begin
+  if (from >= Fsize) then
+    Exit(FSize);
+
+  bitsOffset := TMathUtils.Asr(from, 5);
+  currentBits := Fbits[bitsOffset];
+  // mask off lesser bits first
+  {$OVERFLOWCHECKS OFF}
+  currentBits := currentBits and -(1 shl (from and $1F));
+  {$OVERFLOWCHECKS ON}
+
+  while (currentBits = 0) do
+  begin
+    Inc(bitsOffset);
+    if (bitsOffset = Length(Fbits)) then
+      Exit(FSize);
+
+    currentBits := Fbits[bitsOffset];
+  end;
+
+  Result := (bitsOffset shl 5) + numberOfTrailingZeros(currentBits);
+  Result := Math.Min(Result, FSize);
+end;
+
+/// <summary>
+/// see getNextSet(int)
+/// </summary>
+/// <param name="from">index to start looking for unset bit</param>
+/// <returns>index of next unset bit, or <see cref="Size"/> if none are unset until the end</returns>
+function TBitArrayImplementation.getNextUnset(from: Integer): Integer;
+var
+  bitsOffset,
+  currentBits: Integer;
+begin
+  if (from >= Fsize) then
+  begin
+    Result := Fsize;
+    exit;
+  end;
+  bitsOffset := TMathUtils.Asr(from, 5);
+  currentBits := not Fbits[bitsOffset];
+
+  // mask off lesser bits first
+  {$OVERFLOWCHECKS OFF}
+  currentBits := currentBits and -(1 shl (from and $1F));
+  {$OVERFLOWCHECKS ON}
+
+  while (currentBits = 0) do
+  begin
+    Inc(bitsOffset);
+    if (bitsOffset = Length(Fbits)) then
+    begin
+      Result := Size;
+      exit;
+    end;
+    currentBits := not Fbits[bitsOffset];
+  end;
+  Result := (bitsOffset shl 5) + numberOfTrailingZeros(currentBits);
+
+  if (Result > Size)
+  then
+     Result := Size;
+end;
+
+procedure TBitArrayImplementation.InitLookup;
+begin
+  _lookup := TArray<Integer>.Create(32, 0, 1, 26, 2, 23, 27, 0, 3, 16, 24, 30,
+    28, 11, 0, 13, 4, 7, 17, 0, 25, 22, 31, 15, 29, 10, 12, 6, 0, 21, 14, 9, 5,
+    20, 8, 19, 18);
+end;
+
+function TBitArrayImplementation.makeArray(Size: Integer): TArray<Integer>;
+var
+  ar: TArray<Integer>;
+begin
+  SetLength(ar, TMathUtils.Asr((Size + 31), 5));
+  Result := ar;
+end;
+
+function TBitArrayImplementation.numberOfTrailingZeros(num: Integer): Integer;
+var
+  index: Integer;
+begin
+  Result := 0;
+
+{$OVERFLOWCHECKS OFF}
+  index := (-num and num) mod 37;
+  if (index < 0) then
+  begin
+    index := index * -1;
+  end;
+
+  if (index >= Low(_lookup)) and (index <= High(_lookup)) then
+    Result := _lookup[index];
+{$OVERFLOWCHECKS ON}
+end;
+
+procedure TBitArrayImplementation.Reverse;
+var
+  newBits: TArray<Integer>;
+  i, len, oldBitsLen, leftOffset, mask, nextInt, currentInt: Integer;
+  x: Int64;
+begin
+
+  SetLength(newBits, Length(Fbits));
+  // reverse all int's first
+  len := TMathUtils.Asr((Size - 1), 5);
+  oldBitsLen := len + 1;
+  for i := 0 to oldBitsLen - 1 do
+  begin
+    x := Fbits[i];
+    x := (TMathUtils.Asr(x, 1) and $55555555) or ((x and $55555555) shl 1);
+    x := (TMathUtils.Asr(x, 2) and $33333333) or ((x and $33333333) shl 2);
+    x := (TMathUtils.Asr(x, 4) and $0F0F0F0F) or ((x and $0F0F0F0F) shl 4);
+    x := (TMathUtils.Asr(x, 8) and $00FF00FF) or ((x and $00FF00FF) shl 8);
+    x := (TMathUtils.Asr(x, 16) and $0000FFFF) or ((x and $0000FFFF) shl 16);
+    newBits[len - i] := integer(x) ;
+  end;
+  // now correct the int's if the bit size isn't a multiple of 32
+  if (Size <> oldBitsLen * 32) then
+  begin
+    leftOffset := oldBitsLen * 32 - Size;
+    mask := 1;
+    for i := 0 to 31 - leftOffset - 1 do
+    begin
+      mask := (mask shl 1) or 1;
+    end;
+
+    currentInt := TMathUtils.Asr(newBits[0], leftOffset) and mask;
+    for i := 1 to oldBitsLen - 1 do
+    begin
+      nextInt := newBits[i];
+      currentInt := currentInt or (nextInt shl (32 - leftOffset));
+      newBits[i - 1] := currentInt;
+      currentInt := TMathUtils.Asr(nextInt, leftOffset) and mask;
+    end;
+    newBits[oldBitsLen - 1] := currentInt;
+  end;
+
+  Fbits := newBits;
+end;
+
+procedure TBitArrayImplementation.SetBit(i: Integer; Value: Boolean);
+var
+  index: Integer;
+begin
+  if (Value) then
+  begin
+    index := TMathUtils.Asr(i, 5);
+    Fbits[index] := Fbits[index] or 1 shl (i and $1F);
+  end;
+end;
+
+function TBitArrayImplementation.Size: Integer;
+begin
+  result := FSize;
+end;
+
+function TBitArrayImplementation.SizeInBytes: Integer;
+begin
+  Result := TMathUtils.Asr(Size + 7, 3);
+end;
+
+/// <summary> Sets a block of 32 bits, starting at bit i.
+///
+/// </summary>
+/// <param name="i">first bit to set
+/// </param>
+/// <param name="newBits">the new value of the next 32 bits. Note again that the least-significant bit
+/// corresponds to bit i, the next-least-significant to i+1, and so on.
+/// </param>
+procedure TBitArrayImplementation.setBulk(i, newBits: Integer);
+var
+  r: Integer;
+begin
+  r := TMathUtils.Asr(i, 5);
+  Fbits[r] := newBits;
+end;
+
+/// <summary>
+/// Sets a range of bits.
+/// </summary>
+/// <param name="start">start of range, inclusive.</param>
+/// <param name="ending">end of range, exclusive</param>
+procedure TBitArrayImplementation.setRange(start, ending: Integer);
+var
+  firstInt,
+  lastInt,
+  mask,
+  i, j : Integer;
+  firstBit,
+  lastBit : Integer;
+begin
+  if (ending < start)
+  then
+     raise EArgumentException.Create('Start is greater than end');
+
+  if (ending = start)
+  then
+     exit;
+  Dec(ending); // will be easier to treat this as the last actually set bit -- inclusive
+  firstInt := TMathUtils.Asr(start, 5);
+  lastInt := TMathUtils.Asr(ending, 5);
+  for i := firstInt to lastInt do
+  begin
+    if (i > firstInt)
+    then
+       firstBit := start
+    else
+       firstBit := $1F;
+    if (i < lastInt)
+    then
+       lastBit := 31
+    else
+       lastBit := (ending and $1F);
+
+    if ((firstBit = 0) and (lastBit = 31))
+    then
+       mask := -1
+    else
+    begin
+      mask := 0;
+      for j := firstBit to lastBit do
+      begin
+        mask := (mask or (1 shl j));
+      end;
+    end;
+    bits[i] := (bits[i] or mask);
+  end;
+end;
+
+/// <summary> Clears all bits (sets to false).</summary>
+procedure TBitArrayImplementation.Clear;
+var
+  max,
+  i: Integer;
+begin
+  max := Length(Fbits);
+  for i := 0 to Pred(max) do
+  begin
+    Fbits[i] := 0;
+  end;
+end;
+
+/// <summary> Efficient method to check if a range of bits is set, or not set.
+///
+/// </summary>
+/// <param name="start">start of range, inclusive.
+/// </param>
+/// <param name="ending">end of range, exclusive
+/// </param>
+/// <param name="value">if true, checks that bits in range are set, otherwise checks that they are not set
+/// </param>
+/// <returns> true iff all bits are set or not set in range, according to value argument
+/// </returns>
+/// <throws>  EIllegalArgumentException if end is less than or equal to start </throws>
+function TBitArrayImplementation.isRange(start, ending: Integer;
+  const value: Boolean): Boolean;
+var
+  firstInt,
+  lastInt,
+  firstBit,
+  lastBit,
+  mask,
+  i, j,
+  temp: Integer;
+begin
+  if (ending = start) then
+  begin
+    Result := true; // empty range matches
+    exit;
+  end;
+  Dec(ending); // will be easier to treat this as the last actually set bit -- inclusive
+
+  firstInt := TMathUtils.Asr(start, 5);
+  lastInt := TMathUtils.Asr(ending, 5);
+  for i := firstInt to lastInt do
+  begin
+    if (i > firstInt)
+  	then
+       firstBit := 0
+    else
+       firstBit := (start and $1F);
+
+    if (i < lastInt)
+	  then
+       lastBit := 31
+    else
+       lastBit := (ending and $1F);
+
+    if ((firstBit = 0) and (lastBit = 31))
+  	then
+       mask := -1
+    else
+    begin
+      mask := 0;
+      for j := firstBit to lastBit do
+        mask := mask or (1 shl j);
+    end;
+
+    // Return false if we're looking for 1s and the masked bits[i] isn't all 1s (that is,
+    // equals the mask, or we're looking for 0s and the masked portion is not all 0s
+    if (Value)
+	  then
+       temp := mask
+  	else
+	   temp := 0;
+
+    if ((Fbits[i] and mask) <> (temp)) then
+    begin
+      Result := False;
+      exit;
+    end;
+  end;
+
+  Result := true;
+end;
+
+/// <summary>
+/// Appends the bit.
+/// </summary>
+/// <param name="bit">The bit.</param>
+procedure TBitArrayImplementation.appendBit(bit: Boolean);
+var
+  i: Integer;
+begin
+  ensureCapacity(Fsize + 1);
+  if (bit) then
+  begin
+    i := TMathUtils.Asr(Fsize, 5);
+    bits[i] := (bits[i] or (Fsize and $1F));
+  end;
+  Dec(Fsize);
+end;
+
+
+
+
+function NewBitArray:IBitArray;
+begin
+   result :=  TBitArrayImplementation.Create;
+end;
+
+
+function NewBitArray(const Size: Integer):IBitArray;
+begin
+   result :=  TBitArrayImplementation.Create(size);
+end;
+
+
+end.