Files
Password-Manager/android-client/ThirdParty/ZXing/Common/ZXing.DefaultGridSampler.pas
T
r-zakarya dd9fd62dcb 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

267 lines
7.6 KiB
ObjectPascal

{
* Copyright 2007 ZXing authors
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
* Original Author: Sean Owen
* Ported from ZXING Java Source: www.Redivivus.in (suraj.supekar@redivivus.in)
* Delphi Implementation by E. Spelt and K. Gossens
}
unit ZXing.DefaultGridSampler;
interface
uses
System.SysUtils,
System.Math,
ZXing.Common.BitMatrix,
ZXing.Common.PerspectiveTransform,
ZXing.Common.Detector.MathUtils;
type
// TODO(KG) Add GridSampler basis class
TDefaultGridSampler = class //(TGridSampler)
private
class var GridSampler: TDefaultGridSampler;
class function get_Instance(): TDefaultGridSampler; static;
protected
/// <summary> <p>Checks a set of points that have been transformed to sample points on an image against
/// the image's dimensions to see if the point are even within the image.</p>
///
/// <p>This method will actually "nudge" the endpoints back onto the image if they are found to be
/// barely (less than 1 pixel) off the image. This accounts for imperfect detection of finder
/// patterns in an image where the QR Code runs all the way to the image border.</p>
///
/// <p>For efficiency, the method will check points from either end of the line until one is found
/// to be within the image. Because the set of points are assumed to be linear, this is valid.</p>
///
/// </summary>
/// <param name="image">image into which the points should map
/// </param>
/// <param name="points">actual points in x1,y1,...,xn,yn form
/// </param>
class function checkAndNudgePoints(const image: TBitMatrix;
const points: TArray<Single>): boolean; static;
public
class function sampleGrid(const image: TBitMatrix;
const dimensionX, dimensionY: Integer;
const p1ToX, p1ToY, p2ToX, p2ToY, p3ToX, p3ToY, p4ToX, p4ToY,
p1FromX, p1FromY, p2FromX, p2FromY, p3FromX, p3FromY, p4FromX,
p4FromY: Single): TBitMatrix; overload; static;
class function sampleGrid(const image: TBitMatrix;
const dimensionX, dimensionY: Integer;
const transform: TPerspectiveTransform): TBitMatrix; overload; static;
class procedure setGridSampler(newGridSampler: TDefaultGridSampler); static;
// Properties
class property Instance: TDefaultGridSampler read get_Instance;
end;
implementation
{ TDefaultGridSampler }
class function TDefaultGridSampler.sampleGrid(const image: TBitMatrix;
const dimensionX, dimensionY: Integer; const p1ToX, p1ToY, p2ToX, p2ToY,
p3ToX, p3ToY, p4ToX, p4ToY, p1FromX, p1FromY, p2FromX, p2FromY, p3FromX,
p3FromY, p4FromX, p4FromY: Single): TBitMatrix;
var
transform: TPerspectiveTransform;
begin
transform := TPerspectiveTransform.quadrilateralToQuadrilateral(p1ToX, p1ToY,
p2ToX, p2ToY, p3ToX, p3ToY, p4ToX, p4ToY, p1FromX, p1FromY, p2FromX,
p2FromY, p3FromX, p3FromY, p4FromX, p4FromY);
try
Result := sampleGrid(image, dimensionX, dimensionY, transform);
finally
transform.free;
end;
end;
class function TDefaultGridSampler.sampleGrid(const image: TBitMatrix;
const dimensionX, dimensionY: Integer;
const transform: TPerspectiveTransform) : TBitMatrix;
var
bits: TBitMatrix;
points: TArray<Single>;
y, x, max: Integer;
iValue: Single;
begin
Result := nil;
if ((dimensionX <= 0) or
(dimensionY <= 0))
then
exit;
bits := TBitMatrix.Create(dimensionX, dimensionY);
points := TArray<Single>.Create();
SetLength(points, dimensionX shl 1);
try
for y := 0 to Pred(dimensionY) do
begin
max := Length(points) - 1;
iValue := (y + 0.5);
x := 0;
while ((x < max)) do
begin
points[x] := TMathUtils.Asr(x, 1) + 0.5;
points[(x + 1)] := iValue;
Inc(x, 2);
end;
transform.transformPoints(points);
// Quick check to see if points transformed to something inside the image;
// sufficient to check the endpoints
if (not checkAndNudgePoints(image, points)) then
begin
bits.Free;
exit;
end;
try
x := 0;
while (x < max) do
begin
bits[(TMathUtils.Asr(x, 1)), y] := image[Floor(points[x]), Floor(points[x + 1])];
Inc(x, 2);
end
except
// This feels wrong, but, sometimes if the finder patterns are misidentified, the resulting
// transform gets "twisted" such that it maps a straight line of points to a set of points
// whose endpoints are in bounds, but others are not. There is probably some mathematical
// way to detect this about the transformation that I don't know yet.
// This results in an ugly runtime exception despite our clever checks above -- can't have
// that. We could check each point's coordinates but that feels duplicative. We settle for
// catching and wrapping ArrayIndexOutOfBoundsException.
exit;
end;
end;
finally
points := nil;
end;
Result := bits;
end;
class function TDefaultGridSampler.checkAndNudgePoints(const image: TBitMatrix;
const points: TArray<Single>): Boolean;
var
offset,
x, y,
width, height : Integer;
nudged : Boolean;
begin
width := image.width;
height := image.height;
// Check and nudge points from start until we see some that are OK:
nudged := true;
offset := 0;
while ((offset < (Length(points) - 1)) and nudged) do
begin
x := Floor(points[offset]);
y := Floor(points[(offset + 1)]);
if ((((x < -1) or (x > width)) or (y < -1)) or (y > height)) then
begin
Result := false;
exit
end;
nudged := false;
if (x = -1) then
begin
points[offset] := 0;
nudged := true
end
else if (x = width) then
begin
points[offset] := (width - 1);
nudged := true
end;
if (y = -1) then
begin
points[(offset + 1)] := 0;
nudged := true
end
else if (y = height) then
begin
points[(offset + 1)] := (height - 1);
nudged := true
end;
inc(offset, 2)
end;
// Check and nudge points from end:
nudged := true;
offset := (Length(points) - 2);
while ((offset >= 0) and nudged) do
begin
x := Floor(points[offset]);
y := Floor(points[(offset + 1)]);
if ((((x < -1) or (x > width)) or (y < -1)) or (y > height)) then
begin
Result := false;
exit
end;
nudged := false;
if (x = -1) then
begin
points[offset] := 0;
nudged := true
end
else if (x = width) then
begin
points[offset] := (width - 1);
nudged := true
end;
if (y = -1) then
begin
points[(offset + 1)] := 0;
nudged := true
end
else if (y = height) then
begin
points[(offset + 1)] := (height - 1);
nudged := true
end;
Dec(offset, 2);
end;
Result := true;
end;
class function TDefaultGridSampler.get_Instance: TDefaultGridSampler;
begin
GridSampler := TDefaultGridSampler.Create();
Result := GridSampler;
end;
class procedure TDefaultGridSampler.setGridSampler(newGridSampler
: TDefaultGridSampler);
begin
if (newGridSampler = nil) then
begin
raise EArgumentException.Create('Arguments in error');
end;
GridSampler := newGridSampler;
end;
end.