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>
This commit is contained in:
r-zakarya
+83
@@ -0,0 +1,83 @@
|
||||
unit ZXing.Common.Detector.MathUtils;
|
||||
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
* Restructured by K. Gossens
|
||||
}
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils;
|
||||
|
||||
type
|
||||
TMathUtils = class sealed
|
||||
public
|
||||
class function distance(const aX, aY, bX, bY: Double): Single; static;
|
||||
class function round(d: Single): Integer; static;
|
||||
// class function Asr(x, y: integer): integer; overload; static;
|
||||
class function Asr(Value: Int64; ShiftBits: integer): Int64; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TMathUtils }
|
||||
|
||||
class function TMathUtils.distance(const aX, aY, bX, bY: Double): Single;
|
||||
var
|
||||
xDiff, yDiff: double;
|
||||
begin
|
||||
xDiff := aX - bX;
|
||||
yDiff := aY - bY;
|
||||
result := Sqrt(xDiff * xDiff + yDiff * yDiff);
|
||||
end;
|
||||
|
||||
class function TMathUtils.round(d: Single): Integer;
|
||||
begin
|
||||
if (Single.IsNaN(d)) then
|
||||
begin
|
||||
Result := 0;
|
||||
exit
|
||||
end;
|
||||
if (Single.IsPositiveInfinity(d)) then
|
||||
begin
|
||||
Result := $7fffffff;
|
||||
exit;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
if (d < 0)
|
||||
then
|
||||
Result := Trunc(d + (-0.5))
|
||||
else
|
||||
Result := Trunc(d + 0.5);
|
||||
end;
|
||||
|
||||
{
|
||||
class function TMathUtils.Asr(x, y: integer): integer;
|
||||
begin
|
||||
result := x div (1 shl y);
|
||||
end;
|
||||
}
|
||||
class function TMathUtils.Asr(Value: Int64; ShiftBits: integer): Int64;
|
||||
begin
|
||||
result := Value shr ShiftBits;
|
||||
if (Value and $8000000000000000) > 0 then
|
||||
result := result or ($FFFFFFFFFFFFFFFF shl (64 - ShiftBits));
|
||||
end;
|
||||
|
||||
end.
|
||||
Vendored
+398
@@ -0,0 +1,398 @@
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
* Restructured by K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.Common.Detector.WhiteRectangleDetector;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
ZXing.Common.BitMatrix,
|
||||
ZXing.Common.Detector.MathUtils,
|
||||
ZXing.ResultPoint;
|
||||
|
||||
type
|
||||
TWhiteRectangleDetector = class sealed
|
||||
private const
|
||||
CORR: Integer = 1;
|
||||
INIT_SIZE: Integer = 10;
|
||||
|
||||
var
|
||||
downInit: Integer;
|
||||
height: Integer;
|
||||
image: TBitMatrix;
|
||||
leftInit: Integer;
|
||||
rightInit: Integer;
|
||||
upInit: Integer;
|
||||
width: Integer;
|
||||
constructor Create(image: TBitMatrix); overload;
|
||||
constructor Create(image: TBitMatrix; initSize: Integer; x: Integer;
|
||||
y: Integer); overload;
|
||||
function centerEdges(y: IResultPoint; z: IResultPoint; x: IResultPoint;
|
||||
t: IResultPoint): TArray<IResultPoint>;
|
||||
function containsBlackPoint(a: Integer; b: Integer; fixed: Integer;
|
||||
horizontal: boolean): boolean;
|
||||
function getBlackPointOnSegment(aX: Single; aY: Single; bX: Single;
|
||||
bY: Single): IResultPoint;
|
||||
public
|
||||
class function New(image: TBitMatrix): TWhiteRectangleDetector; overload;
|
||||
class function New(image: TBitMatrix; initSize: Integer; x: Integer;
|
||||
y: Integer): TWhiteRectangleDetector; overload; static;
|
||||
function detect(): TArray<IResultPoint>;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TWhiteRectangleDetector }
|
||||
|
||||
constructor TWhiteRectangleDetector.Create(image: TBitMatrix);
|
||||
begin
|
||||
Self.Create(image, 10, image.width div 2, image.height div 2);
|
||||
end;
|
||||
|
||||
constructor TWhiteRectangleDetector.Create(image: TBitMatrix; initSize: Integer;
|
||||
x: Integer; y: Integer);
|
||||
var
|
||||
halfsize: Integer;
|
||||
begin
|
||||
Self.image := image;
|
||||
Self.height := image.height;
|
||||
Self.width := image.width;
|
||||
halfsize := (initSize div 2);
|
||||
Self.leftInit := (x - halfsize);
|
||||
Self.rightInit := (x + halfsize);
|
||||
Self.upInit := (y - halfsize);
|
||||
Self.downInit := (y + halfsize);
|
||||
end;
|
||||
|
||||
function TWhiteRectangleDetector.centerEdges(y: IResultPoint; z: IResultPoint;
|
||||
x: IResultPoint; t: IResultPoint): TArray<IResultPoint>;
|
||||
var
|
||||
yi, yj, zi, zj, xi, xj, ti, tj: Single;
|
||||
begin
|
||||
yi := y.x;
|
||||
yj := y.y;
|
||||
zi := z.x;
|
||||
zj := z.y;
|
||||
xi := x.x;
|
||||
xj := x.y;
|
||||
ti := t.x;
|
||||
tj := t.y;
|
||||
|
||||
if (yi < (Self.width div 2)) then
|
||||
begin
|
||||
Result := TArray<IResultPoint>.Create(TResultPointHelpers.CreateResultPoint((ti - 1), (tj + 1)
|
||||
), TResultPointHelpers.CreateResultPoint((zi + 1), (zj + 1)), TResultPointHelpers.CreateResultPoint((xi - 1),
|
||||
(xj - 1)), TResultPointHelpers.CreateResultPoint((yi + 1), (yj - 1)));
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := TArray<IResultPoint>.Create(TResultPointHelpers.CreateResultPoint((ti + 1), (tj + 1)),
|
||||
TResultPointHelpers.CreateResultPoint((zi + 1), (zj - 1)), TResultPointHelpers.CreateResultPoint((xi - 1),
|
||||
(xj + 1)), TResultPointHelpers.CreateResultPoint((yi - 1), (yj - 1)));
|
||||
|
||||
end;
|
||||
|
||||
function TWhiteRectangleDetector.containsBlackPoint(a: Integer; b: Integer;
|
||||
fixed: Integer; horizontal: boolean): boolean;
|
||||
var
|
||||
x, y: Integer;
|
||||
begin
|
||||
if (horizontal) then
|
||||
begin
|
||||
x := a;
|
||||
|
||||
while ((x <= b)) do
|
||||
begin
|
||||
if (Self.image[x, fixed]) then
|
||||
begin
|
||||
Result := true;
|
||||
exit;
|
||||
end;
|
||||
Inc(x)
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
y := a;
|
||||
|
||||
while ((y <= b)) do
|
||||
begin
|
||||
if (Self.image[fixed, y]) then
|
||||
begin
|
||||
Result := true;
|
||||
exit;
|
||||
end;
|
||||
Inc(y);
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
class function TWhiteRectangleDetector.New(image: TBitMatrix)
|
||||
: TWhiteRectangleDetector;
|
||||
var
|
||||
instance: TWhiteRectangleDetector;
|
||||
begin
|
||||
Result := nil;
|
||||
if (image <> nil) then
|
||||
begin
|
||||
instance := TWhiteRectangleDetector.Create(image);
|
||||
if (((instance.upInit >= 0) and (instance.leftInit >= 0)) and
|
||||
((instance.downInit < instance.height) and
|
||||
(instance.rightInit < instance.width))) then
|
||||
Result := instance
|
||||
else
|
||||
instance.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TWhiteRectangleDetector.New(image: TBitMatrix; initSize: Integer;
|
||||
x: Integer; y: Integer): TWhiteRectangleDetector;
|
||||
var
|
||||
instance: TWhiteRectangleDetector;
|
||||
begin
|
||||
instance := TWhiteRectangleDetector.Create(image, initSize, x, y);
|
||||
if (((instance.upInit >= 0) and (instance.leftInit >= 0)) and
|
||||
((instance.downInit < instance.height) and
|
||||
(instance.rightInit < instance.width))) then
|
||||
Result := instance
|
||||
else
|
||||
begin
|
||||
instance.Free;
|
||||
Result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWhiteRectangleDetector.detect: TArray<IResultPoint>;
|
||||
var
|
||||
left, right, up, down: Integer;
|
||||
sizeExceeded, aBlackPointFoundOnBorder, atLeastOneBlackPointFoundOnBorder,
|
||||
atLeastOneBlackPointFoundOnRight, atLeastOneBlackPointFoundOnBottom,
|
||||
atLeastOneBlackPointFoundOnLeft, atLeastOneBlackPointFoundOnTop,
|
||||
rightBorderNotWhite, bottomBorderNotWhite, leftBorderNotWhite,
|
||||
topBorderNotWhite: boolean;
|
||||
i: Integer;
|
||||
z, t, x, y: IResultPoint;
|
||||
maxSize: Integer;
|
||||
begin
|
||||
z := nil;
|
||||
t := nil;
|
||||
x := nil;
|
||||
y := nil;
|
||||
|
||||
left := Self.leftInit;
|
||||
right := Self.rightInit;
|
||||
up := Self.upInit;
|
||||
down := Self.downInit;
|
||||
sizeExceeded := false;
|
||||
aBlackPointFoundOnBorder := true;
|
||||
atLeastOneBlackPointFoundOnBorder := false;
|
||||
atLeastOneBlackPointFoundOnRight := false;
|
||||
atLeastOneBlackPointFoundOnBottom := false;
|
||||
atLeastOneBlackPointFoundOnLeft := false;
|
||||
atLeastOneBlackPointFoundOnTop := false;
|
||||
while (aBlackPointFoundOnBorder) do
|
||||
begin
|
||||
aBlackPointFoundOnBorder := false;
|
||||
rightBorderNotWhite := true;
|
||||
while ((rightBorderNotWhite or (not atLeastOneBlackPointFoundOnRight)) and
|
||||
(right < Self.width)) do
|
||||
begin
|
||||
rightBorderNotWhite := Self.containsBlackPoint(up, down, right, false);
|
||||
if (rightBorderNotWhite) then
|
||||
begin
|
||||
Inc(right);
|
||||
aBlackPointFoundOnBorder := true;
|
||||
atLeastOneBlackPointFoundOnRight := true;
|
||||
end
|
||||
else if (not atLeastOneBlackPointFoundOnRight) then
|
||||
Inc(right);
|
||||
end;
|
||||
|
||||
if (right >= Self.width) then
|
||||
begin
|
||||
sizeExceeded := true;
|
||||
break;
|
||||
end;
|
||||
|
||||
bottomBorderNotWhite := true;
|
||||
while ((bottomBorderNotWhite or (not atLeastOneBlackPointFoundOnBottom)) and
|
||||
(down < Self.height)) do
|
||||
begin
|
||||
bottomBorderNotWhite := Self.containsBlackPoint(left, right, down, true);
|
||||
if (bottomBorderNotWhite) then
|
||||
begin
|
||||
Inc(down);
|
||||
aBlackPointFoundOnBorder := true;
|
||||
atLeastOneBlackPointFoundOnBottom := true;
|
||||
end
|
||||
else if (not atLeastOneBlackPointFoundOnBottom) then
|
||||
Inc(down);
|
||||
end;
|
||||
|
||||
if (down >= Self.height) then
|
||||
begin
|
||||
sizeExceeded := true;
|
||||
break;
|
||||
end;
|
||||
|
||||
leftBorderNotWhite := true;
|
||||
while ((leftBorderNotWhite or (not atLeastOneBlackPointFoundOnLeft)) and
|
||||
(left >= 0)) do
|
||||
begin
|
||||
leftBorderNotWhite := Self.containsBlackPoint(up, down, left, false);
|
||||
if (leftBorderNotWhite) then
|
||||
begin
|
||||
Dec(left);
|
||||
aBlackPointFoundOnBorder := true;
|
||||
atLeastOneBlackPointFoundOnLeft := true;
|
||||
end
|
||||
else if (not atLeastOneBlackPointFoundOnLeft) then
|
||||
Dec(left);
|
||||
end;
|
||||
|
||||
if (left < 0) then
|
||||
begin
|
||||
sizeExceeded := true;
|
||||
break;
|
||||
end;
|
||||
|
||||
topBorderNotWhite := true;
|
||||
while ((topBorderNotWhite or (not atLeastOneBlackPointFoundOnTop)) and
|
||||
(up >= 0)) do
|
||||
begin
|
||||
topBorderNotWhite := Self.containsBlackPoint(left, right, up, true);
|
||||
if (topBorderNotWhite) then
|
||||
begin
|
||||
Dec(up);
|
||||
aBlackPointFoundOnBorder := true;
|
||||
atLeastOneBlackPointFoundOnTop := true;
|
||||
end
|
||||
else if (not atLeastOneBlackPointFoundOnTop) then
|
||||
Dec(up);
|
||||
end;
|
||||
|
||||
if (up < 0) then
|
||||
begin
|
||||
sizeExceeded := true;
|
||||
break;
|
||||
end;
|
||||
|
||||
if (aBlackPointFoundOnBorder) then
|
||||
atLeastOneBlackPointFoundOnBorder := true;
|
||||
end;
|
||||
|
||||
if (not(not sizeExceeded and atLeastOneBlackPointFoundOnBorder)) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
maxSize := (right - left);
|
||||
i := 1;
|
||||
while ((i < maxSize)) do
|
||||
begin
|
||||
z := Self.getBlackPointOnSegment(left, (down - i), (left + i), down);
|
||||
if (z <> nil) then
|
||||
break;
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
if (z = nil) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
i := 1;
|
||||
while ((i < maxSize)) do
|
||||
begin
|
||||
t := Self.getBlackPointOnSegment(left, (up + i), (left + i), up);
|
||||
if (t <> nil) then
|
||||
break;
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
if (t = nil) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
i := 1;
|
||||
while ((i < maxSize)) do
|
||||
begin
|
||||
x := Self.getBlackPointOnSegment(right, (up + i), (right - i), up);
|
||||
if (x <> nil) then
|
||||
break;
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
if (x = nil) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
y := nil;
|
||||
i := 1;
|
||||
while ((i < maxSize)) do
|
||||
begin
|
||||
y := Self.getBlackPointOnSegment(right, (down - i), (right - i), down);
|
||||
if (y <> nil) then
|
||||
break;
|
||||
Inc(i);
|
||||
end;
|
||||
|
||||
if (y = nil) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := Self.centerEdges(y, z, x, t);
|
||||
end;
|
||||
|
||||
function TWhiteRectangleDetector.getBlackPointOnSegment(aX: Single; aY: Single;
|
||||
bX: Single; bY: Single): IResultPoint;
|
||||
var
|
||||
i, x, y, dist: Integer;
|
||||
xStep, yStep: Single;
|
||||
begin
|
||||
dist := TMathUtils.round(TMathUtils.distance(aX, aY, bX, bY));
|
||||
xStep := ((bX - aX) / dist);
|
||||
yStep := ((bY - aY) / dist);
|
||||
i := 0;
|
||||
while ((i < dist)) do
|
||||
begin
|
||||
x := TMathUtils.round((aX + (i * xStep)));
|
||||
y := TMathUtils.round((aY + (i * yStep)));
|
||||
if (Self.image[x, y]) then
|
||||
begin
|
||||
Result := TResultPointHelpers.CreateResultPoint(x, y);
|
||||
exit;
|
||||
end;
|
||||
Inc(i);
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
end.
|
||||
+693
@@ -0,0 +1,693 @@
|
||||
unit ZXing.Common.ReedSolomon.GenericGF;
|
||||
|
||||
{
|
||||
* 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
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
|
||||
// ES: two classes in one unit. This is to avoid circulair reference.
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils;
|
||||
|
||||
type
|
||||
TGenericGF = class;
|
||||
|
||||
IGenericGFPoly = interface
|
||||
['{9E56C626-16C5-4A5A-99B5-84559780EB9D}']
|
||||
|
||||
function get_Degree: Integer;
|
||||
function get_isZero: boolean;
|
||||
function get_field: TGenericGF;
|
||||
function get_coefficients: TArray<Integer>;
|
||||
|
||||
property coefficients: TArray<Integer> read get_coefficients;
|
||||
property degree: Integer read get_Degree;
|
||||
property isZero: boolean read get_isZero;
|
||||
property Field: TGenericGF read get_field;
|
||||
|
||||
function addOrSubtract(other: IGenericGFPoly): IGenericGFPoly;
|
||||
function divide(other: IGenericGFPoly): TArray<IGenericGFPoly>;
|
||||
function evaluateAt(a: Integer): Integer;
|
||||
function getCoefficient(degree: Integer): Integer;
|
||||
|
||||
function multiply(scalar: Integer): IGenericGFPoly; overload;
|
||||
function multiply(other: IGenericGFPoly): IGenericGFPoly; overload;
|
||||
|
||||
function multiplyByMonomial(degree: Integer; coefficient: Integer)
|
||||
: IGenericGFPoly;
|
||||
|
||||
function ToString: string;
|
||||
end;
|
||||
|
||||
/// <summary>
|
||||
/// <p>This class contains utility methods for performing mathematical operations over
|
||||
/// the Galois Fields. Operations use a given primitive polynomial in calculations.</p>
|
||||
/// <p>Throughout this package, elements of the GF are represented as an {@code int}
|
||||
/// for convenience and speed (but at the cost of memory).
|
||||
/// </p>
|
||||
/// </summary>
|
||||
TGenericGF = class sealed
|
||||
private
|
||||
FexpTable: TArray<Integer>;
|
||||
FGeneratorBase: Integer;
|
||||
FlogTable: TArray<Integer>;
|
||||
FZero: IGenericGFPoly;
|
||||
FOne: IGenericGFPoly;
|
||||
Fprimitive: Integer;
|
||||
Fsize: Integer;
|
||||
|
||||
function get_GeneratorBase: Integer;
|
||||
function get_One: IGenericGFPoly;
|
||||
function get_Zero: IGenericGFPoly;
|
||||
function get_Size: Integer;
|
||||
|
||||
class function get_AZTEC_DATA_10: TGenericGF; static;
|
||||
class function get_AZTEC_DATA_12: TGenericGF; static;
|
||||
class function get_AZTEC_DATA_6: TGenericGF; static;
|
||||
class function get_AZTEC_PARAM: TGenericGF; static;
|
||||
class function get_QR_CODE_FIELD_256: TGenericGF; static;
|
||||
class function get_DATA_MATRIX_FIELD_256: TGenericGF; static;
|
||||
class procedure InitializeClass(); static;
|
||||
class procedure FinalizeClass(); static;
|
||||
public
|
||||
class var AZTEC_DATA_10: TGenericGF;
|
||||
class var AZTEC_DATA_12: TGenericGF;
|
||||
class var AZTEC_DATA_6: TGenericGF;
|
||||
class var AZTEC_PARAM: TGenericGF;
|
||||
class var DATA_MATRIX_FIELD_256: TGenericGF;
|
||||
class var QR_CODE_FIELD_256: TGenericGF;
|
||||
class var MAXICODE_FIELD_64: TGenericGF;
|
||||
class var AZTEC_DATA_8: TGenericGF;
|
||||
|
||||
constructor Create(primitive, size, genBase: Integer);
|
||||
destructor Destroy(); override;
|
||||
|
||||
function ToString: string; override;
|
||||
|
||||
class function addOrSubtract(a: Integer; b: Integer): Integer; static;
|
||||
function multiply(a: Integer; b: Integer): Integer;
|
||||
function buildMonomial(degree: Integer; coefficient: Integer)
|
||||
: IGenericGFPoly;
|
||||
function log(a: Integer): Integer;
|
||||
function exp(a: Integer): Integer;
|
||||
function inverse(a: Integer): Integer;
|
||||
|
||||
property GeneratorBase: Integer read get_GeneratorBase;
|
||||
property size: Integer read get_Size;
|
||||
property One: IGenericGFPoly read get_One;
|
||||
property Zero: IGenericGFPoly read get_Zero;
|
||||
|
||||
end;
|
||||
|
||||
TGenericGFPoly = class sealed(TInterfacedObject, IGenericGFPoly)
|
||||
private
|
||||
Fcoefficients: TArray<Integer>;
|
||||
Ffield: TGenericGF;
|
||||
public
|
||||
function get_Degree: Integer;
|
||||
function get_isZero: boolean;
|
||||
function get_field: TGenericGF;
|
||||
function get_coefficients: TArray<Integer>;
|
||||
|
||||
property coefficients: TArray<Integer> read get_coefficients;
|
||||
property degree: Integer read get_Degree;
|
||||
property isZero: boolean read get_isZero;
|
||||
property Field: TGenericGF read get_field;
|
||||
|
||||
constructor Create(Field: TGenericGF; coefficients: TArray<Integer>);
|
||||
destructor Destroy(); override;
|
||||
function addOrSubtract(other: IGenericGFPoly): IGenericGFPoly;
|
||||
function divide(other: IGenericGFPoly): TArray<IGenericGFPoly>;
|
||||
function evaluateAt(a: Integer): Integer;
|
||||
function getCoefficient(degree: Integer): Integer;
|
||||
|
||||
function multiply(scalar: Integer): IGenericGFPoly; overload;
|
||||
function multiply(other: IGenericGFPoly): IGenericGFPoly; overload;
|
||||
|
||||
function multiplyByMonomial(degree: Integer; coefficient: Integer)
|
||||
: IGenericGFPoly;
|
||||
|
||||
function ToString: string; override;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TGenericGF }
|
||||
|
||||
class procedure TGenericGF.InitializeClass();
|
||||
begin
|
||||
AZTEC_DATA_10 := get_AZTEC_DATA_10();
|
||||
AZTEC_DATA_12 := get_AZTEC_DATA_12;
|
||||
AZTEC_DATA_6 := get_AZTEC_DATA_6;
|
||||
AZTEC_PARAM := get_AZTEC_PARAM;
|
||||
DATA_MATRIX_FIELD_256 := get_DATA_MATRIX_FIELD_256;
|
||||
QR_CODE_FIELD_256 := get_QR_CODE_FIELD_256;
|
||||
MAXICODE_FIELD_64 := get_AZTEC_DATA_6;
|
||||
AZTEC_DATA_8 := get_DATA_MATRIX_FIELD_256;
|
||||
end;
|
||||
|
||||
class procedure TGenericGF.FinalizeClass;
|
||||
begin
|
||||
FreeAndNil(AZTEC_DATA_10);
|
||||
FreeAndNil(AZTEC_DATA_12);
|
||||
FreeAndNil(AZTEC_DATA_6);
|
||||
FreeAndNil(AZTEC_PARAM);
|
||||
FreeAndNil(DATA_MATRIX_FIELD_256);
|
||||
FreeAndNil(QR_CODE_FIELD_256);
|
||||
FreeAndNil(MAXICODE_FIELD_64);
|
||||
FreeAndNil(AZTEC_DATA_8);
|
||||
end;
|
||||
|
||||
constructor TGenericGF.Create(primitive, size, genBase: Integer);
|
||||
var
|
||||
x, i: Integer;
|
||||
begin
|
||||
self.Fprimitive := primitive;
|
||||
Fsize := size;
|
||||
|
||||
FGeneratorBase := genBase;
|
||||
self.FexpTable := TArray<Integer>.Create();
|
||||
self.FlogTable := TArray<Integer>.Create();
|
||||
|
||||
SetLength(self.FexpTable, size);
|
||||
SetLength(self.FlogTable, size);
|
||||
|
||||
x := 1;
|
||||
i := 0;
|
||||
|
||||
while ((i < size)) do
|
||||
begin
|
||||
self.FexpTable[i] := x;
|
||||
x := (x shl 1);
|
||||
if (x >= size) then
|
||||
begin
|
||||
x := (x xor primitive);
|
||||
x := (x and (size - 1))
|
||||
end;
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
i := 0;
|
||||
while ((i < (size - 1))) do
|
||||
begin
|
||||
self.FlogTable[self.FexpTable[i]] := i;
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
FZero := TGenericGFPoly.Create(self, TArray<Integer>.Create(0));
|
||||
FOne := TGenericGFPoly.Create(self, TArray<Integer>.Create(1));
|
||||
end;
|
||||
|
||||
destructor TGenericGF.Destroy;
|
||||
begin
|
||||
self.FexpTable := nil;
|
||||
self.FlogTable := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
class function TGenericGF.addOrSubtract(a, b: Integer): Integer;
|
||||
begin
|
||||
Result := (a xor b)
|
||||
end;
|
||||
|
||||
function TGenericGF.buildMonomial(degree, coefficient: Integer): IGenericGFPoly;
|
||||
var
|
||||
coefficients: TArray<Integer>;
|
||||
begin
|
||||
if (degree < 0) then
|
||||
raise EArgumentException.Create('Wrong argument');
|
||||
|
||||
if (coefficient = 0) then
|
||||
begin
|
||||
Result := self.Zero;
|
||||
exit
|
||||
end;
|
||||
|
||||
coefficients := TArray<Integer>.Create();
|
||||
SetLength(coefficients, degree + 1);
|
||||
coefficients[0] := coefficient;
|
||||
|
||||
Result := TGenericGFPoly.Create(self, coefficients);
|
||||
|
||||
end;
|
||||
|
||||
function TGenericGF.exp(a: Integer): Integer;
|
||||
begin
|
||||
Result := self.FexpTable[a]
|
||||
end;
|
||||
|
||||
class function TGenericGF.get_AZTEC_DATA_10: TGenericGF;
|
||||
begin
|
||||
Result := TGenericGF.Create($409, $400, 1);
|
||||
end;
|
||||
|
||||
class function TGenericGF.get_AZTEC_DATA_12: TGenericGF;
|
||||
begin
|
||||
Result := TGenericGF.Create($1069, $1000, 1);
|
||||
end;
|
||||
|
||||
class function TGenericGF.get_AZTEC_DATA_6: TGenericGF;
|
||||
begin
|
||||
Result := TGenericGF.Create($43, $40, 1);
|
||||
end;
|
||||
|
||||
class function TGenericGF.get_AZTEC_PARAM: TGenericGF;
|
||||
begin
|
||||
Result := TGenericGF.Create($13, $10, 1);
|
||||
end;
|
||||
|
||||
class function TGenericGF.get_DATA_MATRIX_FIELD_256: TGenericGF;
|
||||
begin
|
||||
Result := TGenericGF.Create($12D, $100, 1);
|
||||
end;
|
||||
|
||||
function TGenericGF.get_GeneratorBase: Integer;
|
||||
begin
|
||||
Result := FGeneratorBase;
|
||||
end;
|
||||
|
||||
function TGenericGF.get_One: IGenericGFPoly;
|
||||
begin
|
||||
Result := FOne;
|
||||
end;
|
||||
|
||||
class function TGenericGF.get_QR_CODE_FIELD_256: TGenericGF;
|
||||
begin
|
||||
Result := TGenericGF.Create($11D, $100, 0);
|
||||
end;
|
||||
|
||||
function TGenericGF.get_Size: Integer;
|
||||
begin
|
||||
Result := Fsize;
|
||||
end;
|
||||
|
||||
function TGenericGF.get_Zero: IGenericGFPoly;
|
||||
begin
|
||||
Result := FZero;
|
||||
end;
|
||||
|
||||
function TGenericGF.inverse(a: Integer): Integer;
|
||||
begin
|
||||
if (a = 0) then
|
||||
raise Exception.Create('Artithmetic Exception');
|
||||
|
||||
Result := self.FexpTable[((self.size - self.FlogTable[a]) - 1)];
|
||||
end;
|
||||
|
||||
function TGenericGF.log(a: Integer): Integer;
|
||||
begin
|
||||
if (a = 0) then
|
||||
raise EArgumentException.Create('wrong argument');
|
||||
|
||||
Result := self.FlogTable[a];
|
||||
end;
|
||||
|
||||
function TGenericGF.multiply(a, b: Integer): Integer;
|
||||
begin
|
||||
if ((a = 0) or (b = 0)) then
|
||||
begin
|
||||
Result := 0;
|
||||
exit
|
||||
end;
|
||||
|
||||
Result := self.FexpTable
|
||||
[((self.FlogTable[a] + self.FlogTable[b]) mod (self.Fsize - 1))];
|
||||
|
||||
end;
|
||||
|
||||
function TGenericGF.ToString: string;
|
||||
begin
|
||||
Result := 'GF(0x' + Fprimitive.ToString() + ',' + size.ToString() + ')';
|
||||
end;
|
||||
|
||||
/// /////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
constructor TGenericGFPoly.Create(Field: TGenericGF;
|
||||
coefficients: TArray<Integer>);
|
||||
var
|
||||
coefficientsLength, firstNonZero: Integer;
|
||||
|
||||
begin
|
||||
|
||||
coefficientsLength := Length(coefficients);
|
||||
if (coefficientsLength = 0) then
|
||||
raise EArgumentException.Create('Wrong arguments');
|
||||
|
||||
self.Ffield := Field;
|
||||
|
||||
if ((coefficientsLength > 1) and (coefficients[0] = 0)) then
|
||||
begin
|
||||
firstNonZero := 1;
|
||||
while (((firstNonZero < coefficientsLength) and
|
||||
(coefficients[firstNonZero] = 0))) do
|
||||
begin
|
||||
inc(firstNonZero)
|
||||
end;
|
||||
|
||||
Fcoefficients := TArray<Integer>.Create();
|
||||
if (firstNonZero = coefficientsLength) then
|
||||
begin
|
||||
SetLength(Fcoefficients, 1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
SetLength(Fcoefficients, coefficientsLength - firstNonZero);
|
||||
Fcoefficients := Copy(coefficients, firstNonZero, Length(Fcoefficients));
|
||||
end
|
||||
end
|
||||
else
|
||||
Fcoefficients := coefficients
|
||||
end;
|
||||
|
||||
destructor TGenericGFPoly.Destroy;
|
||||
begin
|
||||
SetLength(Fcoefficients, 0);
|
||||
Fcoefficients := nil;
|
||||
|
||||
Ffield := nil;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.addOrSubtract(other: IGenericGFPoly): IGenericGFPoly;
|
||||
var
|
||||
lengthDiff, i, y: Integer;
|
||||
smallerCoefficients, largerCoefficients, temp, sumDiff: TArray<Integer>;
|
||||
begin
|
||||
|
||||
if (not self.Ffield.Equals(other.field)) then
|
||||
raise EArgumentException.Create
|
||||
('GenericGFPolys do not have same GenericGF field');
|
||||
|
||||
if (self.isZero) then
|
||||
begin
|
||||
Result := other;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (other.isZero) then
|
||||
begin
|
||||
Result := self;
|
||||
exit
|
||||
end;
|
||||
|
||||
smallerCoefficients := self.coefficients;
|
||||
largerCoefficients := other.coefficients;
|
||||
if (Length(smallerCoefficients) > Length(largerCoefficients)) then
|
||||
begin
|
||||
temp := smallerCoefficients;
|
||||
smallerCoefficients := largerCoefficients;
|
||||
largerCoefficients := temp
|
||||
end;
|
||||
|
||||
sumDiff := TArray<Integer>.Create();
|
||||
SetLength(sumDiff, Length(largerCoefficients));
|
||||
lengthDiff := Length(largerCoefficients) - Length(smallerCoefficients);
|
||||
|
||||
for y := 0 to lengthDiff - 1 do
|
||||
begin
|
||||
sumDiff[y] := largerCoefficients[y]
|
||||
end;
|
||||
|
||||
i := lengthDiff;
|
||||
while (i < Length(largerCoefficients)) do
|
||||
begin
|
||||
sumDiff[i] := TGenericGF.addOrSubtract(smallerCoefficients[(i - lengthDiff)
|
||||
], largerCoefficients[i]);
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
Result := TGenericGFPoly.Create(self.Ffield, sumDiff);
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.divide(other: IGenericGFPoly): TArray<IGenericGFPoly>;
|
||||
var
|
||||
term, quotient, remainder, iterationQuotient: IGenericGFPoly;
|
||||
degreeDifference, denominatorLeadingTerm, scale,
|
||||
inverseDenominatorLeadingTerm: Integer;
|
||||
begin
|
||||
if (not self.Ffield.Equals(other.field)) then
|
||||
raise EArgumentException.Create
|
||||
('GenericGFPolys do not have same GenericGF field');
|
||||
|
||||
if (other.isZero) then
|
||||
raise EArgumentException.Create('Divide by 0');
|
||||
|
||||
quotient := self.Ffield.Zero;
|
||||
remainder := self;
|
||||
denominatorLeadingTerm := other.getCoefficient(other.degree);
|
||||
inverseDenominatorLeadingTerm := self.Ffield.inverse(denominatorLeadingTerm);
|
||||
|
||||
while (((remainder.degree >= other.degree) and not remainder.isZero)) do
|
||||
begin
|
||||
degreeDifference := (remainder.degree - other.degree);
|
||||
scale := self.Ffield.multiply(remainder.getCoefficient(remainder.degree),
|
||||
inverseDenominatorLeadingTerm);
|
||||
term := other.multiplyByMonomial(degreeDifference, scale);
|
||||
iterationQuotient := self.Ffield.buildMonomial(degreeDifference, scale);
|
||||
quotient := quotient.addOrSubtract(iterationQuotient);
|
||||
remainder := remainder.addOrSubtract(term)
|
||||
end;
|
||||
|
||||
Result := TArray<IGenericGFPoly>.Create(quotient, remainder);
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.evaluateAt(a: Integer): Integer;
|
||||
var
|
||||
size, coefficient, i, y, l: Integer;
|
||||
|
||||
begin
|
||||
Result := 0;
|
||||
if (a = 0) then
|
||||
begin
|
||||
Result := self.getCoefficient(0);
|
||||
exit
|
||||
end;
|
||||
|
||||
size := Length(self.coefficients);
|
||||
if (a = 1) then
|
||||
begin
|
||||
|
||||
l := Length(self.coefficients) - 1;
|
||||
for y := 0 to l do
|
||||
begin
|
||||
coefficient := coefficients[y];
|
||||
Result := TGenericGF.addOrSubtract(Result, coefficient)
|
||||
end;
|
||||
|
||||
exit
|
||||
end;
|
||||
|
||||
Result := self.coefficients[0];
|
||||
i := 1;
|
||||
while ((i < size)) do
|
||||
begin
|
||||
Result := TGenericGF.addOrSubtract(self.Ffield.multiply(a, Result),
|
||||
self.coefficients[i]);
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.getCoefficient(degree: Integer): Integer;
|
||||
begin
|
||||
Result := Fcoefficients[Length(Fcoefficients) - 1 - degree]
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.get_coefficients: TArray<Integer>;
|
||||
begin
|
||||
Result := fcoefficients;
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.get_Degree: Integer;
|
||||
begin
|
||||
Result := Length(Fcoefficients) - 1;
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.get_field: TGenericGF;
|
||||
begin
|
||||
Result := FField;
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.get_isZero: boolean;
|
||||
begin
|
||||
Result := Fcoefficients[0] = 0;
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.multiply(other: IGenericGFPoly): IGenericGFPoly;
|
||||
var
|
||||
product, aCoefficients, bCoefficients: TArray<Integer>;
|
||||
aLength, bLength, i, aCoeff, j: Integer;
|
||||
begin
|
||||
|
||||
if (not self.Ffield.Equals(other.field)) then
|
||||
raise EArgumentException.Create
|
||||
('GenericGFPolys do not have same GenericGF field');
|
||||
|
||||
if (self.isZero or other.isZero) then
|
||||
begin
|
||||
Result := self.Ffield.Zero;
|
||||
exit
|
||||
end;
|
||||
|
||||
aCoefficients := self.coefficients;
|
||||
aLength := Length(aCoefficients);
|
||||
bCoefficients := other.coefficients;
|
||||
bLength := Length(bCoefficients);
|
||||
product := TArray<Integer>.Create();
|
||||
SetLength(product, (aLength + bLength) - 1);
|
||||
i := 0;
|
||||
|
||||
while ((i < aLength)) do
|
||||
begin
|
||||
aCoeff := aCoefficients[i];
|
||||
j := 0;
|
||||
while ((j < bLength)) do
|
||||
begin
|
||||
product[(i + j)] := TGenericGF.addOrSubtract(product[(i + j)],
|
||||
self.Ffield.multiply(aCoeff, bCoefficients[j]));
|
||||
inc(j)
|
||||
end;
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
Result := TGenericGFPoly.Create(self.Ffield, product);
|
||||
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.multiply(scalar: Integer): IGenericGFPoly;
|
||||
var
|
||||
product: TArray<Integer>;
|
||||
size, i: Integer;
|
||||
begin
|
||||
|
||||
if (scalar = 0) then
|
||||
begin
|
||||
Result := self.Ffield.Zero;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (scalar = 1) then
|
||||
begin
|
||||
Result := self;
|
||||
exit
|
||||
end;
|
||||
|
||||
size := Length(self.coefficients);
|
||||
product := TArray<Integer>.Create();
|
||||
SetLength(product, size);
|
||||
i := 0;
|
||||
while ((i < size)) do
|
||||
begin
|
||||
product[i] := self.Ffield.multiply(self.coefficients[i], scalar);
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
Result := TGenericGFPoly.Create(self.Ffield, product);
|
||||
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.multiplyByMonomial(degree, coefficient: Integer)
|
||||
: IGenericGFPoly;
|
||||
var
|
||||
product: TArray<Integer>;
|
||||
size, i: Integer;
|
||||
begin
|
||||
if (degree < 0) then
|
||||
raise EArgumentException.Create('Wrong arguments');
|
||||
|
||||
if (coefficient = 0) then
|
||||
begin
|
||||
Result := self.Ffield.Zero;
|
||||
exit
|
||||
end;
|
||||
|
||||
size := Length(self.coefficients);
|
||||
product := TArray<Integer>.Create();
|
||||
SetLength(product, size + degree);
|
||||
i := 0;
|
||||
|
||||
while ((i < size)) do
|
||||
begin
|
||||
product[i] := self.Ffield.multiply(self.coefficients[i], coefficient);
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
Result := TGenericGFPoly.Create(self.Ffield, product);
|
||||
end;
|
||||
|
||||
function TGenericGFPoly.ToString: string;
|
||||
var
|
||||
lResult: TStringBuilder;
|
||||
degree, coefficient, alphaPower: Integer;
|
||||
|
||||
begin
|
||||
lResult := TStringBuilder.Create((8 * self.degree));
|
||||
degree := self.degree;
|
||||
|
||||
while ((degree >= 0)) do
|
||||
begin
|
||||
|
||||
coefficient := self.getCoefficient(degree);
|
||||
if (coefficient <> 0) then
|
||||
begin
|
||||
|
||||
if (coefficient < 0) then
|
||||
begin
|
||||
lResult.Append(' - ');
|
||||
coefficient := -1 * coefficient
|
||||
end
|
||||
else if (Result.Length > 0) then
|
||||
lResult.Append(' + ');
|
||||
|
||||
if ((degree = 0) or (coefficient <> 1)) then
|
||||
begin
|
||||
alphaPower := self.Ffield.log(coefficient);
|
||||
if (alphaPower = 0) then
|
||||
lResult.Append('1')
|
||||
else if (alphaPower = 1) then
|
||||
lResult.Append('a')
|
||||
else
|
||||
begin
|
||||
lResult.Append('a^');
|
||||
lResult.Append(alphaPower)
|
||||
end
|
||||
end;
|
||||
|
||||
if (degree <> 0) then
|
||||
if (degree = 1) then
|
||||
lResult.Append('x')
|
||||
else
|
||||
begin
|
||||
lResult.Append('x^');
|
||||
lResult.Append(degree)
|
||||
end
|
||||
end;
|
||||
dec(degree)
|
||||
end;
|
||||
|
||||
Result := lResult.ToString();
|
||||
end;
|
||||
|
||||
initialization
|
||||
TGenericGF.InitializeClass();
|
||||
finalization
|
||||
TGenericGF.FinalizeClass();
|
||||
end.
|
||||
Vendored
+297
@@ -0,0 +1,297 @@
|
||||
{
|
||||
* Copyright 2008 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 Authors: Sean Owen and William Rucklidge
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.Common.ReedSolomon.ReedSolomonDecoder;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
// Hint: ZXing.Common.ReedSolomon.GenericGFPoly is implemented in GenericGF as second class
|
||||
ZXing.Common.ReedSolomon.GenericGF;
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// Implements Reed-Solomon encoding, as the name implies.
|
||||
/// </summary>
|
||||
TReedSolomonDecoder = class sealed
|
||||
public
|
||||
constructor Create(field: TGenericGF);
|
||||
public
|
||||
function decode(received: TArray<Integer>; twoS: Integer): boolean;
|
||||
strict private
|
||||
function findErrorLocations(errorLocator: IGenericGFPoly): TArray<Integer>;
|
||||
strict private
|
||||
function findErrorMagnitudes(errorEvaluator: IGenericGFPoly;
|
||||
errorLocations: TArray<Integer>): TArray<Integer>;
|
||||
private
|
||||
function runEuclideanAlgorithm(a: IGenericGFPoly; b: IGenericGFPoly;
|
||||
pR: Integer): TArray<IGenericGFPoly>;
|
||||
|
||||
strict private
|
||||
field: TGenericGF;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TReedSolomonDecoder }
|
||||
|
||||
constructor TReedSolomonDecoder.Create(field: TGenericGF);
|
||||
begin
|
||||
self.field := field
|
||||
end;
|
||||
|
||||
function TReedSolomonDecoder.decode(received: TArray<Integer>;
|
||||
twoS: Integer): boolean;
|
||||
var
|
||||
i, eval, position: Integer;
|
||||
poly, syndrome, sigma, omega: IGenericGFPoly;
|
||||
sigmaOmega: TArray<IGenericGFPoly>;
|
||||
errorLocations: TArray<Integer>;
|
||||
|
||||
syndromeCoefficients, errorMagnitudes: TArray<Integer>;
|
||||
noError: boolean;
|
||||
begin
|
||||
poly := TGenericGFPoly.Create(self.field, received);
|
||||
|
||||
syndromeCoefficients := TArray<Integer>.Create();
|
||||
SetLength(syndromeCoefficients, twoS);
|
||||
|
||||
try
|
||||
|
||||
noError := true;
|
||||
i := 0;
|
||||
while ((i < twoS)) do
|
||||
begin
|
||||
eval := poly.evaluateAt(self.field.exp((i + self.field.GeneratorBase)));
|
||||
syndromeCoefficients[((Length(syndromeCoefficients) - 1) - i)] := eval;
|
||||
if (eval <> 0) then
|
||||
noError := false;
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
if (noError) then
|
||||
begin
|
||||
Result := true;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
syndrome := TGenericGFPoly.Create(self.field, syndromeCoefficients);
|
||||
sigmaOmega := self.runEuclideanAlgorithm(self.field.buildMonomial(twoS, 1),
|
||||
syndrome, twoS);
|
||||
|
||||
if (sigmaOmega = nil) then
|
||||
begin
|
||||
Result := false;
|
||||
Exit
|
||||
end;
|
||||
|
||||
sigma := sigmaOmega[0];
|
||||
errorLocations := self.findErrorLocations(sigma);
|
||||
if (errorLocations = nil) then
|
||||
begin
|
||||
Result := false;
|
||||
Exit
|
||||
end;
|
||||
|
||||
omega := sigmaOmega[1];
|
||||
errorMagnitudes := self.findErrorMagnitudes(omega, errorLocations);
|
||||
i := 0;
|
||||
while (i < Length(errorLocations)) do
|
||||
begin
|
||||
position := ((Length(received) - 1) - self.field.log(errorLocations[i]));
|
||||
if (position < 0) then
|
||||
begin
|
||||
Result := false;
|
||||
Exit
|
||||
end;
|
||||
received[position] := TGenericGF.addOrSubtract(received[position],
|
||||
errorMagnitudes[i]);
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
finally
|
||||
SetLength(sigmaOmega, 0);
|
||||
SetLength(syndromeCoefficients, 0);
|
||||
end;
|
||||
|
||||
Result := true;
|
||||
|
||||
end;
|
||||
|
||||
function TReedSolomonDecoder.findErrorLocations(errorLocator: IGenericGFPoly)
|
||||
: TArray<Integer>;
|
||||
var
|
||||
numErrors, e, i: Integer;
|
||||
|
||||
begin
|
||||
numErrors := errorLocator.Degree;
|
||||
|
||||
if (numErrors = 1) then
|
||||
begin
|
||||
Result := TArray<Integer>.Create(errorLocator.getCoefficient(1));
|
||||
Exit
|
||||
end;
|
||||
|
||||
Result := TArray<Integer>.Create();
|
||||
SetLength(Result, numErrors);
|
||||
|
||||
e := 0;
|
||||
i := 1;
|
||||
|
||||
while (((i < self.field.Size) and (e < numErrors))) do
|
||||
begin
|
||||
|
||||
if (errorLocator.evaluateAt(i) = 0) then
|
||||
begin
|
||||
Result[e] := self.field.inverse(i);
|
||||
inc(e)
|
||||
end;
|
||||
|
||||
inc(i);
|
||||
|
||||
end;
|
||||
|
||||
if (e <> numErrors) then
|
||||
begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TReedSolomonDecoder.findErrorMagnitudes(errorEvaluator: IGenericGFPoly;
|
||||
errorLocations: TArray<Integer>): TArray<Integer>;
|
||||
var
|
||||
s, i, xiInverse, denominator, j, term, termPlus1: Integer;
|
||||
|
||||
begin
|
||||
s := Length(errorLocations);
|
||||
Result := TArray<Integer>.Create();
|
||||
SetLength(Result, s);
|
||||
|
||||
i := 0;
|
||||
while ((i < s)) do
|
||||
begin
|
||||
xiInverse := self.field.inverse(errorLocations[i]);
|
||||
denominator := 1;
|
||||
j := 0;
|
||||
while ((j < s)) do
|
||||
begin
|
||||
if (i <> j) then
|
||||
begin
|
||||
term := self.field.multiply(errorLocations[j], xiInverse);
|
||||
|
||||
if ((term and 1) = 0) then
|
||||
begin
|
||||
termPlus1 := (term or 1)
|
||||
end
|
||||
else
|
||||
begin
|
||||
termPlus1 := (term and (not 1));
|
||||
end;
|
||||
|
||||
denominator := self.field.multiply(denominator, termPlus1)
|
||||
|
||||
end;
|
||||
inc(j)
|
||||
end;
|
||||
|
||||
Result[i] := self.field.multiply(errorEvaluator.evaluateAt(xiInverse),
|
||||
self.field.inverse(denominator));
|
||||
|
||||
if (self.field.GeneratorBase <> 0) then
|
||||
Result[i] := self.field.multiply(Result[i], xiInverse);
|
||||
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TReedSolomonDecoder.runEuclideanAlgorithm(a, b: IGenericGFPoly;
|
||||
pR: Integer): TArray<IGenericGFPoly>;
|
||||
var
|
||||
temp, rLastLast, tLastLast, rLast, tLast, t, q, sigma, omega,
|
||||
R: IGenericGFPoly;
|
||||
denominatorLeadingTerm, dltInverse, degreeDiff, scale, inverse,
|
||||
sigmaTildeAtZero: Integer;
|
||||
begin
|
||||
|
||||
if (a.Degree < b.Degree) then
|
||||
begin
|
||||
temp := a;
|
||||
a := b;
|
||||
b := temp
|
||||
end;
|
||||
|
||||
rLast := a;
|
||||
R := b;
|
||||
tLast := self.field.Zero;
|
||||
t := self.field.One;
|
||||
|
||||
while ((R.Degree >= (pR div 2))) do
|
||||
begin
|
||||
rLastLast := rLast;
|
||||
tLastLast := tLast;
|
||||
rLast := R;
|
||||
tLast := t;
|
||||
|
||||
if (rLast.isZero) then
|
||||
begin
|
||||
Result := nil;
|
||||
Exit
|
||||
end;
|
||||
|
||||
R := rLastLast;
|
||||
q := self.field.Zero;
|
||||
denominatorLeadingTerm := rLast.getCoefficient(rLast.Degree);
|
||||
dltInverse := self.field.inverse(denominatorLeadingTerm);
|
||||
|
||||
while (((R.Degree >= rLast.Degree) and not R.isZero)) do
|
||||
begin
|
||||
degreeDiff := (R.Degree - rLast.Degree);
|
||||
scale := self.field.multiply(R.getCoefficient(R.Degree), dltInverse);
|
||||
q := q.addOrSubtract(self.field.buildMonomial(degreeDiff, scale));
|
||||
R := R.addOrSubtract(rLast.multiplyByMonomial(degreeDiff, scale))
|
||||
end;
|
||||
|
||||
t := q.multiply(tLast).addOrSubtract(tLastLast);
|
||||
|
||||
if (R.Degree >= rLast.Degree) then
|
||||
begin
|
||||
Result := nil;
|
||||
Exit
|
||||
end
|
||||
end;
|
||||
|
||||
sigmaTildeAtZero := t.getCoefficient(0);
|
||||
if (sigmaTildeAtZero = 0) then
|
||||
begin
|
||||
Result := nil;
|
||||
Exit
|
||||
end;
|
||||
|
||||
inverse := self.field.inverse(sigmaTildeAtZero);
|
||||
sigma := t.multiply(inverse);
|
||||
omega := R.multiply(inverse);
|
||||
|
||||
Result := TArray<IGenericGFPoly>.Create(sigma, omega);
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,96 @@
|
||||
unit ZXIng.ByteSegments;
|
||||
interface
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// implements the ByteSegments (which was declared as a TList<TArray<Byte>>
|
||||
/// throughout the code as reference-counted interface object)
|
||||
/// </summary>
|
||||
IByteSegments = Interface
|
||||
['{0994FC90-E8F5-40D8-8A48-9B05DFFF2635}']
|
||||
function Count:integer;
|
||||
procedure Clear;
|
||||
function GetCapacity: integer;
|
||||
procedure SetCapacity(const Value: integer);
|
||||
property Capacity:integer read GetCapacity write SetCapacity;
|
||||
function Add(const item:TArray<byte>):integer;
|
||||
function Get(index: integer):TArray<byte>;
|
||||
end;
|
||||
|
||||
|
||||
function ByteSegmentsCreate:IByteSegments;
|
||||
|
||||
implementation
|
||||
uses system.SysUtils,
|
||||
Generics.Collections;
|
||||
|
||||
type
|
||||
TByteSegments = class(TInterfacedObject,IByteSegments)
|
||||
private
|
||||
FList: TList<TArray<Byte>>;
|
||||
function Count:integer;
|
||||
procedure Clear;
|
||||
constructor Create;
|
||||
function GetCapacity: integer;
|
||||
procedure SetCapacity(const Value: integer);
|
||||
function Add(const item:TArray<byte>):integer;
|
||||
function Get(index: integer):TArray<byte>;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
function ByteSegmentsCreate:IByteSegments;
|
||||
begin
|
||||
result := TByteSegments.Create;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
{ TByteSegments }
|
||||
|
||||
function TByteSegments.Add(const item: TArray<byte>): integer;
|
||||
begin
|
||||
result := FList.Add(item);
|
||||
end;
|
||||
|
||||
procedure TByteSegments.Clear;
|
||||
begin
|
||||
FList.Clear;
|
||||
end;
|
||||
|
||||
function TByteSegments.Count: integer;
|
||||
begin
|
||||
result := FList.Count;
|
||||
end;
|
||||
|
||||
constructor TByteSegments.Create;
|
||||
begin
|
||||
FList := TList<TArray<Byte>>.Create;
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
destructor TByteSegments.Destroy;
|
||||
begin
|
||||
FList.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TByteSegments.GetCapacity: integer;
|
||||
begin
|
||||
result := FList.Capacity;
|
||||
end;
|
||||
|
||||
procedure TByteSegments.SetCapacity(const Value: integer);
|
||||
begin
|
||||
FList.Capacity := value;
|
||||
end;
|
||||
|
||||
function TByteSegments.Get(index: Integer) : TArray<byte>;
|
||||
begin
|
||||
Result := FList[index];
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,89 @@
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
}
|
||||
|
||||
unit ZXing.BarcodeFormat;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TBarcodeFormat = (
|
||||
/// <summary>No format set. All formats will be used</summary>
|
||||
Auto = 0,
|
||||
|
||||
/// <summary>Aztec 2D barcode format.</summary>
|
||||
AZTEC = 1,
|
||||
|
||||
/// <summary>CODABAR 1D format.</summary>
|
||||
CODABAR = 2,
|
||||
|
||||
/// <summary>Code 39 1D format.</summary>
|
||||
CODE_39 = 4,
|
||||
|
||||
/// <summary>Code 93 1D format.</summary>
|
||||
CODE_93 = 8,
|
||||
|
||||
/// <summary>Code 128 1D format.</summary>
|
||||
CODE_128 = 16,
|
||||
|
||||
/// <summary>Data Matrix 2D barcode format.</summary>
|
||||
DATA_MATRIX = 32,
|
||||
|
||||
/// <summary>EAN-8 1D format.</summary>
|
||||
EAN_8 = 64,
|
||||
|
||||
/// <summary>EAN-13 1D format.</summary>
|
||||
EAN_13 = 128,
|
||||
|
||||
/// <summary>ITF (Interleaved Two of Five) 1D format.</summary>
|
||||
ITF = 256,
|
||||
|
||||
/// <summary>MaxiCode 2D barcode format.</summary>
|
||||
MAXICODE = 512,
|
||||
|
||||
/// <summary>PDF417 format.</summary>
|
||||
PDF_417 = 1024,
|
||||
|
||||
/// <summary>QR Code 2D barcode format.</summary>
|
||||
QR_CODE = 2048,
|
||||
|
||||
/// <summary>RSS 14</summary>
|
||||
RSS_14 = 4096,
|
||||
|
||||
/// <summary>RSS EXPANDED</summary>
|
||||
RSS_EXPANDED = 8192,
|
||||
|
||||
/// <summary>UPC-A 1D format.</summary>
|
||||
UPC_A = 16384,
|
||||
|
||||
/// <summary>UPC-E 1D format.</summary>
|
||||
UPC_E = 32768,
|
||||
|
||||
/// <summary>UPC/EAN extension format. Not a stand-alone format.</summary>
|
||||
UPC_EAN_EXTENSION = 65536,
|
||||
|
||||
/// <summary>MSI</summary>
|
||||
MSI = 131072,
|
||||
|
||||
/// <summary>Plessey</summary>
|
||||
PLESSEY = 262144
|
||||
|
||||
);
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,110 @@
|
||||
unit ZXing.BitSource;
|
||||
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
}
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
ZXing.Common.Detector.MathUtils;
|
||||
|
||||
type
|
||||
|
||||
TBitSource = class sealed
|
||||
private
|
||||
bytes: TArray<Byte>;
|
||||
public
|
||||
BitOffset: Integer;
|
||||
ByteOffset: Integer;
|
||||
constructor Create(bytes: TArray<Byte>);
|
||||
function available: Integer;
|
||||
function readBits(numBits: Integer): Integer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TBitSource }
|
||||
|
||||
function TBitSource.available: Integer;
|
||||
begin
|
||||
Result := 8 * (Length(self.bytes) - self.ByteOffset) - self.BitOffset;
|
||||
end;
|
||||
|
||||
constructor TBitSource.Create(bytes: TArray<Byte>);
|
||||
begin
|
||||
self.bytes := bytes;
|
||||
end;
|
||||
|
||||
function TBitSource.readBits(numBits: Integer): Integer;
|
||||
var
|
||||
bitsToNotRead, bitsLeft, toRead, mask: Integer;
|
||||
begin
|
||||
if (((numBits < 1) or (numBits > $20)) or (numBits > available())) then
|
||||
raise EArgumentException.Create(numBits.ToString + 'numBits');
|
||||
|
||||
Result := 0;
|
||||
if (BitOffset > 0) then
|
||||
begin
|
||||
|
||||
bitsLeft := 8 - BitOffset;
|
||||
if (numBits < bitsLeft) then
|
||||
toRead := numBits
|
||||
else
|
||||
toRead := bitsLeft;
|
||||
|
||||
bitsToNotRead := (bitsLeft - toRead);
|
||||
mask := TMathUtils.Asr($FF, ((8 - toRead) and $1F)) shl bitsToNotRead;
|
||||
Result := TMathUtils.Asr((self.bytes[self.ByteOffset] and mask),
|
||||
bitsToNotRead);
|
||||
|
||||
dec(numBits, toRead);
|
||||
inc(BitOffset, toRead);
|
||||
|
||||
if (BitOffset = 8) then
|
||||
begin
|
||||
BitOffset := 0;
|
||||
inc(ByteOffset)
|
||||
end
|
||||
end;
|
||||
|
||||
if (numBits > 0) then
|
||||
begin
|
||||
|
||||
while ((numBits >= 8)) do
|
||||
begin
|
||||
Result := ((Result shl 8) or (self.bytes[self.ByteOffset] and $FF));
|
||||
inc(self.ByteOffset);
|
||||
dec(numBits, 8)
|
||||
end;
|
||||
|
||||
if (numBits > 0) then
|
||||
begin
|
||||
bitsToNotRead := 8 - numBits;
|
||||
mask := TMathUtils.Asr($FF, bitsToNotRead) shl bitsToNotRead;
|
||||
|
||||
Result := (Result shl numBits) or
|
||||
TMathUtils.Asr((bytes[ByteOffset] and mask), bitsToNotRead);
|
||||
|
||||
inc(BitOffset, numBits)
|
||||
end
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,180 @@
|
||||
unit ZXing.CharacterSetECI;
|
||||
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
}
|
||||
interface
|
||||
|
||||
uses SysUtils, Generics.Collections;
|
||||
|
||||
type
|
||||
|
||||
TECI = class abstract
|
||||
private
|
||||
value_Renamed: Integer;
|
||||
constructor Create(value_Renamed: Integer);
|
||||
public
|
||||
class function getECIByValue(value_Renamed: Integer): TECI; static;
|
||||
property value: Integer read value_Renamed;
|
||||
end;
|
||||
|
||||
TCharacterSetECI = class sealed(TECI)
|
||||
strict private
|
||||
FEncodingName: string;
|
||||
class var NAME_TO_ECI: TDictionary<string, TCharacterSetECI>;
|
||||
class var VALUE_TO_ECI: TDictionary<Integer, TCharacterSetECI>;
|
||||
///<summary>
|
||||
/// this objectlist is just for doing proper deallocation of TCharacterSetECI instances under Win32/Win64,
|
||||
/// without having to mess with TInterfacedObject. Since instances are meant to exist for the whole program life, there's no need of doing
|
||||
/// anything much more complicated than this.
|
||||
/// </summary>
|
||||
class var AllocatedInstances:TObjectList<TCharacterSetECI>;
|
||||
|
||||
class constructor Create;
|
||||
constructor Create(value: Integer; encodingName: string); overload;
|
||||
class destructor Destroy;
|
||||
|
||||
class procedure addCharacterSet(value: Integer; encodingNames: TArray<string>); static;
|
||||
|
||||
public
|
||||
|
||||
property encodingName: string read FEncodingName;
|
||||
|
||||
class function getCharacterSetECIByName(name: string)
|
||||
: TCharacterSetECI; static;
|
||||
class function getCharacterSetECIByValue(value: Integer)
|
||||
: TCharacterSetECI; static;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TECI }
|
||||
|
||||
constructor TECI.Create(value_Renamed: Integer);
|
||||
begin
|
||||
self.value_Renamed := value_Renamed
|
||||
end;
|
||||
|
||||
class function TECI.getECIByValue(value_Renamed: Integer): TECI;
|
||||
begin
|
||||
if ((value_Renamed < 0) or (value_Renamed > $F423F)) then
|
||||
raise EArgumentException.Create('Bad ECI value: ' +
|
||||
value_Renamed.ToString());
|
||||
|
||||
if (value_Renamed < 900) then
|
||||
begin
|
||||
Result := TCharacterSetECI.getCharacterSetECIByValue(value_Renamed);
|
||||
exit
|
||||
end;
|
||||
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
{ TCharacterSetECI }
|
||||
|
||||
constructor TCharacterSetECI.Create(value: Integer; encodingName: string);
|
||||
begin
|
||||
inherited Create(value);
|
||||
FEncodingName := encodingName;
|
||||
AllocatedInstances.Add(self); // add the instance to the global list of all created instances
|
||||
end;
|
||||
|
||||
class destructor TCharacterSetECI.Destroy;
|
||||
begin
|
||||
NAME_TO_ECI.Free;
|
||||
VALUE_TO_ECI.Free;
|
||||
|
||||
if AllocatedInstances<>nil then begin
|
||||
AllocatedInstances.Clear;
|
||||
AllocatedInstances.Free;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
class constructor TCharacterSetECI.Create;
|
||||
begin
|
||||
NAME_TO_ECI:=TDictionary<string, TCharacterSetECI>.Create;
|
||||
VALUE_TO_ECI:=TDictionary<Integer, TCharacterSetECI>.Create;
|
||||
// under Win32/64 TObjectList by default "OWNS" the objects it contains:
|
||||
// if we clear the list, the objects contained get automatically destroyed
|
||||
AllocatedInstances:= TObjectList<TCharacterSetECI>.Create;
|
||||
|
||||
TCharacterSetECI.addCharacterSet( 0, ['CP437']);
|
||||
TCharacterSetECI.addCharacterSet( 1, ['ISO-8859-1','ISO8859_1']);
|
||||
TCharacterSetECI.addCharacterSet( 2, ['CP437']);
|
||||
TCharacterSetECI.addCharacterSet( 3, ['ISO-8859-1', 'ISO8859_1']);
|
||||
TCharacterSetECI.addCharacterSet( 4, ['ISO-8859-2', 'ISO8859_2']);
|
||||
TCharacterSetECI.addCharacterSet( 5, ['ISO-8859-3', 'ISO8859_3']);
|
||||
TCharacterSetECI.addCharacterSet( 6, ['ISO-8859-4', 'ISO8859_4']);
|
||||
TCharacterSetECI.addCharacterSet( 7, ['ISO-8859-5', 'ISO8859_5']);
|
||||
TCharacterSetECI.addCharacterSet( 8, ['ISO-8859-6', 'ISO8859_6']);
|
||||
TCharacterSetECI.addCharacterSet( 9, ['ISO-8859-7', 'ISO8859_7']);
|
||||
TCharacterSetECI.addCharacterSet( 10, ['ISO-8859-8', 'ISO8859_8']);
|
||||
TCharacterSetECI.addCharacterSet( 11, ['ISO-8859-9', 'ISO8859_9']);
|
||||
TCharacterSetECI.addCharacterSet( 12, ['ISO-8859-4', 'ISO-8859-10', 'ISO8859_10']);
|
||||
TCharacterSetECI.addCharacterSet( 13, ['ISO-8859-11', 'ISO8859_11']);
|
||||
TCharacterSetECI.addCharacterSet( 15, ['ISO-8859-13', 'ISO8859_13']);
|
||||
TCharacterSetECI.addCharacterSet($10, ['ISO-8859-1', 'ISO-8859-14', 'ISO8859_14']);
|
||||
TCharacterSetECI.addCharacterSet($11, ['ISO-8859-15', 'ISO8859_15']);
|
||||
TCharacterSetECI.addCharacterSet($12, ['ISO-8859-3', 'ISO-8859-16', 'ISO8859_16']);
|
||||
TCharacterSetECI.addCharacterSet( 20, ['SJIS', 'Shift_JIS']);
|
||||
TCharacterSetECI.addCharacterSet($15, ['WINDOWS-1250','CP1250']);
|
||||
TCharacterSetECI.addCharacterSet($16, ['WINDOWS-1251','CP1251']);
|
||||
TCharacterSetECI.addCharacterSet($17, ['WINDOWS-1252','CP1252']);
|
||||
TCharacterSetECI.addCharacterSet($18, ['WINDOWS-1256', 'CP1256']);
|
||||
TCharacterSetECI.addCharacterSet($19, ['UTF-16BE','UNICODEBIG']);
|
||||
TCharacterSetECI.addCharacterSet($1A, ['UTF-8', 'UTF8']);
|
||||
TCharacterSetECI.addCharacterSet($1B, ['US-ASCII']);
|
||||
TCharacterSetECI.addCharacterSet(170, ['US-ASCII']);
|
||||
TCharacterSetECI.addCharacterSet($1C, ['BIG5']);
|
||||
TCharacterSetECI.addCharacterSet($1D, ['GB18030', 'GB2312', 'EUC_CN', 'GBK'] );
|
||||
TCharacterSetECI.addCharacterSet( 30, ['EUC-KR', 'EUC_KR']);
|
||||
|
||||
end;
|
||||
|
||||
class procedure TCharacterSetECI.addCharacterSet(value: Integer; encodingNames: TArray<string>);
|
||||
var
|
||||
t: string;
|
||||
Eci: TCharacterSetECI;
|
||||
begin
|
||||
Eci := TCharacterSetECI.Create(value, encodingNames[0]);
|
||||
TCharacterSetECI.VALUE_TO_ECI.AddOrSetValue(value,Eci); // note : VALUE_TO_ECI[value] := Eci raises "key not found exception": it cant' be used for adding not existing values
|
||||
|
||||
for t in encodingNames do
|
||||
TCharacterSetECI.NAME_TO_ECI.AddOrSetValue(t,Eci);
|
||||
end;
|
||||
|
||||
class function TCharacterSetECI.getCharacterSetECIByName(name: string)
|
||||
: TCharacterSetECI;
|
||||
begin
|
||||
Result := TCharacterSetECI.NAME_TO_ECI[name.ToUpper]
|
||||
end;
|
||||
|
||||
class function TCharacterSetECI.getCharacterSetECIByValue(value: Integer)
|
||||
: TCharacterSetECI;
|
||||
begin
|
||||
if ((value < 0) or (value >= 900)) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit
|
||||
end;
|
||||
|
||||
Result := TCharacterSetECI.VALUE_TO_ECI[value];
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,70 @@
|
||||
{
|
||||
* Copyright 2008 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
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.Common.BitArray;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
IBitArray = interface
|
||||
['{3D65F451-E408-4015-A637-73CD05877BCB}']
|
||||
// property getters and setters
|
||||
function GetBit(i: Integer): Boolean;
|
||||
procedure SetBit(i: Integer; Value: Boolean);
|
||||
function GetBits: TArray<Integer>;
|
||||
|
||||
function Size: Integer;
|
||||
function SizeInBytes: Integer;
|
||||
|
||||
property Self[i: Integer]: Boolean read GetBit write SetBit; default;
|
||||
property Bits: TArray<Integer> read GetBits;
|
||||
|
||||
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;
|
||||
|
||||
TBitArrayHelpers = class
|
||||
class function CreateBitArray:IBitArray; overload;
|
||||
class function CreateBitArray(const Size: Integer):IBitArray; overload;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses ZXing.Common.BitArrayImplementation;
|
||||
|
||||
class function TBitArrayHelpers.CreateBitArray:IBitArray;
|
||||
begin
|
||||
result := ZXing.Common.BitArrayImplementation.NewBitArray;
|
||||
end;
|
||||
|
||||
|
||||
class function TBitArrayHelpers.CreateBitArray(const Size: Integer):IBitArray;
|
||||
begin
|
||||
result := ZXing.Common.BitArrayImplementation.NewBitArray(size);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
+468
@@ -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.
|
||||
@@ -0,0 +1,480 @@
|
||||
{
|
||||
* Copyright 2008 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 Authors: Sean Owen and dswitkin@google.com (Daniel Switkin)
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.Common.BitMatrix;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
{$IFDEF FRAMEWORK_FMX}
|
||||
FMX.Graphics,
|
||||
{$ENDIF}
|
||||
{$IFDEF FRAMEWORK_VCL}
|
||||
VCL.Graphics,
|
||||
{$ENDIF}
|
||||
Generics.Collections,
|
||||
ZXing.Common.BitArray,
|
||||
ZXing.BarcodeFormat,
|
||||
ZXing.Helpers,
|
||||
ZXing.Common.Detector.MathUtils;
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// <p>Represents a 2D matrix of bits. In function arguments below, and throughout the common
|
||||
/// module, x is the column position, and y is the row position. The ordering is always x, y.
|
||||
/// The origin is at the top-left.</p>
|
||||
/// <p>Internally the bits are represented in a 1-D array of 32-bit ints. However, each row begins
|
||||
/// with a new int. This is done intentionally so that we can copy out a row into a BitArray very
|
||||
/// efficiently.</p>
|
||||
/// <p>The ordering of bits is row-major. Within each int, the least significant bits are used first,
|
||||
/// meaning they represent lower x values. This is compatible with BitArray's implementation.</p>
|
||||
/// </summary>
|
||||
TBitMatrix = class sealed
|
||||
private
|
||||
Fbits: TArray<Integer>;
|
||||
Fheight: Integer;
|
||||
FrowSize: Integer;
|
||||
Fwidth: Integer;
|
||||
|
||||
function getBit(x, y: Integer): Boolean;
|
||||
procedure setBit(x, y: Integer; const value: Boolean);
|
||||
|
||||
constructor Create(const width, height, rowSize: Integer;
|
||||
const bits: TArray<Integer>); overload;
|
||||
public
|
||||
constructor Create(const width, height: Integer); overload;
|
||||
constructor Create(const dimension: Integer); overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure clear;
|
||||
function Clone: TObject;
|
||||
function Equals(obj: TObject): Boolean; override;
|
||||
procedure flip(x: Integer; y: Integer);
|
||||
function getBottomRightOnBit: TArray<Integer>;
|
||||
function getEnclosingRectangle: TArray<Integer>;
|
||||
function GetHashCode: Integer; override;
|
||||
function getRow(const y: Integer; row: IBitArray): IBitArray;
|
||||
function getTopLeftOnBit: TArray<Integer>;
|
||||
procedure Rotate180;
|
||||
procedure setRegion(left: Integer; top: Integer; width: Integer;
|
||||
height: Integer);
|
||||
procedure setRow(y: Integer; row: IBitArray);
|
||||
function ToBitmap: TBitmap; overload;
|
||||
function ToBitmap(format: TBarcodeFormat; content: string)
|
||||
: TBitmap; overload;
|
||||
|
||||
property width: Integer read Fwidth;
|
||||
property height: Integer read Fheight;
|
||||
property Matrix[x, y: Integer]: Boolean read getBit write setBit; default;
|
||||
// added for debugging
|
||||
function ToString: string; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TBitMatrix }
|
||||
|
||||
function TBitMatrix.getBit(x, y: Integer): Boolean;
|
||||
var
|
||||
offset, v, bits, shift: Int64;
|
||||
uBits: Cardinal;
|
||||
begin
|
||||
offset := y * FrowSize + TMathUtils.Asr(x, 5);
|
||||
if ( offset >= Low( FBits ) ) and ( offset <= High( FBits ) ) then
|
||||
begin
|
||||
bits := Fbits[offset];
|
||||
uBits := Cardinal(bits);
|
||||
shift := (x and $1F);
|
||||
v := TMathUtils.Asr(uBits, shift);
|
||||
Result := (v and 1) <> 0;
|
||||
end
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
procedure TBitMatrix.setBit(x, y: Integer; const value: Boolean);
|
||||
var
|
||||
offset: NativeInt;
|
||||
begin
|
||||
if (value) then
|
||||
begin
|
||||
offset := y * FrowSize + TMathUtils.Asr(x, 5);
|
||||
Fbits[offset] := Fbits[offset] or (1 shl (x and $1F));
|
||||
end
|
||||
else
|
||||
begin
|
||||
offset := Trunc(y * FrowSize + (x / 32));
|
||||
Fbits[offset] := Fbits[offset] and (not(1 shl (x and $1F)));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBitMatrix.clear;
|
||||
var
|
||||
max, i: Integer;
|
||||
begin
|
||||
max := Length(Fbits);
|
||||
i := 0;
|
||||
while ((i < max)) do
|
||||
begin
|
||||
Fbits[i] := 0;
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TBitMatrix.Clone: TObject;
|
||||
var
|
||||
b: TArray<Integer>;
|
||||
begin
|
||||
b := TArray.Clone(Fbits);
|
||||
Result := TBitMatrix.Create(Self.Fwidth, Self.Fheight, Self.FrowSize, b);
|
||||
end;
|
||||
|
||||
constructor TBitMatrix.Create(const width, height, rowSize: Integer;
|
||||
const bits: TArray<Integer>);
|
||||
begin
|
||||
if ((width < 1) or (height < 1)) then
|
||||
raise EArgumentException.Create('Both dimensions must be greater than 0');
|
||||
|
||||
Self.Fwidth := width;
|
||||
Self.Fheight := height;
|
||||
Self.FrowSize := rowSize;
|
||||
Self.Fbits := bits;
|
||||
end;
|
||||
|
||||
constructor TBitMatrix.Create(const width, height: Integer);
|
||||
begin
|
||||
if ((width < 1) or (height < 1)) then
|
||||
raise EArgumentException.Create('Both dimensions must be greater than 0');
|
||||
|
||||
Self.Fwidth := width;
|
||||
Self.Fheight := height;
|
||||
Self.FrowSize := TMathUtils.Asr((width + $1F), 5);
|
||||
SetLength(Self.Fbits, Self.FrowSize * height);
|
||||
Self.clear;
|
||||
end;
|
||||
|
||||
constructor TBitMatrix.Create(const dimension: Integer);
|
||||
begin
|
||||
Self.Create(dimension, dimension);
|
||||
end;
|
||||
|
||||
destructor TBitMatrix.Destroy;
|
||||
begin
|
||||
Self.Fbits := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TBitMatrix.Equals(obj: TObject): Boolean;
|
||||
var
|
||||
other: TBitMatrix;
|
||||
i, l: Integer;
|
||||
begin
|
||||
if (not(obj is TBitMatrix)) then
|
||||
begin
|
||||
Result := false;
|
||||
exit;
|
||||
end;
|
||||
|
||||
other := (obj as TBitMatrix);
|
||||
if ((((Fwidth <> other.Fwidth) or (Fheight <> other.Fheight)) or
|
||||
(FrowSize <> other.FrowSize)) or (Length(Fbits) <> Length(other.Fbits)))
|
||||
then
|
||||
begin
|
||||
Result := false;
|
||||
exit
|
||||
end;
|
||||
|
||||
i := 0;
|
||||
l := Length(Fbits);
|
||||
|
||||
while ((i < l)) do
|
||||
begin
|
||||
if (Fbits[i] <> other.Fbits[i]) then
|
||||
begin
|
||||
Result := false;
|
||||
exit
|
||||
end;
|
||||
Inc(i)
|
||||
end;
|
||||
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
procedure TBitMatrix.flip(x, y: Integer);
|
||||
var
|
||||
offset, s: Integer;
|
||||
begin
|
||||
s := TMathUtils.Asr(x, 5);
|
||||
offset := ((y * FrowSize) + s);
|
||||
Fbits[offset] := (Fbits[offset] xor (1 shl x))
|
||||
end;
|
||||
|
||||
function TBitMatrix.getBottomRightOnBit: TArray<Integer>;
|
||||
var
|
||||
bitsOffset, x, y, theBits, bit: Integer;
|
||||
begin
|
||||
bitsOffset := Length(Fbits) - 1;
|
||||
while ((bitsOffset >= 0) and (Self.Fbits[bitsOffset] = 0)) do
|
||||
begin
|
||||
dec(bitsOffset)
|
||||
end;
|
||||
|
||||
if (bitsOffset < 0) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit
|
||||
end;
|
||||
|
||||
y := (bitsOffset div FrowSize);
|
||||
x := ((bitsOffset mod FrowSize) shl 5);
|
||||
theBits := Fbits[bitsOffset];
|
||||
bit := $1F;
|
||||
|
||||
while ((TMathUtils.Asr(theBits, bit) = 0)) do
|
||||
begin
|
||||
dec(bit);
|
||||
end;
|
||||
|
||||
Inc(x, bit);
|
||||
Result := TArray<Integer>.Create(x, y);
|
||||
end;
|
||||
|
||||
function TBitMatrix.getEnclosingRectangle: TArray<Integer>;
|
||||
var
|
||||
bit, left, top, right, bottom, y, x32, theBits, widthTmp, heightTmp: Integer;
|
||||
begin
|
||||
left := Self.Fwidth;
|
||||
top := Self.Fheight;
|
||||
right := -1;
|
||||
bottom := -1;
|
||||
y := 0;
|
||||
|
||||
while ((y < Self.Fheight)) do
|
||||
begin
|
||||
x32 := 0;
|
||||
|
||||
while ((x32 < Self.FrowSize)) do
|
||||
begin
|
||||
theBits := Self.Fbits[((y * Self.FrowSize) + x32)];
|
||||
|
||||
if (theBits <> 0) then
|
||||
begin
|
||||
|
||||
if (y < top) then
|
||||
top := y;
|
||||
|
||||
if (y > bottom) then
|
||||
bottom := y;
|
||||
|
||||
if ((x32 * $20) < left) then
|
||||
begin
|
||||
bit := 0;
|
||||
while (((theBits shl ($1F - bit)) = 0)) do
|
||||
begin
|
||||
Inc(bit)
|
||||
end;
|
||||
if (((x32 * $20) + bit) < left) then
|
||||
left := ((x32 * $20) + bit)
|
||||
end;
|
||||
|
||||
if (((x32 * $20) + $1F) > right) then
|
||||
begin
|
||||
bit := $1F;
|
||||
while ((TMathUtils.Asr(theBits, bit) = 0)) do
|
||||
begin
|
||||
dec(bit)
|
||||
end;
|
||||
if (((x32 * $20) + bit) > right) then
|
||||
right := ((x32 * $20) + bit)
|
||||
end
|
||||
end;
|
||||
Inc(x32)
|
||||
end;
|
||||
Inc(y)
|
||||
end;
|
||||
|
||||
widthTmp := (right - left);
|
||||
heightTmp := (bottom - top);
|
||||
|
||||
if ((widthTmp < 0) or (heightTmp < 0)) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit;
|
||||
end;
|
||||
|
||||
Result := TArray<Integer>.Create(left, top, widthTmp, heightTmp);
|
||||
end;
|
||||
|
||||
function TBitMatrix.GetHashCode: Integer;
|
||||
var
|
||||
bit, hash: Integer;
|
||||
begin
|
||||
hash := Self.Fwidth;
|
||||
hash := (($1F * hash) + Self.Fwidth);
|
||||
hash := (($1F * hash) + Self.Fheight);
|
||||
hash := (($1F * hash) + Self.FrowSize);
|
||||
|
||||
for bit in Self.Fbits do
|
||||
begin
|
||||
hash := (($1F * hash) + bit); // .GetHashCode
|
||||
end;
|
||||
|
||||
Result := hash;
|
||||
end;
|
||||
|
||||
function TBitMatrix.getRow(const y: Integer; row: IBitArray): IBitArray;
|
||||
var
|
||||
x, offset: Integer;
|
||||
begin
|
||||
if ((row = nil) or (row.Size < Self.Fwidth)) then
|
||||
row := TBitArrayHelpers.CreateBitArray(Self.Fwidth)
|
||||
else
|
||||
row.clear;
|
||||
offset := (y * Self.FrowSize);
|
||||
x := 0;
|
||||
|
||||
while ((x < Self.FrowSize)) do
|
||||
begin
|
||||
row.setBulk((x shl 5), Self.Fbits[(offset + x)]);
|
||||
Inc(x)
|
||||
end;
|
||||
|
||||
Result := row;
|
||||
end;
|
||||
|
||||
function TBitMatrix.getTopLeftOnBit: TArray<Integer>;
|
||||
var
|
||||
bitsOffset, x, y, theBits, bit: Integer;
|
||||
begin
|
||||
bitsOffset := 0;
|
||||
|
||||
while (((bitsOffset < Length(Fbits)) and (Fbits[bitsOffset] = 0))) do
|
||||
begin
|
||||
Inc(bitsOffset)
|
||||
end;
|
||||
|
||||
if (bitsOffset = Length(Fbits)) then
|
||||
begin
|
||||
Result := nil;
|
||||
exit
|
||||
end;
|
||||
|
||||
y := (bitsOffset div Self.FrowSize);
|
||||
x := ((bitsOffset mod Self.FrowSize) shl 5);
|
||||
theBits := Self.Fbits[bitsOffset];
|
||||
bit := 0;
|
||||
|
||||
while (((theBits shl ($1F - bit)) = 0)) do
|
||||
begin
|
||||
Inc(bit)
|
||||
end;
|
||||
|
||||
Inc(x, bit);
|
||||
Result := TArray<Integer>.Create(x, y);
|
||||
end;
|
||||
|
||||
procedure TBitMatrix.Rotate180;
|
||||
var
|
||||
i, width, height: Integer;
|
||||
topRow, bottomRow: IBitArray;
|
||||
begin
|
||||
width := Self.Fwidth;
|
||||
height := Self.Fheight;
|
||||
topRow := TBitArrayHelpers.CreateBitArray(width);
|
||||
bottomRow := TBitArrayHelpers.CreateBitArray(width);
|
||||
i := 0;
|
||||
|
||||
while ((i < ((height + 1) div 2))) do
|
||||
begin
|
||||
topRow := Self.getRow(i, topRow);
|
||||
bottomRow := Self.getRow(((height - 1) - i), bottomRow);
|
||||
topRow.reverse;
|
||||
bottomRow.reverse;
|
||||
Self.setRow(i, bottomRow);
|
||||
Self.setRow(((height - 1) - i), topRow);
|
||||
Inc(i)
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBitMatrix.setRegion(left, top, width, height: Integer);
|
||||
var
|
||||
x, y, offset, right, bottom: Integer;
|
||||
begin
|
||||
if ((top < 0) or (left < 0)) then
|
||||
raise EArgumentException.Create('Left and top must be non-negative');
|
||||
|
||||
if ((height < 1) or (width < 1)) then
|
||||
raise EArgumentException.Create('Height and width must be at least 1');
|
||||
|
||||
right := (left + width);
|
||||
bottom := (top + height);
|
||||
|
||||
if ((bottom > Self.Fheight) or (right > Self.Fwidth)) then
|
||||
raise EArgumentException.Create('The region must fit inside the matrix');
|
||||
|
||||
y := top;
|
||||
|
||||
while ((y < bottom)) do
|
||||
begin
|
||||
offset := (y * Self.FrowSize);
|
||||
x := left;
|
||||
while ((x < right)) do
|
||||
begin
|
||||
Fbits[(offset + TMathUtils.Asr(x, 5))] :=
|
||||
(Fbits[(offset + TMathUtils.Asr(x, 5))] or (1 shl x));
|
||||
Inc(x)
|
||||
end;
|
||||
Inc(y)
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TBitMatrix.setRow(y: Integer; row: IBitArray);
|
||||
begin
|
||||
Fbits := System.Copy(row.bits, (y * FrowSize), FrowSize);
|
||||
end;
|
||||
|
||||
function TBitMatrix.ToBitmap(format: TBarcodeFormat; content: string): TBitmap;
|
||||
begin
|
||||
raise ENotImplemented.Create('Converting to bitmap is not implemented yet!');
|
||||
end;
|
||||
|
||||
function TBitMatrix.ToString: string;
|
||||
var
|
||||
r, c: Integer;
|
||||
begin
|
||||
for r := 0 to Fheight - 1 do
|
||||
begin
|
||||
for c := 0 to Fwidth - 1 do
|
||||
begin
|
||||
if Matrix[r, c] then
|
||||
Result := Result + '*'
|
||||
else
|
||||
Result := Result + '.';
|
||||
end;
|
||||
Result := Result + #13#10;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TBitMatrix.ToBitmap: TBitmap;
|
||||
begin
|
||||
Result := ToBitmap(TBarcodeFormat.CODE_128, '')
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,63 @@
|
||||
{
|
||||
* 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.Common.DetectorResult;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
ZXing.Common.BitMatrix,
|
||||
ZXing.ResultPoint;
|
||||
|
||||
type
|
||||
/// <summary> <p>Encapsulates the result of detecting a barcode in an image. This includes the raw
|
||||
/// matrix of black/white pixels corresponding to the barcode, and possibly points of interest
|
||||
/// in the image, like the location of finder patterns or corners of the barcode in the image.</p>
|
||||
/// </summary>
|
||||
TDetectorResult = class
|
||||
private
|
||||
Fbits: TBitmatrix;
|
||||
Fpoints: TArray<IResultPoint>;
|
||||
public
|
||||
constructor Create(const bits: TBitmatrix; const points: TArray<IResultPoint>);
|
||||
destructor Destroy; override;
|
||||
|
||||
property bits: TBitmatrix read Fbits;
|
||||
property points: TArray<IResultPoint> read Fpoints;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TDetectorResult.Create(const bits: TBitmatrix;
|
||||
const points: TArray<IResultPoint>);
|
||||
begin
|
||||
Fbits := bits;
|
||||
Fpoints := points;
|
||||
end;
|
||||
|
||||
destructor TDetectorResult.Destroy;
|
||||
begin
|
||||
FPoints := nil;
|
||||
FBits.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,159 @@
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by K. Gossens for Delphi
|
||||
}
|
||||
|
||||
unit ZXing.Common.GridSampler;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
ZXing.Common.Bitmatrix,
|
||||
ZXing.Common.PerspectiveTransform;
|
||||
|
||||
type
|
||||
TGridSampler = class abstract
|
||||
private
|
||||
class var FgridSampler: TGridSampler;
|
||||
//class constructor Create;
|
||||
protected
|
||||
constructor Create;
|
||||
class function checkAndNudgePoints(image: TBitMatrix; points: TArray<Single>): boolean; static;
|
||||
public
|
||||
function sampleGrid(image: TBitMatrix; dimensionX: Integer;
|
||||
dimensionY: Integer; transform: TPerspectiveTransform): TBitMatrix; overload; virtual;
|
||||
function sampleGrid(image: TBitMatrix; dimensionX: Integer;
|
||||
dimensionY: Integer; p1ToX: Single; p1ToY: Single; p2ToX: Single;
|
||||
p2ToY: Single; p3ToX: Single; p3ToY: Single; p4ToX: Single; p4ToY: Single;
|
||||
p1FromX: Single; p1FromY: Single; p2FromX: Single; p2FromY: Single;
|
||||
p3FromX: Single; p3FromY: Single; p4FromX: Single; p4FromY: Single): TBitMatrix; overload; virtual; abstract;
|
||||
procedure setGridSampler(newGridSampler: TGridSampler); //static;
|
||||
|
||||
class property Instance: TGridSampler read FgridSampler;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TGridSampler }
|
||||
|
||||
constructor TGridSampler.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
class function TGridSampler.checkAndNudgePoints(image: TBitMatrix;
|
||||
points: TArray<Single>): boolean;
|
||||
var
|
||||
width,
|
||||
height : Integer;
|
||||
nudged : Boolean;
|
||||
offset, maxOffset : Integer;
|
||||
x, y : Single;
|
||||
begin
|
||||
width := image.Width;
|
||||
height := image.Height;
|
||||
nudged := true;
|
||||
offset := 0;
|
||||
maxOffset := Length(points) - 1; // points.length must be even
|
||||
|
||||
while ((offset < maxOffset) and nudged) do
|
||||
begin
|
||||
x := points[offset];
|
||||
y := 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;
|
||||
nudged := true;
|
||||
offset := (Length(points) - 2);
|
||||
while (((offset >= 0) and nudged)) do
|
||||
begin
|
||||
x := points[offset];
|
||||
y := 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;
|
||||
|
||||
function TGridSampler.sampleGrid(image: TBitMatrix; dimensionX: Integer;
|
||||
dimensionY: Integer; transform: TPerspectiveTransform): TBitMatrix;
|
||||
begin
|
||||
raise ENotSupportedException.Create('Not yet supported');
|
||||
end;
|
||||
|
||||
procedure TGridSampler.setGridSampler(newGridSampler: TGridSampler);
|
||||
begin
|
||||
if (newGridSampler = nil)
|
||||
then
|
||||
raise EArgumentException.Create('Missing arguments');
|
||||
FgridSampler := newGridSampler;
|
||||
end;
|
||||
|
||||
end.
|
||||
+248
@@ -0,0 +1,248 @@
|
||||
{
|
||||
* 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.Common.PerspectiveTransform;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils;
|
||||
|
||||
type
|
||||
/// <summary> <p>This class implements a perspective transform in two dimensions. Given four source and four
|
||||
/// destination points, it will compute the transformation implied between them. The code is based
|
||||
/// directly upon section 3.4.2 of George Wolberg's "Digital Image Warping"; see pages 54-56.</p>
|
||||
/// </summary>
|
||||
TPerspectiveTransform = class sealed
|
||||
private
|
||||
a11: Single;
|
||||
a12: Single;
|
||||
a13: Single;
|
||||
a21: Single;
|
||||
a22: Single;
|
||||
a23: Single;
|
||||
a31: Single;
|
||||
a32: Single;
|
||||
a33: Single;
|
||||
|
||||
function buildAdjoint(): TPerspectiveTransform;
|
||||
function times(const other: TPerspectiveTransform): TPerspectiveTransform;
|
||||
public
|
||||
constructor Create(const a11, a21, a31, a12, a22, a32, a13,
|
||||
a23, a33: Single);
|
||||
|
||||
class function quadrilateralToQuadrilateral(const x0, y0, x1, y1, x2, y2,
|
||||
x3, y3, x0p, y0p, x1p, y1p, x2p, y2p,
|
||||
x3p, y3p: Single): TPerspectiveTransform; static;
|
||||
|
||||
class function quadrilateralToSquare(x0: Single; y0: Single; x1: Single;
|
||||
y1: Single; x2: Single; y2: Single; x3: Single; y3: Single)
|
||||
: TPerspectiveTransform; static;
|
||||
|
||||
class function squareToQuadrilateral(const x0, y0, x1, y1, x2, y2,
|
||||
x3, y3: Single): TPerspectiveTransform; static;
|
||||
|
||||
procedure transformPoints(var points: TArray<Single>); overload;
|
||||
|
||||
/// <summary>Convenience method, not optimized for performance. </summary>
|
||||
procedure transformPoints(const xValues, yValues: TArray<Single>); overload;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TPerspectiveTransform.Create(const a11, a21, a31, a12, a22, a32,
|
||||
a13, a23, a33: Single);
|
||||
begin
|
||||
Self.a11 := a11;
|
||||
Self.a12 := a12;
|
||||
Self.a13 := a13;
|
||||
Self.a21 := a21;
|
||||
Self.a22 := a22;
|
||||
Self.a23 := a23;
|
||||
Self.a31 := a31;
|
||||
Self.a32 := a32;
|
||||
Self.a33 := a33;
|
||||
end;
|
||||
|
||||
class function TPerspectiveTransform.quadrilateralToQuadrilateral(const x0, y0,
|
||||
x1, y1, x2, y2, x3, y3, x0p, y0p, x1p, y1p, x2p, y2p,
|
||||
x3p, y3p: Single): TPerspectiveTransform;
|
||||
var
|
||||
qToS,
|
||||
SToQ : TPerspectiveTransform;
|
||||
begin
|
||||
qToS := nil;
|
||||
SToQ := nil;
|
||||
try
|
||||
qToS := TPerspectiveTransform.quadrilateralToSquare(x0, y0, x1, y1, x2,
|
||||
y2, x3, y3);
|
||||
SToQ := TPerspectiveTransform.squareToQuadrilateral(x0p, y0p, x1p, y1p, x2p,
|
||||
y2p, x3p, y3p);
|
||||
|
||||
Result := SToQ.times(qToS);
|
||||
finally
|
||||
|
||||
//if (SToQ <> nil)
|
||||
//then
|
||||
SToQ.Free;
|
||||
|
||||
//if (qToS <> nil)
|
||||
//then
|
||||
qToS.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TPerspectiveTransform.quadrilateralToSquare(x0: Single;
|
||||
y0: Single; x1: Single; y1: Single; x2: Single; y2: Single; x3: Single;
|
||||
y3: Single): TPerspectiveTransform;
|
||||
var
|
||||
SToQ: TPerspectiveTransform;
|
||||
begin
|
||||
SToQ := nil;
|
||||
// Here, the adjoint serves as the inverse:
|
||||
try
|
||||
SToQ := TPerspectiveTransform.squareToQuadrilateral(x0, y0, x1, y1, x2,
|
||||
y2, x3, y3);
|
||||
|
||||
Result := SToQ.buildAdjoint;
|
||||
finally
|
||||
//if (SToQ <> nil)
|
||||
//then
|
||||
SToQ.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TPerspectiveTransform.squareToQuadrilateral(const x0, y0,
|
||||
x1, y1, x2, y2, x3, y3: Single): TPerspectiveTransform;
|
||||
var
|
||||
dx1, dx2,
|
||||
dx3, dy1,
|
||||
dy2, dy3,
|
||||
a13, a23,
|
||||
denominator: Single;
|
||||
begin
|
||||
dx3 := (((x0 - x1) + x2) - x3);
|
||||
dy3 := (((y0 - y1) + y2) - y3);
|
||||
|
||||
if ((dx3 = 0) and (dy3 = 0)) then
|
||||
begin
|
||||
Result := TPerspectiveTransform.Create((x1 - x0), (x2 - x1), x0, (y1 - y0),
|
||||
(y2 - y1), y0, 0, 0, 1);
|
||||
end else
|
||||
begin
|
||||
dx1 := (x1 - x2);
|
||||
dx2 := (x3 - x2);
|
||||
dy1 := (y1 - y2);
|
||||
dy2 := (y3 - y2);
|
||||
denominator := ((dx1 * dy2) - (dx2 * dy1));
|
||||
if denominator = 0 then
|
||||
begin
|
||||
a13 := 0;
|
||||
a23 := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
a13 := (((dx3 * dy2) - (dx2 * dy3)) / denominator);
|
||||
a23 := (((dx1 * dy3) - (dx3 * dy1)) / denominator);
|
||||
end;
|
||||
Result := TPerspectiveTransform.Create(((x1 - x0) + (a13 * x1)),
|
||||
((x3 - x0) + (a23 * x3)), x0, ((y1 - y0) + (a13 * y1)),
|
||||
((y3 - y0) + (a23 * y3)), y0, a13, a23, 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPerspectiveTransform.transformPoints(var points: TArray<Single>);
|
||||
var
|
||||
max, i: Integer;
|
||||
x, y,
|
||||
denominator: Single;
|
||||
begin
|
||||
|
||||
|
||||
a11 := Self.a11;
|
||||
a12 := Self.a12;
|
||||
a13 := Self.a13;
|
||||
a21 := Self.a21;
|
||||
a22 := Self.a22;
|
||||
a23 := Self.a23;
|
||||
a31 := Self.a31;
|
||||
a32 := Self.a32;
|
||||
a33 := Self.a33;
|
||||
i := 0;
|
||||
max := Length(points) - 1;
|
||||
while ((i < max)) do
|
||||
begin
|
||||
x := points[i];
|
||||
y := points[(i + 1)];
|
||||
denominator := (((a13 * x) + (a23 * y)) + a33);
|
||||
points[i] := ((((a11 * x) + (a21 * y)) + a31) / denominator);
|
||||
points[(i + 1)] := ((((a12 * x) + (a22 * y)) + a32) / denominator);
|
||||
Inc(i, 2);
|
||||
end
|
||||
end;
|
||||
|
||||
procedure TPerspectiveTransform.transformPoints(const xValues,
|
||||
yValues: TArray<Single>);
|
||||
var
|
||||
n, i: Integer;
|
||||
x, y, denominator: Single;
|
||||
begin
|
||||
n := Length(xValues);
|
||||
for i := 0 to Pred(n) do
|
||||
begin
|
||||
x := xValues[i];
|
||||
y := yValues[i];
|
||||
denominator := (((self.a13 * x) + (self.a23 * y)) + self.a33);
|
||||
xValues[i] := ((((self.a11 * x) + (self.a21 * y)) + self.a31) /
|
||||
denominator);
|
||||
yValues[i] := ((((self.a12 * x) + (self.a22 * y)) + self.a32) /
|
||||
denominator);
|
||||
end
|
||||
end;
|
||||
|
||||
function TPerspectiveTransform.buildAdjoint(): TPerspectiveTransform;
|
||||
begin
|
||||
// Adjoint is the transpose of the cofactor matrix:
|
||||
Result := TPerspectiveTransform.Create(a22 * a33 - a23 * a32,
|
||||
a23 * a31 - a21 * a33,
|
||||
a21 * a32 - a22 * a31,
|
||||
a13 * a32 - a12 * a33,
|
||||
a11 * a33 - a13 * a31,
|
||||
a12 * a31 - a11 * a32,
|
||||
a12 * a23 - a13 * a22,
|
||||
a13 * a21 - a11 * a23,
|
||||
a11 * a22 - a12 * a21);
|
||||
end;
|
||||
|
||||
function TPerspectiveTransform.times(
|
||||
const other: TPerspectiveTransform): TPerspectiveTransform;
|
||||
begin
|
||||
Result := TPerspectiveTransform.Create(a11 * other.a11 + a21 * other.a12 + a31 * other.a13,
|
||||
a11 * other.a21 + a21 * other.a22 + a31 * other.a23,
|
||||
a11 * other.a31 + a21 * other.a32 + a31 * other.a33,
|
||||
a12 * other.a11 + a22 * other.a12 + a32 * other.a13,
|
||||
a12 * other.a21 + a22 * other.a22 + a32 * other.a23,
|
||||
a12 * other.a31 + a22 * other.a32 + a32 * other.a33,
|
||||
a13 * other.a11 + a23 * other.a12 + a33 * other.a13,
|
||||
a13 * other.a21 + a23 * other.a22 + a33 * other.a23,
|
||||
a13 * other.a31 + a23 * other.a32 + a33 * other.a33);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,127 @@
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
* Restructured by K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.DecodeHintType;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TDecodeHintType = (
|
||||
/// <summary>
|
||||
/// Unspecified, application-specific hint. Maps to an unspecified <see cref="System.Object" />.
|
||||
/// </summary>
|
||||
OTHER,
|
||||
|
||||
/// <summary>
|
||||
/// Image is a pure monochrome image of a barcode. Doesn't matter what it maps to;
|
||||
/// use <see cref="bool" /> = true.
|
||||
/// </summary>
|
||||
PURE_BARCODE,
|
||||
|
||||
/// <summary>
|
||||
/// Image is known to be of one of a few possible formats.
|
||||
/// Maps to a <see cref="System.Collections.ICollection" /> of <see cref="BarcodeFormat" />s.
|
||||
/// </summary>
|
||||
POSSIBLE_FORMATS,
|
||||
|
||||
/// <summary>
|
||||
/// Spend more time to try to find a barcode; optimize for accuracy, not speed.
|
||||
/// Doesn't matter what it maps to; use <see cref="bool" /> = true.
|
||||
/// </summary>
|
||||
TRY_HARDER,
|
||||
|
||||
/// <summary>
|
||||
/// Specifies what character encoding to use when decoding, where applicable (type String)
|
||||
/// </summary>
|
||||
CHARACTER_SET,
|
||||
|
||||
/// <summary>
|
||||
/// Allowed lengths of encoded data -- reject anything else. Maps to an int[].
|
||||
/// </summary>
|
||||
ALLOWED_LENGTHS,
|
||||
|
||||
/// <summary>
|
||||
/// Assume Code 39 codes employ a check digit. Maps to <see cref="bool" />.
|
||||
/// </summary>
|
||||
ASSUME_CODE_39_CHECK_DIGIT,
|
||||
|
||||
/// <summary>
|
||||
/// The caller needs to be notified via callback when a possible <see cref="TResultPoint" />
|
||||
/// is found. Maps to a <see cref="TResultPointCallback" />.
|
||||
/// </summary>
|
||||
NEED_RESULT_POINT_CALLBACK,
|
||||
|
||||
/// <summary>
|
||||
/// Assume MSI codes employ a check digit. Maps to <see cref="bool" />.
|
||||
/// </summary>
|
||||
ASSUME_MSI_CHECK_DIGIT,
|
||||
|
||||
/// <summary>
|
||||
/// if Code39 could be detected try to use extended mode for full ASCII character set
|
||||
/// Maps to <see cref="bool" />.
|
||||
/// </summary>
|
||||
USE_CODE_39_EXTENDED_MODE,
|
||||
|
||||
/// <summary>
|
||||
/// Don't fail if a Code39 is detected but can't be decoded in extended mode.
|
||||
/// Return the raw Code39 result instead. Maps to <see cref="bool" />.
|
||||
/// </summary>
|
||||
RELAXED_CODE_39_EXTENDED_MODE,
|
||||
|
||||
/// <summary>
|
||||
/// 1D readers supporting rotation with TRY_HARDER enabled.
|
||||
/// But BarcodeReader class can do auto-rotating for 1D and 2D codes.
|
||||
/// Enabling that option prevents 1D readers doing double rotation.
|
||||
/// BarcodeReader enables that option automatically if "global" auto-rotation is enabled.
|
||||
/// Maps to <see cref="bool" />.
|
||||
/// </summary>
|
||||
TRY_HARDER_WITHOUT_ROTATION,
|
||||
|
||||
/// <summary>
|
||||
/// Assume the barcode is being processed as a GS1 barcode, and modify behavior as needed.
|
||||
/// For example this affects FNC1 handling for Code 128 (aka GS1-128). Doesn't matter what it maps to;
|
||||
/// use <see cref="bool" />.
|
||||
/// </summary>
|
||||
ASSUME_GS1,
|
||||
|
||||
/// <summary>
|
||||
/// If true, return the start and end digits in a Codabar barcode instead of stripping them. They
|
||||
/// are alpha, whereas the rest are numeric. By default, they are stripped, but this causes them
|
||||
/// to not be. Doesn't matter what it maps to; use <see cref="bool" />.
|
||||
/// </summary>
|
||||
RETURN_CODABAR_START_END,
|
||||
|
||||
/// <summary>
|
||||
/// Allowed extension lengths for EAN or UPC barcodes. Other formats will ignore this.
|
||||
/// Maps to an <see cref="Array.int" /> of the allowed extension lengths, for example [2], [5], or [2, 5].
|
||||
/// If it is optional to have an extension, do not set this hint. If this is set,
|
||||
/// and a UPC or EAN barcode is found but an extension is not, then no result will be returned
|
||||
/// at all.
|
||||
/// </summary>
|
||||
ALLOWED_EAN_EXTENSIONS,
|
||||
/// <summary>
|
||||
/// Allowes for inversion of an image.
|
||||
/// Add the to invert the image
|
||||
/// </summary>
|
||||
ENABLE_INVERSION
|
||||
);
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,90 @@
|
||||
unit ZXing.DecoderResult;
|
||||
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
}
|
||||
interface
|
||||
|
||||
uses SysUtils,
|
||||
Generics.Collections,
|
||||
ZXIng.ByteSegments;
|
||||
|
||||
type
|
||||
TDecoderResult = class
|
||||
private
|
||||
function GetStructuredAppend: boolean;
|
||||
public
|
||||
ByteSegments: IByteSegments;
|
||||
ECLevel: string;
|
||||
Erasures: Integer;
|
||||
ErrorsCorrected: Integer;
|
||||
Other: TObject;
|
||||
RawBytes: TArray<Byte>;
|
||||
StructuredAppendParity: Integer;
|
||||
StructuredAppendSequenceNumber: Integer;
|
||||
Text: string;
|
||||
|
||||
constructor Create(RawBytes: TArray<Byte>; const Text: string;
|
||||
ByteSegments: IByteSegments; ECLevel: string); overload;
|
||||
constructor Create(RawBytes: TArray<Byte>; const Text: string;
|
||||
ByteSegments: IByteSegments; ECLevel: string; saSequence: Integer;
|
||||
saParity: Integer); overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
property StructuredAppend: boolean read GetStructuredAppend;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TDecoderResult }
|
||||
|
||||
constructor TDecoderResult.Create(RawBytes: TArray<Byte>; const Text: String;
|
||||
ByteSegments: IByteSegments; ECLevel: String);
|
||||
begin
|
||||
Self.Create(RawBytes, Text, ByteSegments, ECLevel, -1, -1);
|
||||
end;
|
||||
|
||||
constructor TDecoderResult.Create(RawBytes: TArray<Byte>; const Text: string;
|
||||
ByteSegments: IByteSegments; ECLevel: string;
|
||||
saSequence, saParity: Integer);
|
||||
begin
|
||||
if ((RawBytes = nil) and (Text = ''))
|
||||
then
|
||||
raise EArgumentException.Create('Text or rawbytes cannot be nil or empty');
|
||||
|
||||
Self.RawBytes := RawBytes;
|
||||
Self.Text := Text;
|
||||
Self.ByteSegments := ByteSegments;
|
||||
Self.ECLevel := ECLevel;
|
||||
Self.StructuredAppendParity := saParity;
|
||||
Self.StructuredAppendSequenceNumber := saSequence
|
||||
end;
|
||||
|
||||
destructor TDecoderResult.Destroy;
|
||||
begin
|
||||
RawBytes := nil;
|
||||
FreeAndNil(Other);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TDecoderResult.GetStructuredAppend: boolean;
|
||||
begin
|
||||
result := (StructuredAppendParity >= 0) and
|
||||
(StructuredAppendSequenceNumber >= 0);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,266 @@
|
||||
{
|
||||
* 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.
|
||||
@@ -0,0 +1,43 @@
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
* Restructured by K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.EncodeHintType;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TEncodeHintType = (AZTEC_LAYERS = 15,
|
||||
CHARACTER_SET = 4,
|
||||
CODE128_FORCE_CODESET_B = 13,
|
||||
DATA_MATRIX_DEFAULT_ENCODATION = 14,
|
||||
DATA_MATRIX_SHAPE = 10,
|
||||
DISABLE_ECI = 9,
|
||||
ERROR_CORRECTION = 3,
|
||||
HEIGHT = 1,
|
||||
MARGIN = 5,
|
||||
MAX_SIZE = 12,
|
||||
MIN_SIZE = 11,
|
||||
PDF417_COMPACTION = 7,
|
||||
PDF417_DIMENSIONS = 8,
|
||||
PURE_BARCODE = 2,
|
||||
WIDTH = 0);
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,62 @@
|
||||
unit ZXing.Helpers;
|
||||
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
}
|
||||
interface
|
||||
|
||||
type
|
||||
TArray = class
|
||||
class function Clone(original: TArray<Integer>): TArray<Integer>; static;
|
||||
class function CopyInSameArray(const Input: TArray<Integer>;
|
||||
StartIndex: Integer; Len: Integer): TArray<Integer>; static;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class function TArray.Clone(original: TArray<Integer>): TArray<Integer>;
|
||||
var
|
||||
i: Integer;
|
||||
l: SmallInt;
|
||||
begin
|
||||
l := Length(original);
|
||||
Result := TArray<Integer>.Create();
|
||||
SetLength(Result, l);
|
||||
|
||||
for i := 0 to l - 1 do
|
||||
begin
|
||||
Result[i] := original[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TArray.CopyInSameArray(const Input: TArray<Integer>;
|
||||
StartIndex: Integer; Len: Integer): TArray<Integer>;
|
||||
var
|
||||
i, y: Integer;
|
||||
begin
|
||||
Result := TArray.Clone(Input);
|
||||
|
||||
y := 0;
|
||||
for i := StartIndex to (StartIndex + Len -1) do
|
||||
begin
|
||||
Result[y] := Input[i];
|
||||
inc(y);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,350 @@
|
||||
{
|
||||
* 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 Authors: Sean Owen and dswitkin@google.com (Daniel Switkin)
|
||||
* Ported from ZXING Java Source: www.Redivivus.in (suraj.supekar@redivivus.in)
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.MultiFormatReader;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Rtti,
|
||||
System.Generics.Collections,
|
||||
System.RegularExpressions,
|
||||
ZXing.ReadResult,
|
||||
ZXing.Reader,
|
||||
ZXing.DecodeHintType,
|
||||
ZXing.BinaryBitmap,
|
||||
ZXing.BarcodeFormat,
|
||||
ZXing.ResultPoint,
|
||||
|
||||
// 1D Barcodes
|
||||
ZXing.OneD.OneDReader,
|
||||
ZXing.OneD.Code128Reader,
|
||||
ZXing.OneD.Code93Reader,
|
||||
ZXing.OneD.ITFReader,
|
||||
ZXing.OneD.EAN13Reader,
|
||||
ZXing.OneD.EAN8Reader,
|
||||
ZXing.OneD.UPCAReader,
|
||||
ZXing.OneD.UPCEReader,
|
||||
ZXing.OneD.Code39Reader,
|
||||
|
||||
// 2D Codes
|
||||
ZXing.QrCode.QRCodeReader,
|
||||
ZXing.Datamatrix.DataMatrixReader;
|
||||
|
||||
/// <summary>
|
||||
/// MultiFormatReader is a convenience class and the main entry point into the library for most uses.
|
||||
/// By default it attempts to decode all barcode formats that the library supports. Optionally, you
|
||||
/// can provide a hints object to request different behavior, for example only decoding QR codes.
|
||||
/// </summary>
|
||||
/// <author>Sean Owen</author>
|
||||
/// <author>dswitkin@google.com (Daniel Switkin)</author>
|
||||
/// <author>www.Redivivus.in (suraj.supekar@redivivus.in) - Ported from ZXING Java Source</author>
|
||||
type
|
||||
|
||||
TMultiFormatReader = class(TInterfacedObject, IReader)
|
||||
private
|
||||
|
||||
FHints: TDictionary<TDecodeHintType, TObject>;
|
||||
readers: TList<IReader>;
|
||||
|
||||
function DecodeInternal(image: TBinaryBitmap): TReadResult;
|
||||
procedure Set_Hints(const Value: TDictionary<TDecodeHintType, TObject>);
|
||||
function Get_Hints: TDictionary<TDecodeHintType, TObject>;
|
||||
|
||||
/// <summary> This version of decode honors the intent of Reader.decode(BinaryBitmap) in that it
|
||||
/// passes null as a hint to the decoders. However, that makes it inefficient to call repeatedly.
|
||||
/// Use setHints() followed by decodeWithState() for continuous scan applications.
|
||||
///
|
||||
/// </summary>
|
||||
/// <param name="image">The pixel data to decode
|
||||
/// </param>
|
||||
/// <returns> The contents of the image
|
||||
/// </returns>
|
||||
/// <throws> ReaderException Any errors which occurred </throws>
|
||||
public
|
||||
function decode(const image: TBinaryBitmap): TReadResult; overload;
|
||||
function decode(const image: TBinaryBitmap; WithHints: Boolean)
|
||||
: TReadResult; overload;
|
||||
/// <summary> Decode an image using the hints provided. Does not honor existing state.
|
||||
///
|
||||
/// </summary>
|
||||
/// <param name="image">The pixel data to decode
|
||||
/// </param>
|
||||
/// <param name="hints">The hints to use, clearing the previous state.
|
||||
/// </param>
|
||||
/// <returns> The contents of the image
|
||||
/// </returns>
|
||||
/// <throws> ReaderException Any errors which occurred </throws>
|
||||
function decode(const image: TBinaryBitmap;
|
||||
hints: TDictionary<TDecodeHintType, TObject>): TReadResult; overload;
|
||||
|
||||
/// <summary> Decode an image using the state set up by calling setHints() previously. Continuous scan
|
||||
/// clients will get a <b>large</b> speed increase by using this instead of decode().
|
||||
///
|
||||
/// </summary>
|
||||
/// <param name="image">The pixel data to decode
|
||||
/// </param>
|
||||
/// <returns> The contents of the image
|
||||
/// </returns>
|
||||
/// <throws> ReaderException Any errors which occurred </throws>
|
||||
function DecodeWithState(image: TBinaryBitmap): TReadResult;
|
||||
destructor Destroy; override;
|
||||
|
||||
/// <summary> This method adds state to the MultiFormatReader. By setting the hints once, subsequent calls
|
||||
/// to decodeWithState(image) can reuse the same set of readers without reallocating memory. This
|
||||
/// is important for performance in continuous scan clients.
|
||||
///
|
||||
/// </summary>
|
||||
/// <param name="hints">The set of hints to use for subsequent calls to decode(image)
|
||||
/// </param>
|
||||
property hints: TDictionary<TDecodeHintType, TObject> read Get_Hints
|
||||
write Set_Hints;
|
||||
|
||||
procedure Reset;
|
||||
procedure FreeReaders();
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TMultiFormatReader.decode(const image: TBinaryBitmap): TReadResult;
|
||||
begin
|
||||
hints := nil;
|
||||
result := DecodeInternal(image)
|
||||
end;
|
||||
|
||||
function TMultiFormatReader.decode(const image: TBinaryBitmap;
|
||||
WithHints: Boolean): TReadResult;
|
||||
begin
|
||||
result := DecodeInternal(image)
|
||||
end;
|
||||
|
||||
function TMultiFormatReader.decode(const image: TBinaryBitmap;
|
||||
hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
|
||||
begin
|
||||
FHints := hints;
|
||||
result := DecodeInternal(image)
|
||||
end;
|
||||
|
||||
function TMultiFormatReader.DecodeWithState(image: TBinaryBitmap): TReadResult;
|
||||
begin
|
||||
// Make sure to set up the default state so we don't crash
|
||||
if readers = nil then
|
||||
begin
|
||||
hints := nil
|
||||
end;
|
||||
|
||||
result := DecodeInternal(image);
|
||||
|
||||
end;
|
||||
|
||||
destructor TMultiFormatReader.Destroy;
|
||||
begin
|
||||
FreeReaders;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TMultiFormatReader.FreeReaders;
|
||||
begin
|
||||
if readers <> nil then
|
||||
readers.Clear();
|
||||
|
||||
readers.Free;
|
||||
readers := nil;
|
||||
end;
|
||||
|
||||
function TMultiFormatReader.Get_Hints: TDictionary<TDecodeHintType, TObject>;
|
||||
begin
|
||||
result := FHints;
|
||||
end;
|
||||
|
||||
procedure TMultiFormatReader.Set_Hints(const Value: TDictionary<TDecodeHintType,
|
||||
TObject>);
|
||||
var
|
||||
useCode39CheckDigit, useCode39ExtendedMode: Boolean;
|
||||
formats: TList<TBarcodeFormat>;
|
||||
begin
|
||||
FHints := Value;
|
||||
|
||||
// tryHarder := (Value <> nil) and
|
||||
// (Value.ContainsKey(ZXing.DecodeHintType.TRY_HARDER));
|
||||
|
||||
if ((Value = nil) or
|
||||
(not Value.ContainsKey(ZXing.DecodeHintType.POSSIBLE_FORMATS))) then
|
||||
begin
|
||||
formats := nil;
|
||||
end
|
||||
else
|
||||
begin
|
||||
formats := Value[ZXing.DecodeHintType.POSSIBLE_FORMATS]
|
||||
as TList<TBarcodeFormat>
|
||||
end;
|
||||
|
||||
// add readers from the hints
|
||||
readers := TList<IReader>.Create;
|
||||
if formats <> nil then
|
||||
begin
|
||||
|
||||
// 1D readers
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.CODE_128)) then
|
||||
begin
|
||||
readers.Add(TCode128Reader.Create())
|
||||
end;
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.CODE_93)) then
|
||||
begin
|
||||
readers.Add(TCode93Reader.Create())
|
||||
end;
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.ITF)) then
|
||||
begin
|
||||
readers.Add(TITFReader.Create())
|
||||
end;
|
||||
|
||||
// 2D readers
|
||||
if (formats.Contains(TBarcodeFormat.QR_CODE)) then
|
||||
begin
|
||||
readers.Add(TQRCodeReader.Create())
|
||||
end;
|
||||
|
||||
if formats.Contains(TBarcodeFormat.DATA_MATRIX) then
|
||||
readers.Add(TDataMatrixReader.Create);
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.EAN_13)) then
|
||||
readers.Add(TEAN13Reader.Create());
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.EAN_8)) then
|
||||
readers.Add(TEAN8Reader.Create());
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.UPC_A)) then
|
||||
readers.Add(TUPCAReader.Create());
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.UPC_E)) then
|
||||
readers.Add(TUPCEReader.Create());
|
||||
|
||||
if (formats.Contains(TBarcodeFormat.CODE_39)) then
|
||||
begin
|
||||
useCode39CheckDigit := hints.ContainsKey
|
||||
(TDecodeHintType.ASSUME_CODE_39_CHECK_DIGIT) and
|
||||
hints.ContainsKey(TDecodeHintType.ASSUME_CODE_39_CHECK_DIGIT);
|
||||
|
||||
useCode39ExtendedMode := hints.ContainsKey
|
||||
(TDecodeHintType.USE_CODE_39_EXTENDED_MODE) and
|
||||
hints.ContainsKey(TDecodeHintType.USE_CODE_39_EXTENDED_MODE);
|
||||
|
||||
readers.Add(TCode39Reader.Create(useCode39CheckDigit,
|
||||
useCode39ExtendedMode));
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
if (readers.Count = 0) then // must be auto, add them all
|
||||
begin
|
||||
|
||||
// 1D readers
|
||||
readers.Add(TCode128Reader.Create());
|
||||
readers.Add(TUPCAReader.Create());
|
||||
readers.Add(TUPCEReader.Create());
|
||||
readers.Add(TEAN13Reader.Create());
|
||||
readers.Add(TEAN8Reader.Create());
|
||||
readers.Add(TCode93Reader.Create());
|
||||
readers.Add(TITFReader.Create());
|
||||
useCode39CheckDigit := hints.ContainsKey
|
||||
(TDecodeHintType.ASSUME_CODE_39_CHECK_DIGIT) and hints.ContainsKey
|
||||
(TDecodeHintType.ASSUME_CODE_39_CHECK_DIGIT);
|
||||
|
||||
useCode39ExtendedMode := hints.ContainsKey
|
||||
(TDecodeHintType.USE_CODE_39_EXTENDED_MODE) and hints.ContainsKey
|
||||
(TDecodeHintType.USE_CODE_39_EXTENDED_MODE);
|
||||
|
||||
readers.Add(TCode39Reader.Create(useCode39CheckDigit,
|
||||
useCode39ExtendedMode));
|
||||
|
||||
|
||||
// 2D readers
|
||||
readers.Add(TQRCodeReader.Create());
|
||||
readers.Add(TDataMatrixReader.Create)
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TMultiFormatReader.Reset;
|
||||
var
|
||||
Reader: IReader;
|
||||
begin
|
||||
if readers <> nil then
|
||||
begin
|
||||
for Reader in readers do
|
||||
begin
|
||||
Reader.Reset();
|
||||
end
|
||||
end
|
||||
end;
|
||||
|
||||
function TMultiFormatReader.DecodeInternal(image: TBinaryBitmap): TReadResult;
|
||||
var
|
||||
rpCallBack: TResultPointCallback;
|
||||
i: integer;
|
||||
Reader: IReader;
|
||||
begin
|
||||
|
||||
result := nil;
|
||||
if (readers = nil) then
|
||||
begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
rpCallBack := nil;
|
||||
if ((FHints <> nil) and
|
||||
(FHints.ContainsKey(ZXing.DecodeHintType.NEED_RESULT_POINT_CALLBACK))) then
|
||||
begin
|
||||
// rpCallBack := FHints[DecodeHintType.NEED_RESULT_POINT_CALLBACK]
|
||||
// as TResultPointCallback(nil);
|
||||
end;
|
||||
|
||||
for i := 0 to readers.Count - 1 do
|
||||
begin
|
||||
|
||||
Reader := readers[i];
|
||||
Reader.Reset();
|
||||
result := Reader.decode(image, FHints);
|
||||
if result <> nil then
|
||||
begin
|
||||
|
||||
// found a barcode, pushing the successful reader up front
|
||||
// I assume that the same type of barcode is read multiple times
|
||||
// so the reordering of the readers list should speed up the next reading
|
||||
// a little bit
|
||||
|
||||
readers.Delete(i);
|
||||
readers.Insert(0, Reader);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// if rpCallBack <> nil then
|
||||
// rpCallBack(nil)
|
||||
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,344 @@
|
||||
{
|
||||
* Copyright 2008 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: bbrown@google.com (Brian Brown)
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
unit ZXing.ReadResult;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
Generics.Collections,
|
||||
ZXing.ResultPoint,
|
||||
ZXing.ResultMetadataType,
|
||||
ZXing.BarcodeFormat,
|
||||
ZXing.ByteSegments;
|
||||
|
||||
type
|
||||
|
||||
IMetaData = Interface
|
||||
['{27AEB2C5-D775-44C6-9816-3E69025CA57C}']
|
||||
end;
|
||||
|
||||
IStringMetadata = interface(IMetaData)
|
||||
['{8073F897-30AD-49B7-AE0B-B187D3373163}']
|
||||
function Value:String;
|
||||
end;
|
||||
|
||||
IIntegerMetadata = interface(IMetaData)
|
||||
['{CA60A23A-57ED-4C8E-9886-4F23B832A90C}']
|
||||
function Value:Integer;
|
||||
end;
|
||||
|
||||
IByteSegmentsMetadata = interface(IMetaData)
|
||||
['{CA60A23A-57ED-4C8E-9886-4F23B832A90C}']
|
||||
function Value:IByteSegments;
|
||||
end;
|
||||
|
||||
/// <summary>
|
||||
/// represents the metadata contained in a TReadResult and provides the
|
||||
/// helping functions needed to create them
|
||||
/// </summary>
|
||||
TResultMetaData = class(TDictionary<TResultMetadataType, IMetaData>)
|
||||
public
|
||||
constructor Create;
|
||||
class function CreateStringMetadata(const Value:string) :IStringMetaData;
|
||||
class function CreateIntegerMetadata(const Value:integer) :IIntegerMetaData;
|
||||
class function CreateByteSegmentsMetadata(const Value:IByteSegments) :IByteSegmentsMetadata;
|
||||
end;
|
||||
|
||||
TReadResult = class
|
||||
private
|
||||
FText: string;
|
||||
FTimeStamp: TDateTime;
|
||||
FResultMetadata: TResultMetaData;
|
||||
FRawBytes: TArray<Byte>;
|
||||
FResultPoints: TArray<IResultPoint>;
|
||||
FFormat: TBarcodeFormat;
|
||||
|
||||
procedure SetText(const AValue: String);
|
||||
procedure SetMetaData( const Value: TResultMetadata);
|
||||
public
|
||||
/// <summary>
|
||||
/// Initializes a new instance of the <see cref="TReadResult"/> class.
|
||||
/// </summary>
|
||||
/// <param name="text">The text.</param>
|
||||
/// <param name="rawBytes">The raw bytes.</param>
|
||||
/// <param name="resultPoints">The result points.</param>
|
||||
/// <param name="format">The format.</param>
|
||||
constructor Create(const text: string; const rawBytes: TArray<Byte>;
|
||||
const resultPoints: TArray<IResultPoint>;
|
||||
const format: TBarcodeFormat); overload;
|
||||
|
||||
/// <summary>
|
||||
/// Initializes a new instance of the <see cref="TReadResult"/> class.
|
||||
/// </summary>
|
||||
/// <param name="text">The text.</param>
|
||||
/// <param name="rawBytes">The raw bytes.</param>
|
||||
/// <param name="resultPoints">The result points.</param>
|
||||
/// <param name="format">The format.</param>
|
||||
/// <param name="timestamp">The timestamp.</param>
|
||||
constructor Create(const text: string; const rawBytes: TArray<Byte>;
|
||||
const resultPoints: TArray<IResultPoint>; const format: TBarcodeFormat;
|
||||
const timeStamp: TDateTime); overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
function ToString: String; override;
|
||||
|
||||
// we need a "write" procedure accessor because we need to properly deallocate
|
||||
// existing instance if we overwrite it with another one
|
||||
property ResultMetaData: TResultMetadata
|
||||
read FResultMetadata write SetMetaData;
|
||||
|
||||
/// <summary>
|
||||
/// Adds one metadata to the result
|
||||
/// </summary>
|
||||
/// <param name="type">The type.</param>
|
||||
/// <param name="value">The value.</param>
|
||||
procedure putMetadata(const ResultMetadataType: TResultMetadataType;
|
||||
const Value: IMetaData);
|
||||
|
||||
/// <summary>
|
||||
/// Adds a list of metadata to the result
|
||||
/// </summary>
|
||||
/// <param name="metadata">The metadata.</param>
|
||||
procedure putAllMetaData(const metaData: TResultMetadata);
|
||||
|
||||
/// <summary>
|
||||
/// Adds the result points.
|
||||
/// </summary>
|
||||
/// <param name="newPoints">The new points.</param>
|
||||
procedure addResultPoints(const newPoints: TArray<IResultPoint>);
|
||||
|
||||
/// <returns>raw text encoded by the barcode, if applicable, otherwise <code>null</code></returns>
|
||||
property text: String read FText write SetText;
|
||||
|
||||
/// <returns>raw bytes encoded by the barcode, if applicable, otherwise <code>null</code></returns>
|
||||
property rawBytes: TArray<Byte> read FRawBytes write FRawBytes;
|
||||
|
||||
/// <returns>
|
||||
/// points related to the barcode in the image. These are typically points
|
||||
/// identifying finder patterns or the corners of the barcode. The exact meaning is
|
||||
/// specific to the type of barcode that was decoded.
|
||||
/// </returns>
|
||||
property resultPoints: TArray<IResultPoint> read FResultPoints
|
||||
write FResultPoints;
|
||||
|
||||
/// <returns>{@link TBarcodeFormat} representing the format of the barcode that was decoded</returns>
|
||||
property BarcodeFormat: TBarcodeFormat read FFormat write FFormat;
|
||||
|
||||
/// <summary>
|
||||
/// Gets the timestamp.
|
||||
/// </summary>
|
||||
property timeStamp: TDateTime read FTimeStamp;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
{$REGION 'IMetaData implementations'}
|
||||
|
||||
{ TStringMetadata }
|
||||
type
|
||||
TStringMetadata = class(TInterfacedObject,IMetaData,IStringMetadata)
|
||||
strict private
|
||||
FValue: String;
|
||||
function Value: String;
|
||||
private
|
||||
constructor Create(const AValue: String);
|
||||
end;
|
||||
|
||||
function TStringMetadata.Value: String;
|
||||
begin
|
||||
result := FValue
|
||||
end;
|
||||
|
||||
constructor TStringMetadata.Create(const AValue: string);
|
||||
begin
|
||||
inherited Create;
|
||||
FValue := AValue;
|
||||
end;
|
||||
|
||||
{ TIntegerMetadata }
|
||||
type
|
||||
TIntegerMetadata = class(TInterfacedObject,IMetaData,IIntegerMetadata)
|
||||
strict private
|
||||
FValue: Integer;
|
||||
function Value: Integer;
|
||||
private
|
||||
constructor Create(const AValue: Integer);
|
||||
end;
|
||||
|
||||
function TIntegerMetadata.Value: Integer;
|
||||
begin
|
||||
result := FValue
|
||||
end;
|
||||
|
||||
constructor TIntegerMetadata.Create(const AValue: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
FValue := AValue;
|
||||
end;
|
||||
|
||||
|
||||
{ TByteSegmentsMetadata }
|
||||
type
|
||||
TByteSegmentsMetadata = class(TInterfacedObject,IMetaData,IByteSegmentsMetadata)
|
||||
strict private
|
||||
FValue: IByteSegments;
|
||||
function Value: IByteSegments;
|
||||
private
|
||||
constructor Create(const AValue: IByteSegments);
|
||||
end;
|
||||
|
||||
function TByteSegmentsMetadata.Value: IByteSegments;
|
||||
begin
|
||||
result := FValue
|
||||
end;
|
||||
|
||||
constructor TByteSegmentsMetadata.Create(const AValue: IByteSegments);
|
||||
begin
|
||||
inherited Create;
|
||||
FValue := AValue;
|
||||
end;
|
||||
|
||||
{ TResultMetadata }
|
||||
constructor TResultMetaData.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
class function TResultMetadata.CreateStringMetadata(const Value:string) :IStringMetaData;
|
||||
begin
|
||||
result := TStringMetadata.Create(Value);
|
||||
end;
|
||||
|
||||
class function TResultMetaData.CreateByteSegmentsMetadata(
|
||||
const Value: IByteSegments): IByteSegmentsMetadata;
|
||||
begin
|
||||
result := TByteSegmentsMetadata.Create(value);
|
||||
end;
|
||||
|
||||
class function TResultMetadata.CreateIntegerMetadata(const Value:integer) :IIntegerMetaData;
|
||||
begin
|
||||
result := TIntegerMetadata.Create(Value);
|
||||
end;
|
||||
|
||||
{$ENDREGION 'IMetaData implementations'}
|
||||
|
||||
|
||||
{ TReadResult }
|
||||
|
||||
constructor TReadResult.Create(const text: String; const rawBytes: TArray<Byte>;
|
||||
const resultPoints: TArray<IResultPoint>; const format: TBarcodeFormat);
|
||||
begin
|
||||
Self.Create(text, rawBytes, resultPoints, format, Now);
|
||||
end;
|
||||
|
||||
constructor TReadResult.Create(const text: String; const rawBytes: TArray<Byte>;
|
||||
const resultPoints: TArray<IResultPoint>; const format: TBarcodeFormat;
|
||||
const timeStamp: TDateTime);
|
||||
begin
|
||||
if ((text = '') and (rawBytes = nil)) then
|
||||
raise EArgumentException.Create('Text and bytes are null.');
|
||||
|
||||
SetText(text);
|
||||
FRawBytes := rawBytes;
|
||||
FResultPoints := resultPoints;
|
||||
FResultMetadata := nil;
|
||||
FFormat := format;
|
||||
FResultMetadata := nil;
|
||||
FTimeStamp := timeStamp;
|
||||
end;
|
||||
|
||||
destructor TReadResult.Destroy;
|
||||
var i:Integer;
|
||||
begin
|
||||
|
||||
for I := Low(FResultPoints) to High(FResultPoints) do
|
||||
begin
|
||||
FResultPoints[i] := nil;
|
||||
end;
|
||||
|
||||
FResultPoints := nil;
|
||||
FRawBytes := nil;
|
||||
|
||||
if FResultMetadata <> nil then
|
||||
begin
|
||||
FResultMetadata.Clear;
|
||||
FreeAndNil(FResultMetadata);
|
||||
end;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
// Added (KG): UTF-8 compatiblity
|
||||
procedure TReadResult.SetMetaData(const Value: TResultMetadata);
|
||||
begin
|
||||
if value = FResultMetadata then
|
||||
exit; // no change
|
||||
if FResultMetadata<>nil then
|
||||
FResultMetadata.Free; // we need to free existing object instance, for old-gen compilers
|
||||
FResultMetadata := Value;
|
||||
end;
|
||||
|
||||
procedure TReadResult.SetText(const AValue: String);
|
||||
begin
|
||||
FText := AValue;
|
||||
end;
|
||||
|
||||
procedure TReadResult.putMetadata(const ResultMetadataType: TResultMetadataType;
|
||||
const Value: IMetaData);
|
||||
begin
|
||||
if (FResultMetadata = nil) then
|
||||
FResultMetadata := TResultMetadata.Create();
|
||||
FResultMetadata.AddOrSetValue(ResultMetadataType, Value);
|
||||
end;
|
||||
|
||||
procedure TReadResult.putAllMetaData(const metaData: TResultMetadata);
|
||||
var
|
||||
key: TResultMetadataType;
|
||||
begin
|
||||
if (metaData <> nil) then
|
||||
begin
|
||||
if (FResultMetadata = nil) then
|
||||
FResultMetadata := TResultMetadata.Create();
|
||||
for key in metaData.Keys do
|
||||
FResultMetadata.AddOrSetValue(key, metaData[key]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TReadResult.addResultPoints(const newPoints: TArray<IResultPoint>);
|
||||
begin
|
||||
FResultPoints := FResultPoints + newPoints;
|
||||
end;
|
||||
|
||||
/// <summary>
|
||||
/// Returns a <see cref="System.String"/> that represents this instance.
|
||||
/// </summary>
|
||||
/// <returns>
|
||||
/// A <see cref="System.String"/> that represents this instance.
|
||||
/// </returns>
|
||||
function TReadResult.ToString(): String;
|
||||
begin
|
||||
if (text = '') then
|
||||
Result := '[' + IntToStr(Length(rawBytes)) + ' bytes]'
|
||||
else
|
||||
Result := text;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,71 @@
|
||||
{
|
||||
* 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 Authors: Sean Owen and dswitkin@google.com (Daniel Switkin)
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.Reader;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
ZXing.BinaryBitmap,
|
||||
ZXing.ReadResult,
|
||||
ZXing.DecodeHintType;
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// Implementations of this interface can decode an image of a barcode in some format into
|
||||
/// the String it encodes. For example, <see cref="ZXing.QrCode.QRCodeReader" /> can
|
||||
/// decode a QR code. The decoder may optionally receive hints from the caller which may help
|
||||
/// it decode more quickly or accurately.
|
||||
///
|
||||
/// See <see cref="MultiFormatReader" />, which attempts to determine what barcode
|
||||
/// format is present within the image as well, and then decodes it accordingly.
|
||||
/// </summary>
|
||||
IReader = interface
|
||||
/// <summary>
|
||||
/// Locates and decodes a barcode in some format within an image.
|
||||
/// </summary>
|
||||
/// <param name="image">image of barcode to decode</param>
|
||||
/// <returns>String which the barcode encodes</returns>
|
||||
function decode(const image: TBinaryBitmap): TReadResult; overload;
|
||||
|
||||
/// <summary> Locates and decodes a barcode in some format within an image. This method also accepts
|
||||
/// hints, each possibly associated to some data, which may help the implementation decode.
|
||||
/// </summary>
|
||||
/// <param name="image">image of barcode to decode</param>
|
||||
/// <param name="hints">passed as a <see cref="IDictionary{TKey, TValue}" /> from <see cref="DecodeHintType" />
|
||||
/// to arbitrary data. The
|
||||
/// meaning of the data depends upon the hint type. The implementation may or may not do
|
||||
/// anything with these hints.
|
||||
/// </param>
|
||||
/// <returns>String which the barcode encodes</returns>
|
||||
function decode(const image: TBinaryBitmap;
|
||||
hints: TDictionary<TDecodeHintType, TObject>): TReadResult; overload;
|
||||
|
||||
/// <summary>
|
||||
/// Resets any internal state the implementation has after a decode, to prepare it
|
||||
/// for reuse.
|
||||
/// </summary>
|
||||
procedure Reset();
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,108 @@
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
}
|
||||
|
||||
unit ZXing.ResultMetadataType;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// Represents some type of metadata about the result of the decoding that the decoder
|
||||
/// wishes to communicate back to the caller.
|
||||
/// </summary>
|
||||
/// <author>Sean Owen</author>
|
||||
TResultMetadataType = (
|
||||
/// <summary>
|
||||
/// Unspecified, application-specific metadata. Maps to an unspecified {@link Object}.
|
||||
/// </summary>
|
||||
OTHER,
|
||||
|
||||
/// <summary>
|
||||
/// Denotes the likely approximate orientation of the barcode in the image. This value
|
||||
/// is given as degrees rotated clockwise from the normal, upright orientation.
|
||||
/// For example a 1D barcode which was found by reading top-to-bottom would be
|
||||
/// said to have orientation "90". This key maps to an {@link Integer} whose
|
||||
/// value is in the range [0,360).
|
||||
/// </summary>
|
||||
ORIENTATION,
|
||||
|
||||
/// <summary>
|
||||
/// <p>2D barcode formats typically encode text, but allow for a sort of 'byte mode'
|
||||
/// which is sometimes used to encode binary data. While {@link Result} makes available
|
||||
/// the complete raw bytes in the barcode for these formats, it does not offer the bytes
|
||||
/// from the byte segments alone.</p>
|
||||
/// <p>This maps to a {@link java.util.List} of byte arrays corresponding to the
|
||||
/// raw bytes in the byte segments in the barcode, in order.</p>
|
||||
/// </summary>
|
||||
BYTE_SEGMENTS,
|
||||
|
||||
/// <summary>
|
||||
/// Error correction level used, if applicable. The value type depends on the
|
||||
/// format, but is typically a String.
|
||||
/// </summary>
|
||||
ERROR_CORRECTION_LEVEL,
|
||||
|
||||
/// <summary>
|
||||
/// For some periodicals, indicates the issue number as an {@link Integer}.
|
||||
/// </summary>
|
||||
ISSUE_NUMBER,
|
||||
|
||||
/// <summary>
|
||||
/// For some products, indicates the suggested retail price in the barcode as a
|
||||
/// formatted {@link String}.
|
||||
/// </summary>
|
||||
SUGGESTED_PRICE,
|
||||
|
||||
/// <summary>
|
||||
/// For some products, the possible country of manufacture as a {@link String} denoting the
|
||||
/// ISO country code. Some map to multiple possible countries, like "US/CA".
|
||||
/// </summary>
|
||||
POSSIBLE_COUNTRY,
|
||||
|
||||
/// <summary>
|
||||
/// For some products, the extension text
|
||||
/// </summary>
|
||||
UPC_EAN_EXTENSION,
|
||||
|
||||
/// <summary>
|
||||
/// If the code format supports structured append and
|
||||
/// the current scanned code is part of one then the
|
||||
/// sequence number is given with it.
|
||||
/// </summary>
|
||||
STRUCTURED_APPEND_SEQUENCE,
|
||||
|
||||
/// <summary>
|
||||
/// If the code format supports structured append and
|
||||
/// the current scanned code is part of one then the
|
||||
/// parity is given with it.
|
||||
/// </summary>
|
||||
STRUCTURED_APPEND_PARITY,
|
||||
|
||||
/// <summary>
|
||||
/// PDF417-specific metadata
|
||||
/// </summary>
|
||||
PDF417_EXTRA_METADATA,
|
||||
|
||||
/// <summary>
|
||||
/// Aztec-specific metadata
|
||||
/// </summary>
|
||||
AZTEC_EXTRA_METADATA);
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,206 @@
|
||||
{
|
||||
* Copyright 2008 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
|
||||
* Delphi Implementation by E. Spelt and K. Gossens
|
||||
}
|
||||
|
||||
unit ZXing.ResultPoint;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
ZXing.Common.Detector.MathUtils;
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// To mimic "garbage collection" (or ARC) with old-gen compilers we have to use
|
||||
/// interfaces. IResultPoint is the interface that maps TResultPoint which is now
|
||||
/// implemented as a TInterfacedObject descendant which supports automatic deallocation
|
||||
/// based on reference counting of interface variables.
|
||||
/// See ZXing.ResultPointImplementation to see the actual implementation of this interface.
|
||||
/// since we are using automatic reference counting, we don't need the Clone method any more.
|
||||
/// </summary>
|
||||
|
||||
IResultPoint = interface
|
||||
['{1E60EDAB-0387-440C-9D8E-4E0CC772C820}']
|
||||
// property accessors, for interfaces, MUST be functions or procedures (interfaces cannot contain data)
|
||||
procedure SetX(const AValue: Single);
|
||||
procedure SetY(const AValue: Single);
|
||||
function GetX: Single;
|
||||
function GetY: Single;
|
||||
|
||||
function Equals(other: TObject): Boolean;
|
||||
function GetHashCode(): Integer;
|
||||
function ToString(): String;
|
||||
|
||||
property x: Single read GetX write SetX;
|
||||
property y: Single read GetY write SetY;
|
||||
end;
|
||||
|
||||
/// <summary>
|
||||
/// in order to implement TResultPoint as an interface all static methods
|
||||
/// have been moved in this static class.
|
||||
/// this class contains also the CreateResultPoint method that must be used
|
||||
/// in place of the actual class constructor
|
||||
/// </summary>
|
||||
TResultPointHelpers = class
|
||||
protected
|
||||
/// <summary>
|
||||
/// Returns the z component of the cross product between vectors BC and BA.
|
||||
/// </summary>
|
||||
class function crossProductZ(const pointA, pointB, pointC: IResultPoint): Single; static;
|
||||
public
|
||||
/// <summary>
|
||||
/// Initializes a new instance of <see cref="TResultPoint"/> and returns
|
||||
/// its <see cref="IResultPoint"/> interface
|
||||
/// </summary>
|
||||
class function CreateResultPoint:IResultPoint; overload;
|
||||
/// <summary>
|
||||
/// Initializes a new instance of <see cref="TResultPoint"/> and returns
|
||||
/// its <see cref="IResultPoint"/> interface
|
||||
/// </summary>
|
||||
/// <param name="x">The x.</param>
|
||||
/// <param name="y">The y.</param>
|
||||
class function CreateResultPoint(const pX, pY: Single):IResultPoint; overload;
|
||||
/// <summary>
|
||||
/// Orders an array of three ResultPoints in an order [A,B,C] such that AB is less than AC and
|
||||
/// BC is less than AC and the angle between BC and BA is less than 180 degrees.
|
||||
/// </summary>
|
||||
/// <param name="patterns">array of three <see cref="IResultPoint" /> to order</param>
|
||||
class procedure orderBestPatterns(const patterns : TArray<IResultPoint>); static;
|
||||
/// <summary>
|
||||
/// calculates the distance between two points
|
||||
/// </summary>
|
||||
/// <param name="pattern1">first pattern</param>
|
||||
/// <param name="pattern2">second pattern</param>
|
||||
/// <returns>
|
||||
/// distance between two points
|
||||
/// </returns>
|
||||
class function distance(const pattern1, pattern2: IResultPoint) : Single; static;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
/// <summary> Callback which is invoked when a possible result point (significant
|
||||
/// point in the barcode image such as a corner) is found.
|
||||
///
|
||||
/// </summary>
|
||||
/// <seealso cref="TDecodeHintType.NEED_RESULT_POINT_CALLBACK">
|
||||
/// </seealso>
|
||||
TResultPointCallback = procedure(const point: IResultPoint) of object;
|
||||
|
||||
TResultPointEventObject = class(TObject)
|
||||
private
|
||||
FResultPointCallback: TResultPointCallback;
|
||||
public
|
||||
constructor Create(const AEvent: TResultPointCallback);
|
||||
|
||||
property Event: TResultPointCallback read FResultPointCallback;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses ZXing.ResultPointImplementation;
|
||||
|
||||
class function TResultPointHelpers.CreateResultPoint:IResultPoint;
|
||||
begin
|
||||
result := ZXing.ResultPointImplementation.NewResultPoint;
|
||||
end;
|
||||
|
||||
class function TResultPointHelpers.CreateResultPoint(const pX, pY: Single):IResultPoint;
|
||||
begin
|
||||
result := ZXing.ResultPointImplementation.NewResultPoint(px,py);
|
||||
end;
|
||||
|
||||
|
||||
class function TResultPointHelpers.crossProductZ(const pointA, pointB,
|
||||
pointC: IResultPoint): Single;
|
||||
var
|
||||
bX, bY: Single;
|
||||
begin
|
||||
bX := pointB.x;
|
||||
bY := pointB.y;
|
||||
Result := ((pointC.x - bX) * (pointA.y - bY)) -
|
||||
((pointC.y - bY) * (pointA.x - bX));
|
||||
end;
|
||||
|
||||
|
||||
class function TResultPointHelpers.distance(const pattern1,
|
||||
pattern2: IResultPoint): Single;
|
||||
begin
|
||||
Result := TMathUtils.distance(pattern1.x, pattern1.y, pattern2.x, pattern2.y);
|
||||
end;
|
||||
|
||||
|
||||
class procedure TResultPointHelpers.orderBestPatterns(const patterns
|
||||
: TArray<IResultPoint>);
|
||||
var
|
||||
zeroOneDistance, oneTwoDistance, zeroTwoDistance: Single;
|
||||
pointA, pointB, pointC, temp: IResultPoint;
|
||||
begin
|
||||
// Find distances between pattern centers
|
||||
zeroOneDistance := distance(patterns[0], patterns[1]);
|
||||
oneTwoDistance := distance(patterns[1], patterns[2]);
|
||||
zeroTwoDistance := distance(patterns[0], patterns[2]);
|
||||
|
||||
// Assume one closest to other two is B; A and C will just be guesses at first
|
||||
if ((oneTwoDistance >= zeroOneDistance) and
|
||||
(oneTwoDistance >= zeroTwoDistance)) then
|
||||
begin
|
||||
pointB := patterns[0];
|
||||
pointA := patterns[1];
|
||||
pointC := patterns[2];
|
||||
end
|
||||
else if ((zeroTwoDistance >= oneTwoDistance) and
|
||||
(zeroTwoDistance >= zeroOneDistance)) then
|
||||
begin
|
||||
pointB := patterns[1];
|
||||
pointA := patterns[0];
|
||||
pointC := patterns[2];
|
||||
end
|
||||
else
|
||||
begin
|
||||
pointB := patterns[2];
|
||||
pointA := patterns[0];
|
||||
pointC := patterns[1];
|
||||
end;
|
||||
|
||||
// Use cross product to figure out whether A and C are correct or flipped.
|
||||
// This asks whether BC x BA has a positive z component, which is the arrangement
|
||||
// we want for A, B, C. If it's negative, then we've got it flipped around and
|
||||
// should swap A and C.
|
||||
if (crossProductZ(pointA, pointB, pointC) < 0) then
|
||||
begin
|
||||
temp := pointA;
|
||||
pointA := pointC;
|
||||
pointC := temp;
|
||||
end;
|
||||
|
||||
patterns[0] := pointA;
|
||||
patterns[1] := pointB;
|
||||
patterns[2] := pointC;
|
||||
end;
|
||||
|
||||
|
||||
{ TResultPointEventObject }
|
||||
|
||||
constructor TResultPointEventObject.Create(const AEvent: TResultPointCallback);
|
||||
begin
|
||||
Self.FResultPointCallback := AEvent;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,168 @@
|
||||
unit ZXing.ResultPointImplementation;
|
||||
|
||||
interface
|
||||
uses system.SysUtils,
|
||||
ZXing.ResultPoint;
|
||||
|
||||
type
|
||||
/// <summary>
|
||||
/// Encapsulates a point of interest in an image containing a barcode. Typically, this
|
||||
/// would be the location of a finder pattern or the corner of the barcode, for example.
|
||||
/// this class is meant to be used only indirectly, via the IResultPoint reference-counted interface
|
||||
// it implements. It is exposed in the interface section just to allow the declaration of its derived classes
|
||||
/// </summary>
|
||||
TResultPoint = class(TInterfacedObject,IResultPoint)
|
||||
private type
|
||||
TSingleArray = array [0 .. Pred(SizeOf(Single))] of Byte;
|
||||
var
|
||||
Fx, Fy: Single;
|
||||
bytesX, bytesY: TSingleArray;
|
||||
FToString: String;
|
||||
procedure SetX(const AValue: Single);
|
||||
procedure SetY(const AValue: Single);
|
||||
function GetX: Single;
|
||||
function GetY: Single;
|
||||
public
|
||||
/// <summary>
|
||||
/// Initializes a new instance of the <see cref="TResultPoint"/> class.
|
||||
/// </summary>
|
||||
constructor Create; overload;
|
||||
/// <summary>
|
||||
/// Initializes a new instance of the <see cref="TResultPoint"/> class.
|
||||
/// </summary>
|
||||
/// <param name="x">The x.</param>
|
||||
/// <param name="y">The y.</param>
|
||||
constructor Create(const pX, pY: Single); overload;
|
||||
destructor Destroy; override;
|
||||
|
||||
/// <summary>
|
||||
/// Determines whether the specified <see cref="System.TObject"/> is equal to this instance.
|
||||
/// </summary>
|
||||
/// <param name="other">The <see cref="System.TObject"/> to compare with this instance.</param>
|
||||
/// <returns>
|
||||
/// <c>true</c> if the specified <see cref="System.TObject"/> is equal to this instance; otherwise, <c>false</c>.
|
||||
/// </returns>
|
||||
function Equals(other: TObject): Boolean; override;
|
||||
/// <summary>
|
||||
/// Returns a hash code for this instance.
|
||||
/// </summary>
|
||||
/// <returns>
|
||||
/// A hash code for this instance, suitable for use in hashing algorithms and data structures like a hash table.
|
||||
/// </returns>
|
||||
function GetHashCode(): Integer; override;
|
||||
/// <summary>
|
||||
/// Returns a <see cref="System.String"/> that represents this instance.
|
||||
/// </summary>
|
||||
/// <returns>
|
||||
/// A <see cref="System.String"/> that represents this instance.
|
||||
/// </returns>
|
||||
function ToString(): String; override;
|
||||
|
||||
property x: Single read GetX write SetX;
|
||||
property y: Single read GetY write SetY;
|
||||
end;
|
||||
|
||||
// these are the helping functions that actually create a new instance.
|
||||
// The actual constructor cannot be called outside of this unit
|
||||
function NewResultPoint:IResultPoint; overload;
|
||||
function NewResultPoint(const pX, pY: Single):IResultPoint; overload;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
function NewResultPoint:IResultPoint;
|
||||
begin
|
||||
result := TResultPoint.Create;
|
||||
end;
|
||||
|
||||
function NewResultPoint(const pX, pY: Single):IResultPoint;
|
||||
begin
|
||||
result := TResultPoint.Create(px,py);
|
||||
end;
|
||||
|
||||
|
||||
{ TResultPoint }
|
||||
|
||||
|
||||
constructor TResultPoint.Create;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
constructor TResultPoint.Create(const pX, pY: Single);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
Fx := pX;
|
||||
Fy := pY;
|
||||
bytesX := TSingleArray(pX);
|
||||
bytesY := TSingleArray(pY);
|
||||
end;
|
||||
|
||||
destructor TResultPoint.Destroy;
|
||||
var
|
||||
n: Single;
|
||||
begin
|
||||
n := 0;
|
||||
bytesX := TSingleArray(n);
|
||||
bytesY := TSingleArray(n);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TResultPoint.SetX(const AValue: Single);
|
||||
begin
|
||||
if (AValue <> Fx) then
|
||||
begin
|
||||
Fx := AValue;
|
||||
bytesX := TSingleArray(Fx);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TResultPoint.SetY(const AValue: Single);
|
||||
begin
|
||||
if (AValue <> Fy) then
|
||||
begin
|
||||
Fy := AValue;
|
||||
bytesY := TSingleArray(Fy);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TResultPoint.GetX: Single;
|
||||
begin
|
||||
result := Fx;
|
||||
end;
|
||||
|
||||
function TResultPoint.GetY: Single;
|
||||
begin
|
||||
result := Fy;
|
||||
end;
|
||||
|
||||
function TResultPoint.Equals(other: TObject): Boolean;
|
||||
var
|
||||
otherPoint: TResultPoint;
|
||||
begin
|
||||
otherPoint := other as TResultPoint;
|
||||
if (otherPoint = nil) then
|
||||
Result := false
|
||||
else
|
||||
Result := ((otherPoint.x = Fx) and (otherPoint.y = Fy));
|
||||
end;
|
||||
|
||||
function TResultPoint.GetHashCode: Integer;
|
||||
begin
|
||||
Result := 31 * ((bytesX[0] shl 24) + (bytesX[1] shl 16) + (bytesX[2] shl 8) +
|
||||
bytesX[3]) + (bytesY[0] shl 24) + (bytesY[1] shl 16) + (bytesY[2] shl 8) +
|
||||
bytesY[3];
|
||||
end;
|
||||
|
||||
|
||||
function TResultPoint.ToString: String;
|
||||
begin
|
||||
if (FToString = '') then
|
||||
FToString := Format('(%g),(%g)', [Fx, Fy]);
|
||||
Result := FToString;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,229 @@
|
||||
unit ZXing.StringUtils;
|
||||
|
||||
{
|
||||
* Copyright 2008 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.
|
||||
|
||||
* Implemented by E. Spelt for Delphi
|
||||
}
|
||||
interface
|
||||
|
||||
uses SysUtils, Generics.Collections, ZXing.DecodeHintType;
|
||||
|
||||
type
|
||||
|
||||
TStringUtils = class abstract
|
||||
const
|
||||
UTF8 = 'UTF-8';
|
||||
EUC_JP = 'EUC-JP';
|
||||
ISO88591 = 'ISO-8859-1';
|
||||
class procedure ClassInit;
|
||||
class var ASSUME_SHIFT_JIS: boolean;
|
||||
class var PLATFORM_DEFAULT_ENCODING: string;
|
||||
public
|
||||
class var GB2312: string;
|
||||
class var SHIFT_JIS: string;
|
||||
class function guessEncoding(bytes: TArray<Byte>;
|
||||
hints: TDictionary<TDecodeHintType, TObject>): string; static;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class procedure TStringUtils.ClassInit;
|
||||
begin
|
||||
PLATFORM_DEFAULT_ENCODING := 'ISO-8859-1'; // 'ISO 8859-15';
|
||||
SHIFT_JIS := 'SJIS';
|
||||
GB2312 := 'GB2312';
|
||||
|
||||
ASSUME_SHIFT_JIS := (string.Compare(TStringUtils.SHIFT_JIS,
|
||||
TStringUtils.PLATFORM_DEFAULT_ENCODING, true) = 0) or
|
||||
(string.Compare('EUC-JP', TStringUtils.PLATFORM_DEFAULT_ENCODING,
|
||||
true) = 0);
|
||||
|
||||
end;
|
||||
|
||||
class function TStringUtils.guessEncoding(bytes: TArray<Byte>;
|
||||
hints: TDictionary<TDecodeHintType, TObject>): string;
|
||||
|
||||
var
|
||||
characterSet: string;
|
||||
utf8BytesLeft, utf2BytesChars, utf3BytesChars, utf4BytesChars, sjisBytesLeft,
|
||||
sjisKatakanaChars, sjisCurKatakanaWordLength, sjisCurDoubleBytesWordLength,
|
||||
sjisMaxKatakanaWordLength, sjisMaxDoubleBytesWordLength, isoHighOther, len,
|
||||
i, value: Integer;
|
||||
utf8bom, canBeISO88591, canBeShiftJIS, canBeUTF8: boolean;
|
||||
|
||||
begin
|
||||
if ((hints <> nil) and hints.ContainsKey(ZXing.DecodeHintType.CHARACTER_SET)) then
|
||||
begin
|
||||
characterSet := string(hints[ZXing.DecodeHintType.CHARACTER_SET]);
|
||||
if (characterSet <> '') then
|
||||
begin
|
||||
Result := characterSet;
|
||||
exit
|
||||
end
|
||||
end;
|
||||
|
||||
len := length(bytes);
|
||||
canBeISO88591 := true;
|
||||
canBeShiftJIS := true;
|
||||
canBeUTF8 := true;
|
||||
utf8BytesLeft := 0;
|
||||
utf2BytesChars := 0;
|
||||
utf3BytesChars := 0;
|
||||
utf4BytesChars := 0;
|
||||
sjisBytesLeft := 0;
|
||||
sjisKatakanaChars := 0;
|
||||
sjisCurKatakanaWordLength := 0;
|
||||
sjisCurDoubleBytesWordLength := 0;
|
||||
sjisMaxKatakanaWordLength := 0;
|
||||
sjisMaxDoubleBytesWordLength := 0;
|
||||
isoHighOther := 0;
|
||||
|
||||
utf8bom := ((((length(bytes) > 3) and (bytes[0] = $EF)) and (bytes[1] = $BB))
|
||||
and (bytes[2] = $BF));
|
||||
|
||||
i := 0;
|
||||
while (((i < len) and ((canBeISO88591 or canBeShiftJIS) or canBeUTF8))) do
|
||||
begin
|
||||
value := (bytes[i] and $FF);
|
||||
if (canBeUTF8) then
|
||||
if (utf8BytesLeft > 0) then
|
||||
if ((value and $80) = 0) then
|
||||
canBeUTF8 := false
|
||||
else
|
||||
dec(utf8BytesLeft)
|
||||
else if ((value and $80) <> 0) then
|
||||
if ((value and $40) = 0) then
|
||||
canBeUTF8 := false
|
||||
else
|
||||
begin
|
||||
inc(utf8BytesLeft);
|
||||
if ((value and $20) = 0) then
|
||||
inc(utf2BytesChars)
|
||||
else
|
||||
begin
|
||||
inc(utf8BytesLeft);
|
||||
if ((value and $10) = 0) then
|
||||
inc(utf3BytesChars)
|
||||
else
|
||||
begin
|
||||
inc(utf8BytesLeft);
|
||||
if ((value and 8) = 0) then
|
||||
inc(utf4BytesChars)
|
||||
else
|
||||
canBeUTF8 := false
|
||||
end
|
||||
end
|
||||
end;
|
||||
|
||||
if (canBeISO88591) then
|
||||
if ((value > $7F) and (value < 160)) then
|
||||
canBeISO88591 := false
|
||||
else if ((value > $9F) and (((value < $C0) or (value = $D7)) or
|
||||
(value = $F7))) then
|
||||
inc(isoHighOther);
|
||||
|
||||
if (canBeShiftJIS) then
|
||||
if (sjisBytesLeft > 0) then
|
||||
if (((value < $40) or (value = $7F)) or (value > $FC)) then
|
||||
canBeShiftJIS := false
|
||||
else
|
||||
dec(sjisBytesLeft)
|
||||
else if (((value = $80) or (value = 160)) or (value > $EF)) then
|
||||
canBeShiftJIS := false
|
||||
else if ((value > 160) and (value < $E0)) then
|
||||
begin
|
||||
inc(sjisKatakanaChars);
|
||||
sjisCurDoubleBytesWordLength := 0;
|
||||
inc(sjisCurKatakanaWordLength);
|
||||
if (sjisCurKatakanaWordLength > sjisMaxKatakanaWordLength) then
|
||||
sjisMaxKatakanaWordLength := sjisCurKatakanaWordLength
|
||||
end
|
||||
else if (value > $7F) then
|
||||
begin
|
||||
inc(sjisBytesLeft);
|
||||
sjisCurKatakanaWordLength := 0;
|
||||
inc(sjisCurDoubleBytesWordLength);
|
||||
if (sjisCurDoubleBytesWordLength > sjisMaxDoubleBytesWordLength) then
|
||||
sjisMaxDoubleBytesWordLength := sjisCurDoubleBytesWordLength
|
||||
end
|
||||
else
|
||||
begin
|
||||
sjisCurKatakanaWordLength := 0;
|
||||
sjisCurDoubleBytesWordLength := 0
|
||||
end;
|
||||
inc(i)
|
||||
end;
|
||||
|
||||
if (canBeUTF8 and (utf8BytesLeft > 0)) then
|
||||
canBeUTF8 := false;
|
||||
|
||||
if (canBeShiftJIS and (sjisBytesLeft > 0)) then
|
||||
canBeShiftJIS := false;
|
||||
|
||||
if (canBeUTF8 and (utf8bom or (((utf2BytesChars + utf3BytesChars) +
|
||||
utf4BytesChars) > 0))) then
|
||||
begin
|
||||
Result := 'UTF-8';
|
||||
exit
|
||||
end;
|
||||
|
||||
if (canBeShiftJIS and ((TStringUtils.ASSUME_SHIFT_JIS or
|
||||
(sjisMaxKatakanaWordLength >= 3)) or (sjisMaxDoubleBytesWordLength >= 3)))
|
||||
then
|
||||
begin
|
||||
Result := TStringUtils.SHIFT_JIS;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (canBeISO88591 and canBeShiftJIS) then
|
||||
begin
|
||||
|
||||
if (((sjisMaxKatakanaWordLength = 2) and (sjisKatakanaChars = 2)) or
|
||||
((isoHighOther * 10) >= len)) then
|
||||
Result := TStringUtils.SHIFT_JIS
|
||||
else
|
||||
Result := 'ISO-8859-1';
|
||||
exit
|
||||
end;
|
||||
|
||||
if (canBeISO88591) then
|
||||
begin
|
||||
Result := 'ISO-8859-1';
|
||||
exit
|
||||
end;
|
||||
|
||||
if (canBeShiftJIS) then
|
||||
begin
|
||||
Result := TStringUtils.SHIFT_JIS;
|
||||
exit
|
||||
end;
|
||||
|
||||
if (canBeUTF8) then
|
||||
begin
|
||||
Result := 'UTF-8';
|
||||
exit
|
||||
end;
|
||||
|
||||
Result := TStringUtils.PLATFORM_DEFAULT_ENCODING;
|
||||
|
||||
end;
|
||||
|
||||
Initialization
|
||||
|
||||
TStringUtils.ClassInit;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user