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
2026-09-17 18:38:41 +01:00
parent 780eecc11b
commit dd9fd62dcb
81 changed files with 22141 additions and 19 deletions
+3
View File
@@ -31,6 +31,9 @@
BiometricPrompt n'existe pas encore. -->
<uses-permission android:name="android.permission.USE_BIOMETRIC" />
<uses-permission android:name="android.permission.USE_FINGERPRINT" />
<!-- Scanner du QR des reglages de synchro, demandee au premier appui. -->
<uses-permission android:name="android.permission.CAMERA" />
<uses-feature android:name="android.hardware.camera" android:required="false" />
<uses-feature android:glEsVersion="0x00020000" android:required="true"/>
<queries>
<%queries-child-elements%>
@@ -0,0 +1,696 @@
{
* 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
* Delphi Implementation by E. Spelt and K. Gossens
}
unit ZXing.OneD.Code128Reader;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
ZXing.Helpers,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat;
var
CODE_PATTERNS: TArray<TArray<Integer>>;
type
/// <summary>
/// <p>Decodes Code 128 barcodes.</p>
/// </summary>
TCode128Reader = class(TOneDReader)
private const
CODE_SHIFT = 98;
CODE_CODE_C = 99;
CODE_CODE_B = 100;
CODE_CODE_A = 101;
CODE_FNC_1 = 102;
CODE_FNC_2 = 97;
CODE_FNC_3 = 96;
CODE_FNC_4_A = 101;
CODE_FNC_4_B = 100;
CODE_START_A = 103;
CODE_START_B = 104;
CODE_START_C = 105;
CODE_STOP = 106;
class var MAX_AVG_VARIANCE: Integer;
class var MAX_INDIVIDUAL_VARIANCE: Integer;
class function FindStartPattern(row: IBitArray): TArray<Integer>;
class function DecodeCode(row: IBitArray; counters: TArray<Integer>;
rowOffset: Integer; var code: Integer): Boolean;
class procedure DoInitialize();
class procedure DoFinalize();
public
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
override;
end;
implementation
class procedure TCode128Reader.DoFinalize;
begin
CODE_PATTERNS := nil;
end;
class procedure TCode128Reader.DoInitialize;
begin
CODE_PATTERNS := [[2, 1, 2, 2, 2, 2], // 0
[2, 2, 2, 1, 2, 2], [2, 2, 2, 2, 2, 1], [1, 2, 1, 2, 2, 3],
[1, 2, 1, 3, 2, 2], [1, 3, 1, 2, 2, 2], // 5
[1, 2, 2, 2, 1, 3], [1, 2, 2, 3, 1, 2], [1, 3, 2, 2, 1, 2],
[2, 2, 1, 2, 1, 3], [2, 2, 1, 3, 1, 2], // 10
[2, 3, 1, 2, 1, 2], [1, 1, 2, 2, 3, 2], [1, 2, 2, 1, 3, 2],
[1, 2, 2, 2, 3, 1], [1, 1, 3, 2, 2, 2], // 15
[1, 2, 3, 1, 2, 2], [1, 2, 3, 2, 2, 1], [2, 2, 3, 2, 1, 1],
[2, 2, 1, 1, 3, 2], [2, 2, 1, 2, 3, 1], // 20
[2, 1, 3, 2, 1, 2], [2, 2, 3, 1, 1, 2], [3, 1, 2, 1, 3, 1],
[3, 1, 1, 2, 2, 2], [3, 2, 1, 1, 2, 2], // 25
[3, 2, 1, 2, 2, 1], [3, 1, 2, 2, 1, 2], [3, 2, 2, 1, 1, 2],
[3, 2, 2, 2, 1, 1], [2, 1, 2, 1, 2, 3], // 30
[2, 1, 2, 3, 2, 1], [2, 3, 2, 1, 2, 1], [1, 1, 1, 3, 2, 3],
[1, 3, 1, 1, 2, 3], [1, 3, 1, 3, 2, 1], // 35
[1, 1, 2, 3, 1, 3], [1, 3, 2, 1, 1, 3], [1, 3, 2, 3, 1, 1],
[2, 1, 1, 3, 1, 3], [2, 3, 1, 1, 1, 3], // 40
[2, 3, 1, 3, 1, 1], [1, 1, 2, 1, 3, 3], [1, 1, 2, 3, 3, 1],
[1, 3, 2, 1, 3, 1], [1, 1, 3, 1, 2, 3], // 45
[1, 1, 3, 3, 2, 1], [1, 3, 3, 1, 2, 1], [3, 1, 3, 1, 2, 1],
[2, 1, 1, 3, 3, 1], [2, 3, 1, 1, 3, 1], // 50
[2, 1, 3, 1, 1, 3], [2, 1, 3, 3, 1, 1], [2, 1, 3, 1, 3, 1],
[3, 1, 1, 1, 2, 3], [3, 1, 1, 3, 2, 1], // 55
[3, 3, 1, 1, 2, 1], [3, 1, 2, 1, 1, 3], [3, 1, 2, 3, 1, 1],
[3, 3, 2, 1, 1, 1], [3, 1, 4, 1, 1, 1], // 60
[2, 2, 1, 4, 1, 1], [4, 3, 1, 1, 1, 1], [1, 1, 1, 2, 2, 4],
[1, 1, 1, 4, 2, 2], [1, 2, 1, 1, 2, 4], // 65
[1, 2, 1, 4, 2, 1], [1, 4, 1, 1, 2, 2], [1, 4, 1, 2, 2, 1],
[1, 1, 2, 2, 1, 4], [1, 1, 2, 4, 1, 2], // 70
[1, 2, 2, 1, 1, 4], [1, 2, 2, 4, 1, 1], [1, 4, 2, 1, 1, 2],
[1, 4, 2, 2, 1, 1], [2, 4, 1, 2, 1, 1], // 75
[2, 2, 1, 1, 1, 4], [4, 1, 3, 1, 1, 1], [2, 4, 1, 1, 1, 2],
[1, 3, 4, 1, 1, 1], [1, 1, 1, 2, 4, 2], // 80
[1, 2, 1, 1, 4, 2], [1, 2, 1, 2, 4, 1], [1, 1, 4, 2, 1, 2],
[1, 2, 4, 1, 1, 2], [1, 2, 4, 2, 1, 1], // 85
[4, 1, 1, 2, 1, 2], [4, 2, 1, 1, 1, 2], [4, 2, 1, 2, 1, 1],
[2, 1, 2, 1, 4, 1], [2, 1, 4, 1, 2, 1], // 90
[4, 1, 2, 1, 2, 1], [1, 1, 1, 1, 4, 3], [1, 1, 1, 3, 4, 1],
[1, 3, 1, 1, 4, 1], [1, 1, 4, 1, 1, 3], // 95
[1, 1, 4, 3, 1, 1], [4, 1, 1, 1, 1, 3], [4, 1, 1, 3, 1, 1],
[1, 1, 3, 1, 4, 1], [1, 1, 4, 1, 3, 1], // 100
[3, 1, 1, 1, 4, 1], [4, 1, 1, 1, 3, 1], [2, 1, 1, 4, 1, 2],
[2, 1, 1, 2, 1, 4], [2, 1, 1, 2, 3, 2], // 105
[2, 3, 3, 1, 1, 1, 2]];
MAX_AVG_VARIANCE := Floor(PATTERN_MATCH_RESULT_SCALE_FACTOR * 0.25);
MAX_INDIVIDUAL_VARIANCE := Floor(PATTERN_MATCH_RESULT_SCALE_FACTOR * 0.7);
end;
class function TCode128Reader.FindStartPattern(row: IBitArray): TArray<Integer>;
var
i, bestMatch, startCode, bestVariance, width, rowOffset, patternStart,
patternLength, variance, counterPosition: Integer;
counters: TArray<Integer>;
isWhite: Boolean;
begin
width := row.Size;
rowOffset := row.getNextSet(0);
counterPosition := 0;
counters := TArray<Integer>.Create();
SetLength(counters, 6);
patternStart := rowOffset;
isWhite := false;
patternLength := Length(counters);
for i := rowOffset to width - 1 do
begin
if row[i] xor isWhite then
begin
inc(counters[counterPosition])
end
else
begin
if counterPosition = patternLength - 1 then
begin
bestVariance := MAX_AVG_VARIANCE;
bestMatch := -1;
startCode := CODE_START_A;
while startCode <= CODE_START_C do
begin
variance := patternMatchVariance(counters, CODE_PATTERNS[startCode],
MAX_INDIVIDUAL_VARIANCE);
if variance < bestVariance then
begin
bestVariance := variance;
bestMatch := startCode
end;
inc(startCode);
end;
if bestMatch >= 0 then
begin
// Look for whitespace before start pattern, >= 50% of width of start pattern
if row.isRange(Max(0, patternStart - (i - patternStart) div 2),
patternStart, false) then
begin
result := [patternStart, i, bestMatch];
exit;
end
end;
patternStart := patternStart + counters[0] + counters[1];
// Array.Copy(counters, 2, counters, 0, patternLength - 2);
// source, source index, dest, dest index, lengte
counters := TArray.CopyInSameArray(counters, 2, patternLength - 2);
counters[patternLength - 2] := 0;
counters[patternLength - 1] := 0;
dec(counterPosition);
end
else
begin
inc(counterPosition);
end;
counters[counterPosition] := 1;
isWhite := not isWhite
end;
end;
result := nil;
end;
class function TCode128Reader.DecodeCode(row: IBitArray;
counters: TArray<Integer>; rowOffset: Integer; var code: Integer): Boolean;
var
bestVariance, l, d, variance: Integer;
pattern: TArray<Integer>;
begin
code := -1;
if not recordPattern(row, rowOffset, counters) then
begin
result := false;
exit;
end;
bestVariance := MAX_AVG_VARIANCE;
// worst variance we'll accept
l := Length(CODE_PATTERNS) - 1;
for d := 0 to l do
begin
pattern := CODE_PATTERNS[d];
variance := patternMatchVariance(counters, pattern,
MAX_INDIVIDUAL_VARIANCE);
if variance < bestVariance then
begin
bestVariance := variance;
code := d
end;
end;
// TODO We're overlooking the fact that the STOP pattern has 7 values, not 6.
result := code >= 0;
end;
function TCode128Reader.decodeRow(const rowNumber: Integer;
const row: IBitArray; const hints: TDictionary<TDecodeHintType, TObject>)
: TReadResult;
var
shiftUpperMode, upperMode, lastCharacterWasPrintable, convertFNC1, done,
unshift, isNextShifted: Boolean;
counters, startPatternInfo: TArray<Integer>;
lastPatternSize, multiplier, checksumTotal, code, lastCode, nextStart,
lastStart, startCode, codeSet, l, rawCodesSize: Integer;
rawCodes: TList<Byte>;
rawBytes: TArray<Byte>;
aResult: String;
counter, resultLength, i: Integer;
left, right: Single;
resultPointCallback: TResultPointCallback;
obj: TObject;
resultPoints: TArray<IResultPoint>;
resultPointLeft, resultPointRight: IResultPoint;
begin
convertFNC1 := (hints <> nil) and
(hints.ContainsKey(ZXing.DecodeHintType.ASSUME_GS1));
startPatternInfo := FindStartPattern(row);
if (startPatternInfo = nil) then
begin
result := nil;
exit;
end;
startCode := startPatternInfo[2];
rawCodes := TList<Byte>.Create();
try
rawCodes.Add(Byte(startCode));
case startCode of
CODE_START_A:
begin
codeSet := CODE_CODE_A;
end;
CODE_START_B:
begin
codeSet := CODE_CODE_B;
end;
CODE_START_C:
begin
codeSet := CODE_CODE_C;
end
else
result := nil;
exit;
end;
done := false;
isNextShifted := false;
lastStart := startPatternInfo[0];
nextStart := startPatternInfo[1];
SetLength(counters, 6);
lastCode := 0;
code := 0;
checksumTotal := startCode;
multiplier := 0;
lastCharacterWasPrintable := true;
upperMode := false;
shiftUpperMode := false;
while not done do
begin
unshift := isNextShifted;
isNextShifted := false;
// Save off last code
lastCode := code;
// Decode another code from image
if not DecodeCode(row, counters, nextStart, code) then
begin
result := nil;
exit;
end;
rawCodes.Add(Byte(code));
// Remember whether the last code was printable or not (excluding CODE_STOP)
if code <> CODE_STOP then
begin
lastCharacterWasPrintable := true
end;
// Add to checksum computation (if not CODE_STOP of course)
if code <> CODE_STOP then
begin
inc(multiplier);
checksumTotal := checksumTotal + (multiplier * code);
end;
// Advance to where the next code will to start
lastStart := nextStart;
l := Length(counters) - 1;
for counter := 0 to l do
begin
nextStart := nextStart + counters[counter];
end;
// Take care of illegal start codes
case code of
CODE_START_A, CODE_START_B, CODE_START_C:
begin
result := nil;
exit;
end;
end;
case codeSet of
CODE_CODE_A:
begin
if code < 64 then
begin
if shiftUpperMode = upperMode then
begin
aResult := aResult + Char(32 + code);
end
else
begin
aResult := aResult + Char(32 + 128)
end;
shiftUpperMode := false
end
else if code < 96 then
begin
if shiftUpperMode = upperMode then
begin
aResult := aResult + Char(code - 64)
end
else
begin
aResult := aResult + Char(code + 64)
end;
shiftUpperMode := false
end
else
begin
// Don't let CODE_STOP, which always appears, affect whether whether we think the last
// code was printable or not.
if code <> CODE_STOP then
begin
lastCharacterWasPrintable := false
end;
case code of
CODE_FNC_1:
begin
if convertFNC1 then
begin
if Length(aResult) = 0 then
begin
// GS1 specification 5.4.3.7. and 5.4.6.4. If the first char after the start code
// is FNC1 then this is GS1-128. We add the symbology identifier.
aResult := aResult + ']C1'
end
else
begin
// GS1 specification 5.4.7.5. Every subsequent FNC1 is returned as ASCII 29 (GS)
aResult := aResult + Char(29)
end
end;
end;
CODE_FNC_2, CODE_FNC_3:
begin
// do nothing?
end;
CODE_FNC_4_A:
begin
if (not upperMode) and (shiftUpperMode) then
begin
upperMode := true;
shiftUpperMode := false
end
else if (upperMode) and (shiftUpperMode) then
begin
upperMode := false;
shiftUpperMode := false
end
else
begin
shiftUpperMode := true
end;
end;
CODE_SHIFT:
begin
isNextShifted := true;
codeSet := CODE_CODE_B;
end;
CODE_CODE_B:
begin
codeSet := CODE_CODE_B;
end;
CODE_CODE_C:
begin
codeSet := CODE_CODE_C;
end;
CODE_STOP:
begin
done := true;
end;
end
end;
end;
CODE_CODE_B:
begin
if code < 96 then
begin
if shiftUpperMode = upperMode then
begin
aResult := aResult + Char(32 + code)
end
else
begin
aResult := aResult + Char(32 + code + 128)
end;
shiftUpperMode := false
end
else
begin
if code <> CODE_STOP then
begin
lastCharacterWasPrintable := false
end;
case code of
CODE_FNC_1:
begin
if convertFNC1 then
begin
if Length(aResult) = 0 then
begin
// GS1 specification 5.4.3.7. and 5.4.6.4. If the first char after the start code
// is FNC1 then this is GS1-128. We add the symbology identifier.
aResult := aResult + (']C1')
end
else
begin
// GS1 specification 5.4.7.5. Every subsequent FNC1 is returned as ASCII 29 (GS)
aResult := aResult + Char(29)
end
end;
end;
CODE_FNC_2, CODE_FNC_3:
begin
// do nothing?
end;
CODE_FNC_4_B:
begin
if (not upperMode) and (shiftUpperMode) then
begin
upperMode := true;
shiftUpperMode := false
end
else if (upperMode) and (shiftUpperMode) then
begin
upperMode := false;
shiftUpperMode := false
end
else
begin
shiftUpperMode := true
end;
end;
CODE_SHIFT:
begin
isNextShifted := true;
codeSet := CODE_CODE_A;
end;
CODE_CODE_A:
begin
codeSet := CODE_CODE_A;
end;
CODE_CODE_C:
begin
codeSet := CODE_CODE_C;
end;
CODE_STOP:
begin
done := true;
end;
end
end;
end;
CODE_CODE_C:
begin
if code < 100 then
begin
if code < 10 then
begin
aResult := aResult + ('0')
end;
aResult := aResult + IntToStr(code);
end
else
begin
if code <> CODE_STOP then
begin
lastCharacterWasPrintable := false
end;
case code of
CODE_FNC_1:
begin
if convertFNC1 then
begin
if Length(aResult) = 0 then
begin
// GS1 specification 5.4.3.7. and 5.4.6.4. If the first char after the start code
// is FNC1 then this is GS1-128. We add the symbology identifier.
aResult := aResult + (']C1')
end
else
begin
// GS1 specification 5.4.7.5. Every subsequent FNC1 is returned as ASCII 29 (GS)
aResult := aResult + Char(29)
end
end;
end;
CODE_CODE_A:
begin
codeSet := CODE_CODE_A;
end;
CODE_CODE_B:
begin
codeSet := CODE_CODE_B;
end;
CODE_STOP:
begin
done := true;
end;
end
end;
end;
end;
// Unshift back to another code set if we were shifted
if (unshift) then
begin
if (codeSet = CODE_CODE_A) then
codeSet := CODE_CODE_B
else
codeSet := CODE_CODE_A;
end;
end;
lastPatternSize := nextStart - lastStart;
// Check for ample whitespace following pattern, but, to do this we first need to remember that
// we fudged decoding CODE_STOP since it actually has 7 bars, not 6. There is a black bar left
// to read off. Would be slightly better to properly read. Here we just skip it:
nextStart := row.getNextUnset(nextStart);
if not row.isRange(nextStart, System.Math.Min(row.Size,
nextStart + (nextStart - lastStart) div 2), false) then
begin
result := nil;
exit;
end;
// Pull out from sum the value of the penultimate check code
checksumTotal := checksumTotal - (multiplier * lastCode);
// lastCode is the checksum then:
if checksumTotal mod 103 <> lastCode then
begin
result := nil;
exit;
end;
// Need to pull out the check digits from string
resultLength := Length(aResult);
if resultLength = 0 then
begin
// false positive
result := nil;
exit;
end;
// Only bother if the result had at least one character, and if the checksum digit happened to
// be a printable character. If it was just interpreted as a control code, nothing to remove.
if (resultLength > 0) and (lastCharacterWasPrintable) then
begin
if codeSet = CODE_CODE_C then
begin
aResult := aResult.Remove(resultLength - 2, 2);
end
else
begin
aResult := aResult.Remove(resultLength - 1, 1);
end
end;
left := (startPatternInfo[1] + startPatternInfo[0]) / 2;
right := lastStart + lastPatternSize / 2;
rawCodesSize := rawCodes.Count;
SetLength(rawBytes, rawCodesSize);
for i := 0 to rawCodesSize - 1 do
rawBytes[i] := rawCodes[i];
resultPointLeft := TResultPointHelpers.CreateResultPoint(left, rowNumber);
resultPointRight := TResultPointHelpers.CreateResultPoint(right, rowNumber);
resultPoints := [resultPointLeft, resultPointRight];
resultPointCallback := nil;
// had to add this initialization because the following if/else construct does not assign a value
// for all possible cases. Being resultPointCallback a local variable it is not initialized by default to null,
// so you could get unpredictable results
if ((hints = nil) or
(not hints.ContainsKey(TDecodeHintType.NEED_RESULT_POINT_CALLBACK))) then
resultPointCallback := nil
else
begin
obj := hints[TDecodeHintType.NEED_RESULT_POINT_CALLBACK];
if (obj is TResultPointEventObject) then
resultPointCallback := TResultPointEventObject(obj).Event;
end;
if Assigned(resultPointCallback) then
begin
resultPointCallback(resultPointLeft);
resultPointCallback(resultPointRight);
end;
finally
FreeAndNil(rawCodes);
end;
result := TReadResult.Create(aResult, rawBytes, resultPoints,
TBarcodeFormat.CODE_128);
end;
initialization
TCode128Reader.DoInitialize;
finalization
TCode128Reader.DoFinalize;
end.
@@ -0,0 +1,471 @@
unit ZXing.OneD.Code39Reader;
{
* 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
* Implemented by Nano103 and E. Spelt for Delphi
}
interface
uses
System.SysUtils,
System.Generics.Collections,
Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat,
ZXing.Common.Detector.MathUtils;
type
TCode39Reader = class sealed(TOneDReader)
private
class var ALPHABET: TArray<Char>;
class function decodeExtended(encoded: string): string; static;
function findAsteriskPattern(row: IBitArray): TArray<Integer>;
class function patternToChar(pattern: Integer; var c: Char)
: boolean; static;
class function toNarrowWidePattern(counters: TArray<Integer>)
: Integer; static;
const
ALPHABET_STRING: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. *$/+%';
class var ASTERISK_ENCODING: Integer;
class var
CHARACTER_ENCODINGS: TArray<Integer>;
counters: TArray<Integer>;
decodeRowResult: TStringBuilder;
usingCheckDigit: boolean;
extendedMode: boolean;
public
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
override;
constructor Create(AUsingCheckDigit, AExtendedMode: boolean);
destructor Destroy(); override;
end;
implementation
{ Code93Reader }
constructor TCode39Reader.Create(AUsingCheckDigit, AExtendedMode: boolean);
begin
ALPHABET := ALPHABET_STRING.ToCharArray;
CHARACTER_ENCODINGS := TArray<Integer>.Create($034, $121, $061, $160, $031,
$130, $070, $025, $124, $064, // 0-9
$109, $049, $148, $019, $118, $058, $00D, $10C, $04C, $01C, // A-J
$103, $043, $142, $013, $112, $052, $007, $106, $046, $016, // K-T
$181, $0C1, $1C0, $091, $190, $0D0, $085, $184, $0C4, $094, // U-*
$0A8, $0A2, $08A, $02A // $-%
);
ASTERISK_ENCODING := TCode39Reader.CHARACTER_ENCODINGS[$27];
counters := TArray<Integer>.Create();
SetLength(counters, 9);
decodeRowResult := TStringBuilder.Create();
usingCheckDigit := AUsingCheckDigit;
extendedMode := AExtendedMode;
end;
destructor TCode39Reader.Destroy;
begin
ALPHABET := nil;
CHARACTER_ENCODINGS := nil;
counters := nil;
FreeAndNil(decodeRowResult);
inherited;
end;
class function TCode39Reader.decodeExtended(encoded: string): string;
var
next, c, decodedChar: Char;
length, i: Integer;
decoded: TStringBuilder;
begin
length := encoded.length;
decoded := TStringBuilder.Create(length);
try
i := 0;
while i < length do
begin
c := encoded.Chars[i];
if (((c = '+') or (c = '$')) or ((c = '%') or (c = '/'))) then
begin
if ((i + 1) >= encoded.length) then
begin
Result := '';
exit
end;
next := encoded.Chars[(i + 1)];
decodedChar := Char(#0);
case c of
'+':
begin
if ((next >= 'A') and (next <= 'Z')) then
begin
decodedChar := Char(ord(next) + 32);
end
else
begin
exit('');
end
end;
'$':
begin
if ((next >= 'A') and (next <= 'Z')) then
begin
decodedChar := Char(ord(next) - 64);
end
else
begin
exit('');
end
end;
'%':
begin
if ((next >= 'A') and (next <= 'E')) then
decodedChar := Char(ord(next) - 38)
else if ((next >= 'F') and (next <= 'W')) then
decodedChar := Char(ord(next) - 11)
else
begin
exit('');
end;
end;
'/':
begin
if ((next >= 'A') and (next <= 'O')) then
begin
decodedChar := Char(ord(next) - 32);
end
else if (next = 'Z') then
begin
decodedChar := ':';
end
else
exit('');
end;
end;
decoded.Append(decodedChar);
Inc(i);
end
else
decoded.Append(c);
Inc(i);
end; // end loop/while
Result := decoded.ToString;
finally
decoded.Free;
end;
end;
function TCode39Reader.decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
decodedChar: Char;
lastStart: Integer;
index, nextStart, counter, aEnd, pattern, lastPatternSize: Integer;
start: TArray<Integer>;
resultString: String;
Left, Right: Single;
resultPoints: TArray<IResultPoint>;
resultPointLeft, resultPointRight: IResultPoint;
whiteSpaceAfterEnd: Integer;
i, max, total: Integer;
begin
for index := 0 to length(counters) - 1 do
begin
counters[index] := 0;
end;
decodeRowResult.length := 0;
start := self.findAsteriskPattern(row);
if (start = nil) then
begin
Result := nil;
exit
end;
nextStart := row.getNextSet(start[1]);
aEnd := row.Size;
repeat
if (not TOneDReader.recordPattern(row, nextStart, self.counters)) then
begin
Result := nil;
exit
end;
pattern := TCode39Reader.toNarrowWidePattern(self.counters);
if (pattern < 0) then
begin
Result := nil;
exit
end;
if (not TCode39Reader.patternToChar(pattern, decodedChar)) then
begin
Result := nil;
exit
end;
self.decodeRowResult.Append(decodedChar);
lastStart := nextStart;
for counter in self.counters do
begin
Inc(nextStart, counter)
end;
nextStart := row.getNextSet(nextStart)
until (decodedChar = '*');
self.decodeRowResult.Remove((self.decodeRowResult.length - 1), 1);
lastPatternSize := 0;
for counter in self.counters do
begin
Inc(lastPatternSize, counter)
end;
whiteSpaceAfterEnd := nextStart - lastStart - lastPatternSize;
if (nextStart <> aEnd) and ((whiteSpaceAfterEnd shl 1) < lastPatternSize) then
begin
Result := nil;
exit
end;
if (usingCheckDigit) then
begin
max := self.decodeRowResult.length - 1;
total := 0;
for i := 0 to max - 1 do
begin
Inc(total, ALPHABET_STRING.indexOf(decodeRowResult.Chars[i]));
end;
if (self.decodeRowResult.Chars[max] <> ALPHABET_STRING[total mod 43]) then
begin
Result := nil;
exit
end;
self.decodeRowResult.Remove(max, self.decodeRowResult.length);
end;
if (self.decodeRowResult.length = 0) then
begin
Result := nil;
exit
end;
if extendedMode then
resultString := TCode39Reader.decodeExtended
(self.decodeRowResult.ToString())
else
resultString := decodeRowResult.ToString();
if (resultString = '') then
begin
Result := nil;
exit
end;
Left := (start[1] + start[0]) / 2;
Right := lastStart + (lastPatternSize / 2);
resultPointLeft := TResultPointHelpers.CreateResultPoint(Left, rowNumber);
resultPointRight := TResultPointHelpers.CreateResultPoint(Right, rowNumber);
resultPoints := [resultPointLeft, resultPointRight];
Result := TReadResult.Create(resultString, nil, resultPoints,
TBarcodeFormat.CODE_39);
end;
function TCode39Reader.findAsteriskPattern(row: IBitArray): TArray<Integer>;
var
i, l, patternStart, patternLength, width, counterPosition, rowOffset,
index: Integer;
isWhite: boolean;
begin
width := row.Size;
rowOffset := row.getNextSet(0);
index := 0;
while (index < length(self.counters)) do
begin
self.counters[index] := 0;
Inc(index)
end;
counterPosition := 0;
patternStart := rowOffset;
isWhite := False;
patternLength := length(counters);
for i := rowOffset to width - 1 do
begin
if (row[i] xor isWhite) then
begin
Inc(counters[counterPosition])
end
else
begin
if (counterPosition = (patternLength - 1)) then
begin
if (TCode39Reader.toNarrowWidePattern(counters)
= TCode39Reader.ASTERISK_ENCODING) then
begin
Result := TArray<Integer>.Create(patternStart, i);
exit
end;
Inc(patternStart, (counters[0] + counters[1]));
for l := 2 to patternLength - 2 do
begin
counters[l - 2] := counters[l];
end;
counters[(patternLength - 2)] := 0;
counters[(patternLength - 1)] := 0;
dec(counterPosition)
end
else
Inc(counterPosition);
counters[counterPosition] := 1;
isWhite := not isWhite
end;
end;
Result := nil;
end;
class function TCode39Reader.patternToChar(pattern: Integer;
var c: Char): boolean;
var
i: Integer;
begin
i := 0;
while (i < length(TCode39Reader.CHARACTER_ENCODINGS)) do
begin
if (TCode39Reader.CHARACTER_ENCODINGS[i] = pattern) then
begin
c := TCode39Reader.ALPHABET[i];
begin
Result := true;
exit
end
end;
Inc(i)
end;
c := '*';
Result := False;
end;
class function TCode39Reader.toNarrowWidePattern
(counters: TArray<Integer>): Integer;
var
numCounters: Integer;
maxNarrowCounter: Integer;
wideCounters: Integer;
minCounter: Integer;
counter: Integer;
totalWideCountersWidth: Integer;
pattern: Integer;
i: Integer;
begin
numCounters := length(counters);
maxNarrowCounter := 0;
repeat
minCounter := High(Integer);
for counter in counters do
begin
if (counter < minCounter) and (counter > maxNarrowCounter) then
minCounter := counter;
end;
maxNarrowCounter := minCounter;
wideCounters := 0;
totalWideCountersWidth := 0;
pattern := 0;
for i := 0 to numCounters - 1 do
begin
counter := counters[i];
if (counter > maxNarrowCounter) then
begin
pattern := pattern or (1 shl (numCounters - 1 - i));
Inc(wideCounters);
Inc(totalWideCountersWidth, counter);
end;
end;
if (wideCounters = 3) then
begin
// Found 3 wide counters, but are they close enough in width?
// We can perform a cheap, conservative check to see if any individual
// counter is more than 1.5 times the average:
i := 0;
while (i < numCounters) and (wideCounters > 0) do
begin
counter := counters[i];
if (counter > maxNarrowCounter) then
begin
dec(wideCounters);
// totalWideCountersWidth = 3 * average, so this checks if counter >= 3/2 * average
if ((counter * 2) >= totalWideCountersWidth) then
begin
Result := -1;
exit;
end;
end;
Inc(i);
end;
Result := pattern;
exit;
end;
until (wideCounters <= 3);
Result := -1;
end;
end.
@@ -0,0 +1,523 @@
{
* Copyright 2010 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
* Delphi Implementation by E. Spelt and K. Gossens
}
unit ZXing.OneD.Code93Reader;
interface
uses
System.SysUtils,
System.Generics.Collections,
Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat,
ZXing.Common.Detector.MathUtils;
type
/// <summary>
/// <p>Decodes Code 93 barcodes.</p>
/// <see cref="TCode39Reader" />
/// </summary>
TCode93Reader = class sealed(TOneDReader)
private
class var ALPHABET: TArray<Char>;
class function checkChecksums(pResult: TStringBuilder): boolean; static;
class function checkOneChecksum(pResult: TStringBuilder;
checkPosition, weightMax: Integer): boolean;
class function decodeExtended(encoded: TStringBuilder): string; static;
function findAsteriskPattern(row: IBitArray): TArray<Integer>;
class function patternToChar(pattern: Integer; var c: Char)
: boolean; static;
class function toPattern(counters: TArray<Integer>): Integer; static;
const
ALPHABET_STRING
: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%abcd*';
class var ASTERISK_ENCODING: Integer;
class var
CHARACTER_ENCODINGS: TArray<Integer>;
counters: TArray<Integer>;
decodeRowResult: TStringBuilder;
public
constructor Create;
destructor Destroy; override;
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
override;
end;
implementation
{ Code93Reader }
constructor TCode93Reader.Create;
begin
ALPHABET := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%abcd*'.ToCharArray;
CHARACTER_ENCODINGS := TArray<Integer>.Create($114, $148, $144, $142, $128,
$124, 290, $150, $112, $10A, $1A8, 420, $1A2, $194, $192, $18A, 360, $164,
$162, $134, $11A, $158, $14C, $146, 300, $116, $1B4, $1B2, $1AC, $1A6, $196,
410, $16C, $166, 310, $13A, $12E, $1D4, $1D2, $1CA, $16E, $176, 430, $126,
$1DA, 470, $132, 350);
ASTERISK_ENCODING := TCode93Reader.CHARACTER_ENCODINGS[$2F];
counters := TArray<Integer>.Create();
SetLength(counters, 6);
decodeRowResult := TStringBuilder.Create();
end;
destructor TCode93Reader.Destroy;
begin
ALPHABET := nil;
CHARACTER_ENCODINGS := nil;
counters := nil;
FreeAndNil(decodeRowResult);
inherited;
end;
class function TCode93Reader.checkChecksums(pResult: TStringBuilder): boolean;
var
length: Integer;
begin
length := pResult.length;
if (not TCode93Reader.checkOneChecksum(pResult, (length - 2), 20)) then
begin
Result := false;
exit
end;
if (not TCode93Reader.checkOneChecksum(pResult, (length - 1), 15)) then
begin
Result := false;
exit
end;
begin
Result := true;
exit
end
end;
class function TCode93Reader.checkOneChecksum(pResult: TStringBuilder;
checkPosition, weightMax: Integer): boolean;
var
weight, total, i: Integer;
begin
weight := 1;
total := 0;
i := (checkPosition - 1);
while ((i >= 0)) do
begin
inc(total, (weight * ALPHABET_STRING.IndexOf(pResult.Chars[i])));
inc(weight);
if (weight > weightMax) then
weight := 1;
dec(i)
end;
if (pResult.Chars[checkPosition] <> TCode93Reader.ALPHABET[(total mod $2F)])
then
begin
Result := false;
exit
end;
begin
Result := true;
exit
end
end;
class function TCode93Reader.decodeExtended(encoded: TStringBuilder): string;
var
next, c: Char;
decodedChar: Char;
length, i: Integer;
decoded: TStringBuilder;
label Label_0179, Label_0169, Label_014A;
begin
length := encoded.length;
decoded := TStringBuilder.Create(length);
try
i := 0;
next := Char(0);
while ((i < length)) do
begin
c := encoded.Chars[i];
if ((c < 'a') or (c > 'd')) then
goto Label_0179;
if (i < (length - 1)) then
begin
next := encoded.Chars[(i + 1)];
decodedChar := #0;
case c of
'a':
begin
if ((next < 'A') or (next > 'Z')) then
begin
Result := '';
exit
end;
decodedChar := Char(ord(next) - ord('@'));
goto Label_0169
end;
'b':
begin
if ((next < 'A') or (next > 'E')) then
break;;
decodedChar := Char(ord(next) - ord('&'));
goto Label_0169
end;
'c':
begin
if ((next < 'A') or (next > 'O')) then
goto Label_014A;
decodedChar := Char(ord(next) - ord(' '));
goto Label_0169
end;
'd':
begin
if ((next < 'A') or (next > 'Z')) then
begin
Result := '';
exit
end;
decodedChar := Char(ord(next) + ord(' '));
goto Label_0169
end;
else
begin
goto Label_0169
end;
end;
if ((next >= 'F') and (next <= 'W')) then
begin
decodedChar := Char(ord(next) - ord(' '));
goto Label_0169
end
end;
begin
Result := '';
exit
end;
Label_014A:
if (next = 'Z') then
decodedChar := ':'
else
begin
Result := '';
exit
end;
Label_0169:
decoded.Append(decodedChar);
inc(i);
continue;
Label_0179:
decoded.Append(c);
inc(i)
end;
Result := decoded.ToString;
finally
FreeAndNil(decoded);
end;
end;
function TCode93Reader.decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
decodedChar: Char;
lastStart: Integer;
index, nextStart, counter, aEnd, pattern, lastPatternSize: Integer;
start: TArray<Integer>;
resultString: String;
Left, Right: Single;
resultPointCallback: TResultPointCallback;
obj: TObject;
resultPoints: TArray<IResultPoint>;
resultPointLeft, resultPointRight: IResultPoint;
begin
for index := 0 to length(counters) - 1 do
counters[index] := 0;
decodeRowResult.length := 0;
start := self.findAsteriskPattern(row);
if (start = nil) then
begin
Result := nil;
exit
end;
nextStart := row.getNextSet(start[1]);
aEnd := row.Size;
repeat
if (not TOneDReader.recordPattern(row, nextStart, self.counters)) then
begin
Result := nil;
exit
end;
pattern := TCode93Reader.toPattern(self.counters);
if (pattern < 0) then
begin
Result := nil;
exit
end;
if (not TCode93Reader.patternToChar(pattern, decodedChar)) then
begin
Result := nil;
exit
end;
self.decodeRowResult.Append(decodedChar);
lastStart := nextStart;
for counter in self.counters do
begin
inc(nextStart, counter)
end;
nextStart := row.getNextSet(nextStart)
until (decodedChar = '*');
self.decodeRowResult.Remove((self.decodeRowResult.length - 1), 1);
lastPatternSize := 0;
for counter in self.counters do
begin
inc(lastPatternSize, counter)
end;
if (not((nextStart <> aEnd) and row[nextStart])) then
begin
Result := nil;
exit
end;
if (self.decodeRowResult.length < 2) then
begin
Result := nil;
exit
end;
if (not TCode93Reader.checkChecksums(self.decodeRowResult)) then
begin
Result := nil;
exit
end;
self.decodeRowResult.length := self.decodeRowResult.length - 2;
resultString := TCode93Reader.decodeExtended(self.decodeRowResult);
if (resultString = '') then
begin
Result := nil;
exit
end;
Left := (start[1] + start[0]) div 2;
Right := (lastStart + lastPatternSize) / 2;
resultPointLeft := TResultPointHelpers.CreateResultPoint(Left, rowNumber);
resultPointRight := TResultPointHelpers.CreateResultPoint(Right, rowNumber);
resultPoints := [resultPointLeft, resultPointRight];
resultPointCallback := nil;
// it is a local variable: it doesn't get NIL as default value, and the following ifs do not assign a value for all possible cases
if ((hints = nil) or
(not hints.ContainsKey(TDecodeHintType.NEED_RESULT_POINT_CALLBACK))) then
resultPointCallback := nil
else
begin
obj := hints[TDecodeHintType.NEED_RESULT_POINT_CALLBACK];
if (obj is TResultPointEventObject) then
resultPointCallback := TResultPointEventObject(obj).Event;
end;
if Assigned(resultPointCallback) then
begin
resultPointCallback(resultPointLeft);
resultPointCallback(resultPointRight);
end;
Result := TReadResult.Create(resultString, nil, resultPoints,
TBarcodeFormat.CODE_93);
end;
function TCode93Reader.findAsteriskPattern(row: IBitArray): TArray<Integer>;
var
i, l, patternStart, patternLength, width, counterPosition, rowOffset,
index: Integer;
isWhite: boolean;
begin
width := row.Size;
rowOffset := row.getNextSet(0);
index := 0;
while (index < length(self.counters)) do
begin
self.counters[index] := 0;
inc(index)
end;
counterPosition := 0;
patternStart := rowOffset;
isWhite := false;
patternLength := length(counters);
for i := rowOffset to width - 1 do
begin
if (row[i] xor isWhite) then
begin
inc(counters[counterPosition])
end
else
begin
if (counterPosition = (patternLength - 1)) then
begin
if (TCode93Reader.toPattern(counters) = TCode93Reader.ASTERISK_ENCODING)
then
begin
Result := TArray<Integer>.Create(patternStart, i);
exit
end;
inc(patternStart, (counters[0] + counters[1]));
for l := 2 to patternLength - 2 do
begin
counters[l - 2] := counters[l];
end;
counters[(patternLength - 2)] := 0;
counters[(patternLength - 1)] := 0;
dec(counterPosition)
end
else
inc(counterPosition);
counters[counterPosition] := 1;
isWhite := not isWhite
end;
end;
Result := nil;
end;
class function TCode93Reader.patternToChar(pattern: Integer;
var c: Char): boolean;
var
i: Integer;
begin
i := 0;
while (i < length(TCode93Reader.CHARACTER_ENCODINGS)) do
begin
if (TCode93Reader.CHARACTER_ENCODINGS[i] = pattern) then
begin
c := TCode93Reader.ALPHABET[i];
begin
Result := true;
exit
end
end;
inc(i)
end;
c := '*';
Result := false;
end;
class function TCode93Reader.toPattern(counters: TArray<Integer>): Integer;
var
counter, max, sum, pattern, i, j, scaledShifted, scaledUnshifted: Integer;
begin
max := length(counters);
sum := 0;
for counter in counters do
begin
inc(sum, counter)
end;
pattern := 0;
i := 0;
while ((i < max)) do
begin
scaledShifted := (((counters[i] shl TOneDReader.INTEGER_MATH_SHIFT) *
9) div sum);
scaledUnshifted := TMathUtils.Asr(scaledShifted,
TOneDReader.INTEGER_MATH_SHIFT);
if ((scaledShifted and $FF) > $7F) then
inc(scaledUnshifted);
if ((scaledUnshifted < 1) or (scaledUnshifted > 4)) then
begin
Result := -1;
exit
end;
if ((i and 1) = 0) then
begin
j := 0;
while ((j < scaledUnshifted)) do
begin
pattern := ((pattern shl 1) or 1);
inc(j)
end
end
else
pattern := (pattern shl scaledUnshifted);
inc(i)
end;
Result := pattern;
end;
end.
@@ -0,0 +1,219 @@
{
* 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: dswitkin@google.com (Daniel Switkin), Sean Owen and
* alasdair@google.com (Alasdair Mackintosh)
* Delphi Implementation by K. Gossens, E. Spelt
}
unit ZXing.OneD.EAN13Reader;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.OneD.UPCEANReader,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat;
type
/// <summary>
/// <p>Implements decoding of the EAN-13 format.</p>
/// </summary>
TEAN13Reader = class(TUPCEANReader)
private
// For an EAN-13 barcode, the first digit is represented by the parities used
// to encode the next six digits, according to the table below. For example,
// if the barcode is 5 123456 789012 then the value of the first digit is
// signified by using odd for '1', even for '2', even for '3', odd for '4',
// odd for '5', and even for '6'. See http://en.wikipedia.org/wiki/EAN-13
//
// Parity of next 6 digits
// Digit 0 1 2 3 4 5
// 0 Odd Odd Odd Odd Odd Odd
// 1 Odd Odd Even Odd Even Even
// 2 Odd Odd Even Even Odd Even
// 3 Odd Odd Even Even Even Odd
// 4 Odd Even Odd Odd Even Even
// 5 Odd Even Even Odd Odd Even
// 6 Odd Even Even Even Odd Odd
// 7 Odd Even Odd Even Odd Even
// 8 Odd Even Odd Even Even Odd
// 9 Odd Even Even Odd Even Odd
//
// Note that the encoding for '0' uses the same parity as a UPC barcode. Hence
// a UPC barcode can be converted to an EAN-13 barcode by prepending a 0.
//
// The encoding is represented by the following array, which is a bit pattern
// using Odd = 0 and Even = 1. For example, 5 is represented by:
//
// Odd Even Even Odd Odd Even
// in binary:
// 0 1 1 0 0 1 == 0x19
//
class var
FIRST_DIGIT_ENCODINGS: TArray<Integer>;
decodeMiddleCounters: TArray<Integer>;
/// <summary>
/// Based on pattern of odd-even ('L' and 'G') patterns used to encoded the explicitly-encoded
/// digits in a barcode, determines the implicitly encoded first digit and adds it to the
/// result string.
/// </summary>
/// <param name="resultString">string to insert decoded first digit into</param>
/// <param name="lgPatternFound">int whose bits indicates the pattern of odd/even L/G patterns used to</param>
/// encode digits
/// <return>-1 if first digit cannot be determined</return>
class function determineFirstDigit(const resultString: TStringBuilder;
const lgPatternFound: Integer): Boolean; static;
class procedure InitializeClass; static;
class procedure FinalizeClass; static;
protected
public
/// <summary>
/// Subclasses override this to decode the portion of a barcode between the start
/// and end guard patterns.
/// </summary>
/// <param name="row">row of black/white values to search</param>
/// <param name="startRange">start/end offset of start guard pattern</param>
/// <param name="resultString"><see cref="StringBuilder"/>to append decoded chars to</param>
/// <returns>
/// horizontal offset of first pixel after the "middle" that was decoded or -1 if decoding could not complete successfully
/// </returns>
class function DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const resultString: TStringBuilder)
: Integer; override;
/// <summary>
/// Get the format of this decoder.
/// <returns>The 1D format.</returns>
/// </summary>
function BarcodeFormat: TBarcodeFormat; override;
end;
implementation
{ TEAN13Reader }
class function TEAN13Reader.DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>;
const resultString: TStringBuilder): Integer;
var
bestMatch: Integer;
counter: Integer;
ending: Integer;
counters, middleRange: TArray<Integer>;
rowOffset, x, lgPatternFound: Integer;
begin
Result := -1;
counters := decodeMiddleCounters;
counters[0] := 0;
counters[1] := 0;
counters[2] := 0;
counters[3] := 0;
ending := row.Size;
rowOffset := startRange[1];
lgPatternFound := 0;
x := 0;
while ((x < 6) and (rowOffset < ending)) do
begin
if (not decodeDigit(row, counters, rowOffset, L_AND_G_PATTERNS, bestMatch))
then
exit;
resultString.Append( IntToStr ( bestMatch mod 10) );
for counter in counters do
Inc(rowOffset, counter);
if (bestMatch >= 10) then
lgPatternFound := lgPatternFound or (1 shl (5 - x));
Inc(x);
end;
if (not determineFirstDigit(resultString, lgPatternFound)) then
exit;
middleRange := findGuardPattern(row, rowOffset, true, MIDDLE_PATTERN);
if (middleRange = nil) then
exit;
rowOffset := middleRange[1];
x := 0;
while ((x < 6) and (rowOffset < ending)) do
begin
if (not decodeDigit(row, counters, rowOffset, L_PATTERNS, bestMatch)) then
exit;
resultString.Append(IntToStr(bestMatch));
for counter in counters do
Inc(rowOffset, counter);
Inc(x);
end;
Result := rowOffset;
end;
function TEAN13Reader.BarcodeFormat: TBarcodeFormat;
begin
Result := TBarcodeFormat.EAN_13;
end;
class function TEAN13Reader.determineFirstDigit(const resultString
: TStringBuilder; const lgPatternFound: Integer): Boolean;
var
d: Integer;
begin
Result := false;
for d := 0 to Pred(10) do
begin
if (lgPatternFound = FIRST_DIGIT_ENCODINGS[d]) then
begin
resultString.Insert(0, IntToStr(d));
Result := true;
break;
end;
end;
end;
class procedure TEAN13Reader.InitializeClass;
begin
FIRST_DIGIT_ENCODINGS := TArray<Integer>.Create($00, $0B, $0D, $0E, $13, $19,
$1C, $15, $16, $1A);
SetLength(decodeMiddleCounters, 4);
end;
class procedure TEAN13Reader.FinalizeClass;
begin
FIRST_DIGIT_ENCODINGS := nil;
decodeMiddleCounters := nil;
end;
initialization
TEAN13Reader.InitializeClass;
finalization
TEAN13Reader.FinalizeClass;
end.
@@ -0,0 +1,148 @@
{
* 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: dswitkin@google.com (Daniel Switkin), Sean Owen and
* alasdair@google.com (Alasdair Mackintosh)
*
* Delphi Implementation by E. Spelt
}
unit ZXing.OneD.EAN8Reader;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.OneD.UPCEANReader,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat;
type
/// <summary>
/// <p>Implements decoding of the EAN-8 format.</p>
/// </summary>
TEAN8Reader = class(TUPCEANReader)
private
class var DecodeMiddleCounters: TArray<Integer>;
class procedure DoInitialize();
class procedure DoFinalize();
public
class function DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const resultString: TStringBuilder)
: Integer; override;
function BarcodeFormat: TBarcodeFormat; override;
end;
implementation
function TEAN8Reader.BarcodeFormat: TBarcodeFormat;
begin
result := TBarcodeFormat.EAN_8;
end;
class procedure TEAN8Reader.DoFinalize;
begin
DecodeMiddleCounters := nil;
end;
class procedure TEAN8Reader.DoInitialize;
begin
SetLength(DecodeMiddleCounters, 4);
end;
class function TEAN8Reader.DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>;
const resultString: TStringBuilder): Integer;
var
ending, rowOffset, x, bestMatch: Integer;
counter: Integer;
counters, middleRange: TArray<Integer>;
begin
counters := self.DecodeMiddleCounters;
counters[0] := 0;
counters[1] := 0;
counters[2] := 0;
counters[3] := 0;
ending := row.Size;
rowOffset := startRange[1];
x := 0;
while (((x < 4) and (rowOffset < ending))) do
begin
if (not TUPCEANReader.decodeDigit(row, counters, rowOffset,
TUPCEANReader.L_PATTERNS, bestMatch)) then
begin
result := -1;
exit
end;
resultString.Append(IntToStr(bestMatch));
for counter in counters do
begin
inc(rowOffset, counter)
end;
inc(x)
end;
middleRange := TUPCEANReader.findGuardPattern(row, rowOffset, true,
TUPCEANReader.MIDDLE_PATTERN);
if (middleRange = nil) then
begin
result := -1;
exit
end;
rowOffset := middleRange[1];
x := 0;
while (((x < 4) and (rowOffset < ending))) do
begin
if (not TUPCEANReader.decodeDigit(row, counters, rowOffset,
TUPCEANReader.L_PATTERNS, bestMatch)) then
begin
result := -1;
exit
end;
resultString.Append(IntToStr(bestMatch));
for counter in counters do
begin
inc(rowOffset, counter)
end;
inc(x)
end;
result := rowOffset;
end;
initialization
TEAN8Reader.DoInitialize;
finalization
TEAN8Reader.DoFinalize;
end.
@@ -0,0 +1,230 @@
{
* Copyright 2010 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 K. Gossens
}
unit ZXing.OneD.EANManufacturerOrgSupport;
interface
uses
System.SysUtils,
System.Classes,
System.Generics.Collections,
System.Math,
ZXing.OneD.UPCEANExtension2Support,
ZXing.OneD.UPCEANExtension5Support,
ZXing.Reader,
ZXing.BinaryBitmap,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultMetadataType,
ZXing.ResultPoint,
ZXing.Common.BitArray,
ZXing.Common.Detector.MathUtils;
type
// <summary>
/// Records EAN prefix to GS1 Member Organization, where the member organization
/// correlates strongly with a country. This is an imperfect means of identifying
/// a country of origin by EAN-13 barcode value. See
/// <a href="http://en.wikipedia.org/wiki/List_of_GS1_country_codes">
/// http://en.wikipedia.org/wiki/List_of_GS1_country_codes</a>.
/// </summary>
TEANManufacturerOrgSupport = class sealed
private
var
ranges: TList<TArray<Integer>>;
countryIdentifiers: TStringList;
procedure add(const range: TArray<Integer>; const id: string);
procedure initIfNeeded;
public
constructor Create;
destructor Destroy; override;
function lookupCountryIdentifier(const productCode: String): String;
end;
implementation
{ TEANManufacturerOrgSupport }
constructor TEANManufacturerOrgSupport.Create;
begin
ranges := TList < TArray < Integer >>.Create;
countryIdentifiers := TStringList.Create;
end;
destructor TEANManufacturerOrgSupport.Destroy;
begin
countryIdentifiers.Free;
ranges.Free;
inherited;
end;
function TEANManufacturerOrgSupport.lookupCountryIdentifier(const productCode
: String): String;
var
i, prefix, max: Integer;
range: TArray<Integer>;
start, ending: Integer;
begin
Result := '';
initIfNeeded;
prefix := Integer.Parse(productCode.Substring(0, 3));
max := ranges.Count;
for i := 0 to Pred(max) do
begin
range := ranges[i];
start := range[0];
if (prefix < start) then
exit;
if (Length(range) = 1) then
ending := start
else
ending := range[1];
if (prefix <= ending) then
begin
Result := countryIdentifiers[i];
break;
end;
end;
end;
procedure TEANManufacturerOrgSupport.add(const range: TArray<Integer>;
const id: string);
begin
ranges.add(range);
countryIdentifiers.add(id);
end;
procedure TEANManufacturerOrgSupport.initIfNeeded;
begin
if (ranges.Count = 0) then
begin
add(TArray<Integer>.Create(0, 19), 'US/CA');
add(TArray<Integer>.Create(30, 39), 'US');
add(TArray<Integer>.Create(60, 139), 'US/CA');
add(TArray<Integer>.Create(300, 379), 'FR');
add(TArray<Integer>.Create(380), 'BG');
add(TArray<Integer>.Create(383), 'SI');
add(TArray<Integer>.Create(385), 'HR');
add(TArray<Integer>.Create(387), 'BA');
add(TArray<Integer>.Create(400, 440), 'DE');
add(TArray<Integer>.Create(450, 459), 'JP');
add(TArray<Integer>.Create(460, 469), 'RU');
add(TArray<Integer>.Create(471), 'TW');
add(TArray<Integer>.Create(474), 'EE');
add(TArray<Integer>.Create(475), 'LV');
add(TArray<Integer>.Create(476), 'AZ');
add(TArray<Integer>.Create(477), 'LT');
add(TArray<Integer>.Create(478), 'UZ');
add(TArray<Integer>.Create(479), 'LK');
add(TArray<Integer>.Create(480), 'PH');
add(TArray<Integer>.Create(481), 'BY');
add(TArray<Integer>.Create(482), 'UA');
add(TArray<Integer>.Create(484), 'MD');
add(TArray<Integer>.Create(485), 'AM');
add(TArray<Integer>.Create(486), 'GE');
add(TArray<Integer>.Create(487), 'KZ');
add(TArray<Integer>.Create(489), 'HK');
add(TArray<Integer>.Create(490, 499), 'JP');
add(TArray<Integer>.Create(500, 509), 'GB');
add(TArray<Integer>.Create(520), 'GR');
add(TArray<Integer>.Create(528), 'LB');
add(TArray<Integer>.Create(529), 'CY');
add(TArray<Integer>.Create(531), 'MK');
add(TArray<Integer>.Create(535), 'MT');
add(TArray<Integer>.Create(539), 'IE');
add(TArray<Integer>.Create(540, 549), 'BE/LU');
add(TArray<Integer>.Create(560), 'PT');
add(TArray<Integer>.Create(569), 'IS');
add(TArray<Integer>.Create(570, 579), 'DK');
add(TArray<Integer>.Create(590), 'PL');
add(TArray<Integer>.Create(594), 'RO');
add(TArray<Integer>.Create(599), 'HU');
add(TArray<Integer>.Create(600, 601), 'ZA');
add(TArray<Integer>.Create(603), 'GH');
add(TArray<Integer>.Create(608), 'BH');
add(TArray<Integer>.Create(609), 'MU');
add(TArray<Integer>.Create(611), 'MA');
add(TArray<Integer>.Create(613), 'DZ');
add(TArray<Integer>.Create(616), 'KE');
add(TArray<Integer>.Create(618), 'CI');
add(TArray<Integer>.Create(619), 'TN');
add(TArray<Integer>.Create(621), 'SY');
add(TArray<Integer>.Create(622), 'EG');
add(TArray<Integer>.Create(624), 'LY');
add(TArray<Integer>.Create(625), 'JO');
add(TArray<Integer>.Create(626), 'IR');
add(TArray<Integer>.Create(627), 'KW');
add(TArray<Integer>.Create(628), 'SA');
add(TArray<Integer>.Create(629), 'AE');
add(TArray<Integer>.Create(640, 649), 'FI');
add(TArray<Integer>.Create(690, 695), 'CN');
add(TArray<Integer>.Create(700, 709), 'NO');
add(TArray<Integer>.Create(729), 'IL');
add(TArray<Integer>.Create(730, 739), 'SE');
add(TArray<Integer>.Create(740), 'GT');
add(TArray<Integer>.Create(741), 'SV');
add(TArray<Integer>.Create(742), 'HN');
add(TArray<Integer>.Create(743), 'NI');
add(TArray<Integer>.Create(744), 'CR');
add(TArray<Integer>.Create(745), 'PA');
add(TArray<Integer>.Create(746), 'DO');
add(TArray<Integer>.Create(750), 'MX');
add(TArray<Integer>.Create(754, 755), 'CA');
add(TArray<Integer>.Create(759), 'VE');
add(TArray<Integer>.Create(760, 769), 'CH');
add(TArray<Integer>.Create(770), 'CO');
add(TArray<Integer>.Create(773), 'UY');
add(TArray<Integer>.Create(775), 'PE');
add(TArray<Integer>.Create(777), 'BO');
add(TArray<Integer>.Create(779), 'AR');
add(TArray<Integer>.Create(780), 'CL');
add(TArray<Integer>.Create(784), 'PY');
add(TArray<Integer>.Create(785), 'PE');
add(TArray<Integer>.Create(786), 'EC');
add(TArray<Integer>.Create(789, 790), 'BR');
add(TArray<Integer>.Create(800, 839), 'IT');
add(TArray<Integer>.Create(840, 849), 'ES');
add(TArray<Integer>.Create(850), 'CU');
add(TArray<Integer>.Create(858), 'SK');
add(TArray<Integer>.Create(859), 'CZ');
add(TArray<Integer>.Create(860), 'YU');
add(TArray<Integer>.Create(865), 'MN');
add(TArray<Integer>.Create(867), 'KP');
add(TArray<Integer>.Create(868, 869), 'TR');
add(TArray<Integer>.Create(870, 879), 'NL');
add(TArray<Integer>.Create(880), 'KR');
add(TArray<Integer>.Create(885), 'TH');
add(TArray<Integer>.Create(888), 'SG');
add(TArray<Integer>.Create(890), 'IN');
add(TArray<Integer>.Create(893), 'VN');
add(TArray<Integer>.Create(896), 'PK');
add(TArray<Integer>.Create(899), 'ID');
add(TArray<Integer>.Create(900, 919), 'AT');
add(TArray<Integer>.Create(930, 939), 'AU');
add(TArray<Integer>.Create(940, 949), 'AZ');
add(TArray<Integer>.Create(955), 'MY');
add(TArray<Integer>.Create(958), 'MO');
end;
end;
end.
@@ -0,0 +1,497 @@
{
* 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: kevin.osullivan@sita.aero, SITA Lab.
* Delphi Implementation by E. Spelt and K. Gossens
}
unit ZXing.OneD.ITFReader;
interface
uses
System.SysUtils,
System.Generics.Collections,
Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat,
ZXing.Helpers;
type
/// <summary>
/// <p>Implements decoding of the ITF format, or Interleaved Two of Five.</p>
///
/// <p>This Reader will scan ITF barcodes of certain lengths only.
/// At the moment it reads length 6, 8, 10, 12, 14, 16, 18, 20, 24, 44 and 48 as these have appeared "in the wild". Not all
/// lengths are scanned, especially shorter ones, to avoid false positives. This in turn is due to a lack of
/// required checksum function.</p>
///
/// <p>The checksum is optional and is not applied by this Reader. The consumer of the decoded
/// value will have to apply a checksum if required.</p>
///
/// <p><a href="http://en.wikipedia.org/wiki/Interleaved_2_of_5">http://en.wikipedia.org/wiki/Interleaved_2_of_5</a>
/// is a great reference for Interleaved 2 of 5 information.</p>
/// </summary>
TITFReader = class(TOneDReader)
const
LARGEST_DEFAULT_ALLOWED_LENGTH: Integer = 14;
N: Integer = 1;
W: Integer = 3;
private
class var PATTERNS: TArray<TArray<Integer>>;
class var END_PATTERN_REVERSED: TArray<Integer>;
class var MAX_AVG_VARIANCE: Integer;
class var MAX_INDIVIDUAL_VARIANCE: Integer;
class var DEFAULT_ALLOWED_LENGTHS: TArray<Integer>;
class var
START_PATTERN: TArray<Integer>;
narrowLineWidth: Integer;
class function decodeDigit(counters: TArray<Integer>;
out bestMatch: Integer): boolean; static;
function decodeEnd(row: IBitArray): TArray<Integer>;
class function skipWhiteSpace(row: IBitArray): Integer; static;
class function findGuardPattern(row: IBitArray; rowOffset: Integer;
pattern: TArray<Integer>): TArray<Integer>; static;
function validateQuietZone(row: IBitArray; startPattern: Integer): boolean;
function decodeStart(row: IBitArray): TArray<Integer>;
class function decodeMiddle(row: IBitArray;
payloadStart, payloadEnd: Integer; SBResult: TStringBuilder)
: boolean; static;
class procedure ClassInit();
public
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult; override;
end;
implementation
uses
ZXing.Common.Detector.MathUtils;
{ TITFReader }
class procedure TITFReader.ClassInit();
begin
MAX_AVG_VARIANCE := Floor(PATTERN_MATCH_RESULT_SCALE_FACTOR * 0.42);
MAX_INDIVIDUAL_VARIANCE := Floor(PATTERN_MATCH_RESULT_SCALE_FACTOR * 0.78);
DEFAULT_ALLOWED_LENGTHS := [6, 8, 10, 12, 14];
START_PATTERN := [N, N, N, N];
END_PATTERN_REVERSED := [N, N, W];
PATTERNS := [[N, N, W, W, N], // 0
[W, N, N, N, W], // 1
[N, W, N, N, W], // 2
[W, W, N, N, N], // 3
[N, N, W, N, W], // 4
[W, N, W, N, N], // 5
[N, W, W, N, N], // 6
[N, N, N, W, W], // 7
[W, N, N, W, N], // 8
[N, W, N, W, N]]; // 9
end;
function TITFReader.decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
allowedLength: Integer;
startRange: TArray<Integer>;
endRange: TArray<Integer>;
stringResult: string;
allowedLengths: TArray<Integer>;
maxAllowedLength: Integer;
len: Integer;
lengthOK: boolean;
SBResult: TStringBuilder;
resultPointCallback: TResultPointCallback;
obj: TObject;
resultPoints: TArray<IResultPoint>;
resultPointLeft,
resultPointRight: IResultPoint;
begin
startRange := decodeStart(row);
if (startRange = nil) then
begin
Exit(nil);
end;
endRange := self.decodeEnd(row);
if (endRange = nil) then
begin
Exit(nil);
end;
SBResult := TStringBuilder.Create(20);
if (not decodeMiddle(row, startRange[1], endRange[0], SBResult)) then
begin
FreeAndNil(sbResult);
Exit(nil);
end;
stringResult := SBResult.ToString();
FreeAndNil(sbResult);
allowedLengths := nil;
maxAllowedLength := LARGEST_DEFAULT_ALLOWED_LENGTH;
if ((hints <> nil) and hints.ContainsKey(ZXing.DecodeHintType.ALLOWED_LENGTHS)) then
begin
allowedLengths := TArray<Integer>(hints[ZXing.DecodeHintType.ALLOWED_LENGTHS]);
maxAllowedLength := 0
end;
if (allowedLengths = nil) then
begin
allowedLengths := DEFAULT_ALLOWED_LENGTHS;
maxAllowedLength := LARGEST_DEFAULT_ALLOWED_LENGTH;
end;
len := Length(stringResult);
lengthOK := (len > LARGEST_DEFAULT_ALLOWED_LENGTH);
if (not lengthOK) then
begin
for allowedLength in allowedLengths do
begin
if (len = allowedLength) then
begin
lengthOK := true;
break;
end;
if (allowedLength > maxAllowedLength) then
begin
maxAllowedLength := allowedLength;
end;
end;
if ((not lengthOK) and (len > maxAllowedLength)) then
begin
lengthOK := true;
end;
if (not lengthOK) then
begin
Exit(nil);
end
end;
resultPointLeft := TResultPointHelpers.CreateResultPoint(startRange[1], rowNumber);
resultPointRight := TResultPointHelpers.CreateResultPoint(endRange[0], rowNumber);
resultPoints := [resultPointLeft, resultPointRight];
resultPointCallback := nil; // had to add this initialization because the following if/else construct does not assign a value
// for all possible cases. Being resultPointCallback a local variable it is not initialized by default to null,
// so you could get unpredictable results
if ((hints = nil) or
(not hints.ContainsKey(TDecodeHintType.NEED_RESULT_POINT_CALLBACK)))
then
resultPointCallback := nil
else
begin
obj := hints[TDecodeHintType.NEED_RESULT_POINT_CALLBACK];
if (obj is TResultPointEventObject)
then
resultPointCallback := TResultPointEventObject(obj).Event;
end;
if Assigned(resultPointCallback) then
begin
resultPointCallback(resultPointLeft);
resultPointCallback(resultPointRight);
end;
Result := TReadResult.Create(stringResult, nil, resultPoints,
TBarcodeFormat.ITF);
end;
class function TITFReader.decodeDigit(counters: TArray<Integer>;
out bestMatch: Integer): boolean;
var
bestVariance: Integer;
max: Integer;
i: Integer;
pattern: TArray<Integer>;
variance: Integer;
begin
bestVariance := MAX_AVG_VARIANCE;
bestMatch := -1;
max := Length(PATTERNS);
i := 0;
while ((i < max)) do
begin
pattern := PATTERNS[i];
variance := PatternMatchVariance(counters, pattern,
MAX_INDIVIDUAL_VARIANCE);
if (variance < bestVariance) then
begin
bestVariance := variance;
bestMatch := i
end;
inc(i)
end;
Result := (bestMatch >= 0);
end;
function TITFReader.decodeStart(row: IBitArray): TArray<Integer>;
var
endStart: Integer;
startPattern: TArray<Integer>;
begin
endStart := skipWhiteSpace(row);
if (endStart < 0) then
begin
Exit(nil);
end;
startPattern := findGuardPattern(row, endStart, START_PATTERN);
if (startPattern = nil) then
begin
Exit(nil);
end;
narrowLineWidth := TMathUtils.Asr(startPattern[1] - startPattern[0], 2);
if (not validateQuietZone(row, startPattern[0])) then
begin
Exit(nil);
end;
Result := startPattern;
end;
class function TITFReader.decodeMiddle(row: IBitArray;
payloadStart, payloadEnd: Integer; SBResult: TStringBuilder): boolean;
var
bestMatch: Integer;
counterDigit: Integer;
counterDigitPair: TArray<Integer>;
counterBlack: TArray<Integer>;
counterWhite: TArray<Integer>;
k: Integer;
twoK: Integer;
begin
SetLength(counterDigitPair, 10);
SetLength(counterBlack, 5);
SetLength(counterWhite, 5);
while ((payloadStart < payloadEnd)) do
begin
if (not RecordPattern(row, payloadStart, counterDigitPair)) then
begin
Exit(false);
end;
k := 0;
while ((k < 5)) do
begin
twoK := (k shl 1);
counterBlack[k] := counterDigitPair[twoK];
counterWhite[k] := counterDigitPair[(twoK + 1)];
inc(k)
end;
if (not decodeDigit(counterBlack, bestMatch)) then // @(bestMatch))) then
begin
Exit(false);
end;
SBResult.Append(char($30 + bestMatch));
if (not decodeDigit(counterWhite, bestMatch)) then // @(bestMatch))) then
begin
Exit(false);
end;
SBResult.Append(char($30 + bestMatch));
for counterDigit in counterDigitPair do
begin
inc(payloadStart, counterDigit);
end
end;
Result := true;
end;
function TITFReader.decodeEnd(row: IBitArray): TArray<Integer>;
var
endStart: Integer;
endPattern: TArray<Integer>;
temp: Integer;
begin
row.reverse;
endStart := skipWhiteSpace(row);
if (endStart < 0) then
begin
Exit(nil);
end;
// !!
endPattern := findGuardPattern(row, endStart, END_PATTERN_REVERSED);
if (endPattern = nil) then
begin
row.reverse;
Exit(nil);
end;
if (not validateQuietZone(row, endPattern[0])) then
begin
row.reverse;
Exit(nil);
end;
temp := endPattern[0];
endPattern[0] := row.Size - endPattern[1];
endPattern[1] := row.Size - temp;
row.reverse;
Result := endPattern;
end;
class function TITFReader.findGuardPattern(row: IBitArray; rowOffset: Integer;
pattern: TArray<Integer>): TArray<Integer>;
var
patternLength: Integer;
counters: TArray<Integer>;
width: Integer;
isWhite: boolean;
counterPosition: Integer;
patternStart: Integer;
x: Integer;
begin
patternLength := Length(pattern);
counters := TArray<Integer>.Create();
SetLength(counters, patternLength);
width := row.Size;
isWhite := false;
counterPosition := 0;
patternStart := rowOffset;
x := rowOffset;
while ((x < width)) do
begin
if (row[x] xor isWhite) then
begin
inc(counters[counterPosition]);
end
else
begin
if (counterPosition = (patternLength - 1)) then
begin
if (PatternMatchVariance(counters, pattern, MAX_INDIVIDUAL_VARIANCE) <
MAX_AVG_VARIANCE) then
begin
Result := [patternStart, x];
Exit(Result);
end;
inc(patternStart, (counters[0] + counters[1]));
counters := TArray.CopyInSameArray(counters, 2, patternLength - 2);
counters[(patternLength - 2)] := 0;
counters[(patternLength - 1)] := 0;
dec(counterPosition);
end
else
begin
inc(counterPosition);
end;
counters[counterPosition] := 1;
isWhite := not isWhite
end;
inc(x);
end;
Result := nil;
end;
class function TITFReader.skipWhiteSpace(row: IBitArray): Integer;
var
width: Integer;
endStart: Integer;
begin
width := row.Size;
endStart := row.getNextSet(0);
if (endStart = width) then
begin
Result := -1;
end
else
begin
Result := endStart;
end
end;
function TITFReader.validateQuietZone(row: IBitArray;
startPattern: Integer): boolean;
var
quietCount: Integer;
i: Integer;
begin
quietCount := (self.narrowLineWidth * 10);
if (quietCount >= startPattern) then
begin
quietCount := startPattern;
end;
i := (startPattern - 1);
while (((quietCount > 0) and (i >= 0))) do
begin
if (row[i]) then
begin
break;
end;
dec(quietCount);
dec(i)
end;
if (quietCount <> 0) then
begin
Exit(false);
end;
Result := true;
end;
initialization
TITFReader.ClassInit();
end.
@@ -0,0 +1,499 @@
{
* 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: dswitkin@google.com (Daniel Switkin) and Sean Owen
* Delphi Implementation by E. Spelt and K. Gossens
}
unit ZXing.OneD.OneDReader;
interface
uses
System.SysUtils,
System.Generics.Collections,
Math,
ZXing.Reader,
ZXing.BinaryBitmap,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultMetadataType,
ZXing.ResultPoint,
ZXing.Common.BitArray,
ZXing.Common.Detector.MathUtils;
type
/// <summary>
/// Encapsulates functionality and implementation that is common to all families
/// of one-dimensional barcodes.
/// </summary>
TOneDReader = class(TInterfacedObject, IReader)
private
/// <summary>
/// We're going to examine rows from the middle outward, searching alternately above and below the
/// middle, and farther out each time. rowStep is the number of rows between each successive
/// attempt above and below the middle. So we'd scan row middle, then middle - rowStep, then
/// middle + rowStep, then middle - (2 * rowStep), etc.
/// rowStep is bigger as the image is taller, but is always at least 1. We've somewhat arbitrarily
/// decided that moving up and down by about 1/16 of the image is pretty good; we try more of the
/// image if "trying harder".
/// </summary>
/// <param name="image">The image to decode</param>
/// <param name="hints">Any hints that were requested</param>
/// <returns>The contents of the decoded barcode</returns>
function doDecode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
class procedure InitializeClass; static;
protected
class var INTEGER_MATH_SHIFT: Integer;
class var PATTERN_MATCH_RESULT_SCALE_FACTOR: Integer;
/// <summary>
/// Determines how closely a set of observed counts of runs of black/white values matches a given
/// target pattern. This is reported as the ratio of the total variance from the expected pattern
/// proportions across all pattern elements, to the length of the pattern.
/// </summary>
/// <param name="counters">observed counters</param>
/// <param name="pattern">expected pattern</param>
/// <param name="maxIndividualVariance">The most any counter can differ before we give up</param>
/// <returns>ratio of total variance between counters and pattern compared to total pattern size,
/// where the ratio has been multiplied by 256. So, 0 means no variance (perfect match); 256 means
/// the total variance between counters and patterns equals the pattern length, higher values mean
/// even more variance</returns>
class function patternMatchVariance(counters, pattern: TArray<Integer>;
maxIndividualVariance: Integer): Integer; static;
/// <summary>
/// Records the pattern in reverse.
/// </summary>
/// <param name="row">The row.</param>
/// <param name="start">The start.</param>
/// <param name="counters">The counters.</param>
/// <returns></returns>
class function RecordPatternInReverse(row: IBitArray; start: Integer;
counters: TArray<Integer>): Boolean; Static;
/// <summary>
/// Records the size of successive runs of white and black pixels in a row, starting at a given point.
/// The values are recorded in the given array, and the number of runs recorded is equal to the size
/// of the array. If the row starts on a white pixel at the given start point, then the first count
/// recorded is the run of white pixels starting from that point; likewise it is the count of a run
/// of black pixels if the row begin on a black pixels at that point.
/// </summary>
/// <param name="row">row to count from</param>
/// <param name="start">offset into row to start at</param>
/// <param name="counters">array into which to record counts</param>
class function recordPattern(row: IBitArray; start: Integer;
counters: TArray<Integer>; numCounters: Integer): Boolean;
overload; static;
public
/// <summary>
/// Resets any internal state the implementation has after a decode, to prepare it
/// for reuse.
/// </summary>
procedure reset(); virtual;
/// <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.
/// Note that we don't try rotation without the try harder flag, even if rotation was supported.
/// </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; virtual;
/// <summary>
/// Records the size of successive runs of white and black pixels in a row, starting at a given point.
/// The values are recorded in the given array, and the number of runs recorded is equal to the size
/// of the array. If the row starts on a white pixel at the given start point, then the first count
/// recorded is the run of white pixels starting from that point; likewise it is the count of a run
/// of black pixels if the row begin on a black pixels at that point.
/// </summary>
/// <param name="row">row to count from</param>
/// <param name="start">offset into row to start at</param>
/// <param name="counters">array into which to record counts</param>
class function recordPattern(row: IBitArray; start: Integer;
counters: TArray<Integer>): Boolean; overload; static;
/// <summary>
/// Attempts to decode a one-dimensional barcode format given a single row of
/// an image.
/// </summary>
/// <param name="rowNumber">row number from top of the row</param>
/// <param name="row">the black/white pixel data of the row</param>
/// <param name="hints">decode hints</param>
/// <returns>
/// <see cref="Result"/>containing encoded string and start/end of barcode
/// </returns>
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
virtual; abstract;
end;
implementation
{ TOneDReader }
function TOneDReader.decode(const image: TBinaryBitmap): TReadResult;
begin
Result := decode(image, nil);
end;
class procedure TOneDReader.InitializeClass();
begin
INTEGER_MATH_SHIFT := 8;
PATTERN_MATCH_RESULT_SCALE_FACTOR := (1 shl INTEGER_MATH_SHIFT);
end;
function TOneDReader.decode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
tryHarder, tryHarderWithoutRotation: Boolean;
rotatedImage: TBinaryBitmap;
metadata: TResultMetadata;
orientation, height, i, l: Integer;
points: TArray<IResultPoint>;
begin
Result := doDecode(image, hints);
if (Result = nil) then
begin
Exit;
end;
tryHarder := (hints <> nil) and
(hints.ContainsKey(ZXing.DecodeHintType.TRY_HARDER));
tryHarderWithoutRotation := (hints <> nil) and
(hints.ContainsKey(ZXing.DecodeHintType.TRY_HARDER_WITHOUT_ROTATION));
if (tryHarder and ((not tryHarderWithoutRotation) and image.RotateSupported))
then
begin
rotatedImage := image.rotateCounterClockwise();
Result := doDecode(rotatedImage, hints);
if (Result = nil) then
begin
Exit;
end;
// Record that we found it rotated 90 degrees CCW / 270 degrees CW
metadata := Result.ResultMetadata;
orientation := 270;
if ((metadata <> nil) and metadata.ContainsKey
(ZXing.ResultMetadataType.orientation)) then
begin
// But if we found it reversed in doDecode(), add in that result here:
orientation :=
(orientation + (metadata[ZXing.ResultMetadataType.orientation]
as IIntegerMetadata).Value) mod 360;
end;
Result.putMetadata(ZXing.ResultMetadataType.orientation,
TResultMetadata.CreateIntegerMetadata(orientation));
// Update result points
points := Result.ResultPoints;
if (points <> nil) then
begin
height := rotatedImage.height;
l := Length(points) - 1;
for i := 0 to l do
begin
points[i] := TResultPointHelpers.CreateResultPoint
(height - points[i].Y - 1, points[i].X);
end;
end;
end;
end;
function TOneDReader.doDecode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
attempt, X, rowNumber, rowStepsAboveOrBelow, width, height, middle, rowStep,
maxLines: Integer;
row: IBitArray;
isAbove, hadResultPointCallBack: Boolean;
ReadResult: TReadResult;
points: TArray<IResultPoint>;
obj: TObject;
needsCallBack : boolean;
begin
needsCallBack := (hints <> nil) and (hints.ContainsKey(ZXing.DecodeHintType.NEED_RESULT_POINT_CALLBACK));
width := image.width;
height := image.height;
row := TBitArrayHelpers.CreateBitArray(width);
// row is a interfaced object: we don't need to free it explicitly
middle := TMathUtils.Asr(height, 1);
rowStep := 5;
maxLines := height; // Look at the whole image, not just the center
for X := 0 to maxLines - 1 do
begin
// Scanning from the middle out. Determine which row we're looking at next:
rowStepsAboveOrBelow := TMathUtils.Asr((X + 1), 1);
isAbove := (X and $01) = 0; // i.e. is x even?
if (not isAbove) then
begin
rowStepsAboveOrBelow := rowStepsAboveOrBelow * -1;
end;
rowNumber := middle + rowStep * rowStepsAboveOrBelow;
if ((rowNumber < 0) or (rowNumber >= height)) then
begin
// Oops, if we run off the top or bottom, stop
break;
end;
// Estimate black point for this row and load it:
row := image.getBlackRow(rowNumber, row);
if (row = nil) then
begin
continue;
end;
// While we have the image data in a BitArray, it's fairly cheap to reverse it in place to
// handle decoding upside down barcodes.
// for attempt := 0 to (attempt < 2) do
for attempt := 0 to 1 do
begin
hadResultPointCallBack := false;
if (attempt = 1) then
begin
// trying again?
row.Reverse();
// This means we will only ever draw result points *once* in the life of this method
// since we want to avoid drawing the wrong points after flipping the row, and,
// don't want to clutter with noise from every single row scan -- just the scans
// that start on the center line.
if needsCallBack then
begin
hints.TryGetValue
(ZXing.DecodeHintType.NEED_RESULT_POINT_CALLBACK, obj);
hints.Remove(ZXing.DecodeHintType.NEED_RESULT_POINT_CALLBACK);
hadResultPointCallBack := true;
end;
end;
// Look for a barcode
ReadResult := decodeRow(rowNumber, row, hints);
if hadResultPointCallBack then
begin
hints.Add(ZXing.DecodeHintType.NEED_RESULT_POINT_CALLBACK, obj);
end;
if (ReadResult = nil) then
begin
continue;
end;
// We found our barcode
if (attempt = 1) then
begin
// But it was upside down, so note that
// ReadResult.putMetadata(ResultMetadataType.orientation, TObject(180));
// And remember to flip the result points horizontally.
points := ReadResult.ResultPoints;
if (points <> nil) then
begin
points[0] := TResultPointHelpers.CreateResultPoint
(width - points[0].X - 1, points[0].Y);
points[1] := TResultPointHelpers.CreateResultPoint
(width - points[1].X - 1, points[1].Y);
end;
end;
Exit(ReadResult);
end; // loop
end;
Result := nil;
end;
class function TOneDReader.patternMatchVariance(counters,
pattern: TArray<Integer>; maxIndividualVariance: Integer): Integer;
var
scaledPattern, variance, counter, totalVariance, X, unitBarWidth, i,
patternLength, numCounters, total: Integer;
begin
Result := High(Integer);
numCounters := Length(counters);
total := 0;
patternLength := 0;
for i := 0 to numCounters - 1 do
begin
total := total + counters[i];
patternLength := patternLength + pattern[i];
end;
if (total < patternLength) then
// If we don't even have one pixel per unit of bar width, assume this is too small
// to reliably match, so fail:
Exit;
// We're going to fake floating-point math in integers. We just need to use more bits.
// Scale up patternLength so that intermediate values below like scaledCounter will have
// more "significant digits"
unitBarWidth := (total shl INTEGER_MATH_SHIFT) div patternLength;
maxIndividualVariance :=
TMathUtils.Asr((maxIndividualVariance * unitBarWidth), INTEGER_MATH_SHIFT);
totalVariance := 0;
for X := 0 to numCounters - 1 do
begin
counter := counters[X] shl INTEGER_MATH_SHIFT;
scaledPattern := pattern[X] * unitBarWidth;
if (counter > scaledPattern) then
variance := counter - scaledPattern
else
variance := scaledPattern - counter;
if (variance > maxIndividualVariance) then
Exit;
totalVariance := totalVariance + variance;
end;
Result := totalVariance div total;
end;
class function TOneDReader.recordPattern(row: IBitArray; start: Integer;
counters: TArray<Integer>): Boolean;
begin
Result := recordPattern(row, start, counters, Length(counters));
end;
class function TOneDReader.recordPattern(row: IBitArray; start: Integer;
counters: TArray<Integer>; numCounters: Integer): Boolean;
var
i, counterPosition, idx, ending: Integer;
isWhite: Boolean;
begin
for idx := 0 to numCounters - 1 do
begin
counters[idx] := 0;
end;
ending := row.Size;
if (start >= ending) then
begin
Result := false;
Exit;
end;
isWhite := not row[start];
counterPosition := 0;
i := start;
while (i < ending) do
begin
if (row[i] xor isWhite) then
begin // that is, exactly one is true
inc(counters[counterPosition]);
end
else
begin
inc(counterPosition);
if (counterPosition = numCounters) then
begin
break;
end
else
begin
counters[counterPosition] := 1;
isWhite := not isWhite;
end;
end;
inc(i);
end;
// If we read fully the last section of pixels and filled up our counters -- or filled
// the last counter but ran off the side of the image, OK. Otherwise, a problem.
Result := ((counterPosition = numCounters) or
((counterPosition = (numCounters - 1)) and (i = ending)));
end;
class function TOneDReader.RecordPatternInReverse(row: IBitArray;
start: Integer; counters: TArray<Integer>): Boolean;
var
numTransitionsLeft: Integer;
last: Boolean;
begin
// This could be more efficient I guess
numTransitionsLeft := Length(counters);
last := row[start];
while ((start > 0) and (numTransitionsLeft >= 0)) do
begin
dec(start);
if (row[start] <> last) then
begin
dec(numTransitionsLeft);
last := not last;
end;
end;
if (numTransitionsLeft >= 0) then
begin
Result := false;
Exit;
end;
Result := recordPattern(row, start + 1, counters);
end;
procedure TOneDReader.reset;
begin
// do nothing
end;
initialization
TOneDReader.InitializeClass();
end.
@@ -0,0 +1,140 @@
unit ZXing.OneD.UPCAReader;
{
* 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
* Delphi Implementation by E. Spelt
}
interface
uses
System.SysUtils,
System.Generics.Collections,
Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.BinaryBitmap,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat,
ZXing.Helpers,
ZXing.OneD.EAN13Reader,
ZXing.OneD.UPCEANReader;
type
TUPCAReader = class(TUPCEANReader)
private
class var EAN13Reader: TUPCEANReader;
class function maybeReturnResult(pResult: TReadResult): TReadResult; static;
class procedure DoInitialize();
class procedure DoFinalize();
protected
public
class function DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const resultString: TStringBuilder)
: Integer; override;
function decode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult; override;
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
overload; override;
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const startGuardRange: TArray<Integer>;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
reintroduce; overload;
function BarcodeFormat: TBarcodeFormat; override;
end;
implementation
{ TUPCAReader }
class procedure TUPCAReader.DoFinalize;
begin
EAN13Reader.Free;
end;
class procedure TUPCAReader.DoInitialize;
begin
EAN13Reader := TEAN13Reader.Create();
end;
function TUPCAReader.decode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
begin
result := TUPCAReader.maybeReturnResult(self.EAN13Reader.decode(image, hints))
end;
class function TUPCAReader.DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>;
const resultString: TStringBuilder): Integer;
begin
result := self.EAN13Reader.DecodeMiddle(row, startRange, resultString)
end;
function TUPCAReader.decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
begin
result := TUPCAReader.maybeReturnResult(self.EAN13Reader.decodeRow(rowNumber,
row, hints))
end;
function TUPCAReader.decodeRow(const rowNumber: Integer; const row: IBitArray;
const startGuardRange: TArray<Integer>;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
begin
result := TUPCAReader.maybeReturnResult
(self.EAN13Reader.doDecodeRow(rowNumber, row, startGuardRange, hints))
end;
function TUPCAReader.BarcodeFormat: TBarcodeFormat;
begin
result := TBarcodeFormat.UPC_A;
end;
class function TUPCAReader.maybeReturnResult(pResult: TReadResult): TReadResult;
begin
if not Assigned(pResult) then
Exit(nil);
{$ZEROBASEDSTRINGS ON}
if (copy(pResult.text, 0, 1) = '0') then
begin
pResult.text := copy(pResult.text, 2, length(pResult.text));
pResult.BarcodeFormat := TBarcodeFormat.UPC_A;
end;
{$ZEROBASEDSTRINGS OFF}
result := pResult;
end;
initialization
TUPCAReader.DoInitialize;
finalization
TUPCAReader.DoFinalize;
end.
@@ -0,0 +1,194 @@
{
* 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.
* Delphi Implementation by K. Gossens
}
unit ZXing.OneD.UPCEANExtension2Support;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
ZXing.Reader,
ZXing.BarcodeFormat,
ZXing.BinaryBitmap,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultMetadataType,
ZXing.ResultPoint,
ZXing.Common.BitArray;
type
/// <summary>
/// @see UPCEANExtension5Support
/// </summary>
TUPCEANExtension2Support = class sealed
private
class var
decodeMiddleCounters : TArray<Integer>;
decodeRowStringBuffer : TStringBuilder;
class procedure InitializeClass; static;
class procedure FinalizeClass; static;
class function decodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>;
const resultString: TStringBuilder): Integer;
/// <summary>
/// Parses the extension string.
/// </summary>
/// <param name="raw">raw content of extension</param>
/// <returns>formatted interpretation of raw content as a {@link TMap} mapping
class function parseExtensionString(const raw: String): TResultMetadata; static;
public
class function decodeRow(const rowNumber: Integer; const row: IBitArray;
const extensionStartRange: TArray<Integer>): TReadResult;
end;
implementation
uses
ZXing.OneD.UPCEANReader;
{ TUPCEANExtension2Support }
class procedure TUPCEANExtension2Support.InitializeClass;
begin
decodeMiddleCounters := TArray<Integer>.Create(0, 0, 0, 0);
decodeRowStringBuffer := TStringBuilder.Create;
end;
class procedure TUPCEANExtension2Support.FinalizeClass;
begin
decodeMiddleCounters := nil;
decodeRowStringBuffer.Free;
end;
class function TUPCEANExtension2Support.decodeRow(const rowNumber: Integer;
const row: IBitArray; const extensionStartRange: TArray<Integer>): TReadResult;
var
res : TStringBuilder;
ending : Integer;
resultString : String;
extensionResult : TReadResult;
extensionData : TResultMetadata;
resultPoints : TArray<IResultPoint>;
begin
Result := nil;
res := decodeRowStringBuffer;
res.Length := 0;
ending := decodeMiddle(row, extensionStartRange, res);
if (ending < 0)
then
exit;
resultString := res.ToString;
extensionData := TUPCEANExtension2Support.parseExtensionString(resultString);
resultPoints := TArray<IResultPoint>.Create(
TResultPointHelpers.CreateResultPoint((extensionStartRange[0] + extensionStartRange[1]) div 2, rowNumber),
TResultPointHelpers.CreateResultPoint(ending, rowNumber));
extensionResult := TReadResult.Create(resultString, nil, resultPoints, TBarcodeFormat.UPC_EAN_EXTENSION);
if (extensionData <> nil)
then
begin
extensionResult.putAllMetadata(extensionData);
FreeAndNil(extensionData);
end;
Result := extensionResult;
end;
class function TUPCEANExtension2Support.decodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const resultString: TStringBuilder): Integer;
var
bestMatch: Integer;
counter: Integer;
ending: Integer;
counters : TArray<Integer>;
rowOffset, x,
checkParity: Integer;
begin
Result := -1;
counters := decodeMiddleCounters;
counters[0] := 0;
counters[1] := 0;
counters[2] := 0;
counters[3] := 0;
ending := row.Size;
rowOffset := startRange[1];
checkParity := 0;
x := 0;
while ((x < 2) and (rowOffset < ending)) do
begin
if (not TUPCEANReader.decodeDigit(row, counters, rowOffset, TUPCEANReader.L_AND_G_PATTERNS, bestMatch))
then
exit;
resultString.Append(IntToStr(bestMatch mod 10));
for counter in counters do
Inc(rowOffset, counter);
if (bestMatch >= 10)
then
checkParity := checkParity or (1 shl (1 - x));
if (x <> 1) then
begin
// Read off separator if not last
rowOffset := row.getNextSet(rowOffset);
rowOffset := row.getNextUnset(rowOffset);
end;
Inc(x);
end;
if (resultString.Length <> 2)
then
exit;
if ((Integer.Parse(resultString.ToString) mod 4) <> checkParity)
then
exit;
Result := rowOffset;
end;
class function TUPCEANExtension2Support.parseExtensionString(const raw: String): TResultMetadata;
var
dictionary1: TResultMetadata;
begin
Result := nil;
if (Length(raw) <> 2)
then
exit;
dictionary1 := TResultMetadata.Create;
dictionary1.Add(ZXing.ResultMetadataType.ISSUE_NUMBER, TResultMetaData.CreateStringMetadata(raw));
Result := dictionary1;
end;
initialization
TUPCEANExtension2Support.InitializeClass;
finalization
TUPCEANExtension2Support.FinalizeClass;
end.
@@ -0,0 +1,311 @@
{
* 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.
* Delphi Implementation by K. Gossens
}
unit ZXing.OneD.UPCEANExtension5Support;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
ZXing.Reader,
ZXing.BinaryBitmap,
ZXing.ReadResult,
ZXing.BarcodeFormat,
ZXing.DecodeHintType,
ZXing.ResultMetadataType,
ZXing.ResultPoint,
ZXing.Common.BitArray,
ZXing.Common.Detector.MathUtils;
type
(**
* @see TUPCEANExtension2Support
*)
TUPCEANExtension5Support = class sealed
private
class var
CHECK_DIGIT_ENCODINGS : TArray<Integer>;
decodeMiddleCounters : TArray<Integer>;
decodeRowStringBuffer : TStringBuilder;
class procedure InitializeClass; static;
class procedure FinalizeClass; static;
class function decodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>;
const resultString: TStringBuilder): Integer;
class function extensionChecksum(const s: string): Integer; static;
class function determineCheckDigit(const lgPatternFound: Integer;
var checkDigit: Integer): Boolean; static;
/// <summary>
/// Parses the extension string.
/// </summary>
/// <param name="raw">raw content of extension</param>
/// <returns>formatted interpretation of raw content as a {@link TMap} mapping
/// one {@link TResultMetadataType} to appropriate value, or {@code nil} if not known</returns>
class function parseExtensionString(
const raw: string): TResultMetadata; static;
class function parseExtension5String(const raw: String): String; static;
public
class function decodeRow(const rowNumber: Integer; const row: IBitArray;
const extensionStartRange: TArray<Integer>): TReadResult;
end;
implementation
uses
ZXing.OneD.UPCEANReader;
{ TUPCEANExtension2Support }
class procedure TUPCEANExtension5Support.InitializeClass;
begin
CHECK_DIGIT_ENCODINGS := TArray<Integer>.Create($18, $14, $12, $11, $0C,
$06, $03, $0A, $09, $05);
decodeMiddleCounters := TArray<Integer>.Create(0, 0, 0, 0);
decodeRowStringBuffer := TStringBuilder.Create;
end;
class procedure TUPCEANExtension5Support.FinalizeClass;
begin
CHECK_DIGIT_ENCODINGS := nil;
decodeMiddleCounters := nil;
decodeRowStringBuffer.Free;
end;
class function TUPCEANExtension5Support.decodeRow(const rowNumber: Integer;
const row: IBitArray; const extensionStartRange: TArray<Integer>): TReadResult;
var
res : TStringBuilder;
ending : Integer;
resultString : String;
extensionData : TResultMetadata;
resultPoints : TArray<IResultPoint>;
extensionResult : TReadResult;
begin
Result := nil;
res := decodeRowStringBuffer;
res.Length := 0;
ending := decodeMiddle(row, extensionStartRange, res);
if (ending < 0)
then
exit;
resultString := res.ToString;
extensionData := parseExtensionString(resultString);
resultPoints := TArray<IResultPoint>.Create(
TResultPointHelpers.CreateResultPoint((extensionStartRange[0] + extensionStartRange[1]) div 2, rowNumber),
TResultPointHelpers.CreateResultPoint(ending, rowNumber));
extensionResult := TReadResult.Create(resultString, nil, resultPoints, TBarcodeFormat.UPC_EAN_EXTENSION);
if (extensionData <> nil)
then
begin
extensionResult.putAllMetadata(extensionData);
FreeAndNil(extensionData);
end;
Result := extensionResult;
end;
class function TUPCEANExtension5Support.decodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const resultString: TStringBuilder): Integer;
var
bestMatch: Integer;
counter: Integer;
ending: Integer;
counters : TArray<Integer>;
rowOffset, x,
lgPatternFound,
checkDigit : Integer;
begin
Result := -1;
counters := decodeMiddleCounters;
counters[0] := 0;
counters[1] := 0;
counters[2] := 0;
counters[3] := 0;
ending := row.Size;
rowOffset := startRange[1];
lgPatternFound := 0;
x := 0;
while (((x < 5) and (rowOffset < ending))) do
begin
if (not TUPCEANReader.decodeDigit(row, counters, rowOffset, TUPCEANReader.L_AND_G_PATTERNS, bestMatch))
then
exit;
resultString.Append(IntToStr(bestMatch mod 10));
for counter in counters do
Inc(rowOffset, counter);
if (bestMatch >= 10)
then
lgPatternFound := lgPatternFound or (1 shl (4 - x));
if (x <> 4) then
begin
// Read off separator if not last
rowOffset := row.getNextSet(rowOffset);
rowOffset := row.getNextUnset(rowOffset)
end;
Inc(x);
end;
if (resultString.Length <> 5)
then
exit;
if (not determineCheckDigit(lgPatternFound, checkDigit))
then
exit;
if (extensionChecksum(resultString.ToString) <> checkDigit)
then
exit;
Result := rowOffset;
end;
class function TUPCEANExtension5Support.extensionChecksum(
const s: String): Integer;
var
len,
sum, i : Integer;
begin
len := Length(s);
sum := 0;
i := (len - 2);
while ((i >= 0)) do
begin
Inc(sum, StrToIntDef(s.Chars[i], 0));
Dec(i, 2);
end;
sum := (sum * 3);
i := (len - 1);
while ((i >= 0)) do
begin
Inc(sum, StrToIntDef(s.Chars[i], 0));
Dec(i, 2);
end;
sum := (sum * 3);
Result := (sum mod 10);
end;
class function TUPCEANExtension5Support.determineCheckDigit(
const lgPatternFound: Integer; var checkDigit: Integer): Boolean;
var
i: Integer;
begin
Result := false;
for i := 0 to Pred(10) do
begin
if (lgPatternFound = CHECK_DIGIT_ENCODINGS[i]) then
begin
Result := true;
checkDigit := i;
break;
end;
end;
end;
class function TUPCEANExtension5Support.parseExtensionString(
const raw: String): TResultMetadata;
var
value: String;
dictionary1: TResultMetadata;
begin
Result := nil;
if (Length(raw) <> 5)
then
exit;
value := TUPCEANExtension5Support.parseExtension5String(raw);
//
// if (Length(value) = 0)
// then
// Result := nil;
dictionary1 := TResultMetadata.Create();
dictionary1.Add(ZXing.ResultMetadataType.SUGGESTED_PRICE, TResultMetadata.CreateStringMetadata(value));
Result := dictionary1;
end;
class function TUPCEANExtension5Support.parseExtension5String(
const raw: String): String;
var
currency,
unitsString,
hundredthsString : string;
rawAmount,
hundredths : Integer;
begin
Result := '';
case raw[1] of
'0' : currency := '£';
'5' : currency := '$';
'9' : begin
// Reference: http://www.jollytech.com
if ('90000'.Equals(raw))
then
// No suggested retail price
exit;
if ('99991'.Equals(raw))
then
// Complementary
Result := '0.00';
if ('99990'.Equals(raw))
then
Result := 'Used';
// Otherwise... unknown currency?
currency := '';
end;
else currency := '';
end;
rawAmount := Integer.Parse(raw.Substring(1));
unitsString := ((rawAmount div 100)).ToString;
hundredths := (rawAmount mod 100);
if (hundredths < 10)
then
hundredthsString := '0' + hundredths.ToString
else
hundredthsString := hundredths.ToString;
Result := currency + unitsString + '.' + hundredthsString;
end;
initialization
TUPCEANExtension5Support.InitializeClass;
finalization
TUPCEANExtension5Support.FinalizeClass;
end.
@@ -0,0 +1,99 @@
{
* 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.
* Delphi Implementation by K. Gossens
}
unit ZXing.OneD.UPCEANExtensionSupport;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
ZXing.OneD.UPCEANExtension2Support,
ZXing.OneD.UPCEANExtension5Support,
ZXing.Reader,
ZXing.BinaryBitmap,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultMetadataType,
ZXing.ResultPoint,
ZXing.Common.BitArray,
ZXing.Common.Detector.MathUtils;
type
TUPCEANExtensionSupport = class sealed
private
class var
EXTENSION_START_PATTERN : TArray<Integer>;
twoSupport : TUPCEANExtension2Support;
fiveSupport : TUPCEANExtension5Support;
class procedure InitializeClass; static;
class procedure FinalizeClass; static;
public
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const rowOffset: Integer): TReadResult;
end;
implementation
uses
ZXing.OneD.UPCEANReader;
{ TUPCEANExtensionSupport }
class procedure TUPCEANExtensionSupport.InitializeClass();
begin
EXTENSION_START_PATTERN := TArray<Integer>.Create(1, 1, 2);
twoSupport := TUPCEANExtension2Support.Create();
fiveSupport := TUPCEANExtension5Support.Create();
end;
class procedure TUPCEANExtensionSupport.FinalizeClass();
begin
EXTENSION_START_PATTERN := nil;
twoSupport.Free;
fiveSupport.Free;
end;
function TUPCEANExtensionSupport.decodeRow(const rowNumber: Integer;
const row: IBitArray; const rowOffset: Integer): TReadResult;
var
extensionStartRange: TArray<Integer>;
res : TReadResult;
begin
Result := nil;
extensionStartRange := TUPCEANReader.findGuardPattern(row, rowOffset,
false, EXTENSION_START_PATTERN);
if (extensionStartRange = nil)
then
exit;
res := fiveSupport.decodeRow(rowNumber, row, extensionStartRange);
if (res = nil)
then
res := twoSupport.decodeRow(rowNumber, row, extensionStartRange);
Result := res;
end;
initialization
TUPCEANExtensionSupport.InitializeClass;
finalization
TUPCEANExtensionSupport.FinalizeClass;
end.
@@ -0,0 +1,592 @@
{
* 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: dswitkin@google.com (Daniel Switkin), Sean Owen and
* alasdair@google.com (Alasdair Mackintosh)
* Delphi Implementation by K. Gossens
}
unit ZXing.OneD.UPCEANReader;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.OneD.UPCEANExtensionSupport,
ZXing.OneD.EANManufacturerOrgSupport,
ZXing.ResultMetadataType,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat;
type
/// <summary>
/// <p>Encapsulates functionality and implementation that is common to UPC and EAN families
/// of one-dimensional barcodes.</p>
/// </summary>
TUPCEANReader = class abstract(TOneDReader)
private
decodeRowStringBuffer: TStringBuilder;
extensionReader: TUPCEANExtensionSupport;
eanManSupport: TEANManufacturerOrgSupport;
/// <summary>
/// </summary>
/// <param name="row">row of black/white values to search</param>
/// <param name="rowOffset">position to start search</param>
/// <param name="whiteFirst">if true, indicates that the pattern specifies white/black/white/...</param>
/// pixel counts, otherwise, it is interpreted as black/white/black/...
/// <param name="pattern">pattern of counts of number of black and white pixels that are being</param>
/// searched for as a pattern
/// <param name="counters">array of counters, as long as pattern, to re-use</param>
/// <returns>start/end horizontal offset of guard pattern, as an array of two ints</returns>
class function findGuardPattern(const row: IBitArray; rowOffset: Integer;
const whiteFirst: Boolean; const pattern: TArray<Integer>;
counters: TArray<Integer>): TArray<Integer>; overload;
/// <summary>
/// Computes the UPC/EAN checksum on a string of digits, and reports
/// whether the checksum is correct or not.
/// </summary>
/// <param name="s">string of digits to check</param>
/// <returns>true iff string of digits passes the UPC/EAN checksum algorithm</returns>
class function checkStandardUPCEANChecksum(const s: String)
: Boolean; static;
class procedure InitializeClass; static;
class procedure FinalizeClass; static;
protected
class var
// These two values are critical for determining how permissive the decoding will be.
// We've arrived at these values through a lot of trial and error. Setting them any higher
// lets false positives creep in quickly.
MAX_AVG_VARIANCE: Integer;
MAX_INDIVIDUAL_VARIANCE: Integer;
/// <summary>
/// Start/end guard pattern.
/// </summary>
START_END_PATTERN: TArray<Integer>;
/// <summary>
/// Pattern marking the middle of a UPC/EAN pattern, separating the two halves.
/// </summary>
MIDDLE_PATTERN: TArray<Integer>;
/// <summary>
/// "Odd", or "L" patterns used to encode UPC/EAN digits.
/// </summary>
L_PATTERNS: TArray<TArray<Integer>>;
/// <summary>
/// Decodes the end.
/// </summary>
/// <param name="row">The row.</param>
/// <param name="endStart">The end start.</param>
/// <returns></returns>
class function decodeEnd(const row: IBitArray; const endStart: Integer)
: TArray<Integer>; virtual;
/// <summary>
/// </summary>
/// <param name="s">string of digits to check</param>
/// <returns>see <see cref="checkStandardUPCEANChecksum(String)"/></returns>
class function checkChecksum(const s: String): Boolean; virtual;
public
class var
/// <summary>
/// As above but also including the "even", or "G" patterns used to encode UPC/EAN digits.
/// </summary>
L_AND_G_PATTERNS: TArray<TArray<Integer>>;
/// <summary>
/// Initializes a new instance of the <see cref="TUPCEANReader"/> class.
/// </summary>
constructor Create; virtual;
destructor Destroy; override;
/// <summary>
/// Subclasses override this to decode the portion of a barcode between the start
/// and end guard patterns.
/// </summary>
/// <param name="row">row of black/white values to search</param>
/// <param name="startRange">start/end offset of start guard pattern</param>
/// <param name="resultString"><see cref="StringBuilder" />to append decoded chars to</param>
/// <returns>horizontal offset of first pixel after the "middle" that was decoded or -1 if decoding could not complete successfully</returns>
class function DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const resultString: TStringBuilder)
: Integer; virtual; abstract;
/// <summary>
/// Get the format of this decoder.
/// </summary>
/// <returns>The 1D format.</returns>
function BarcodeFormat: TBarcodeFormat; virtual; abstract;
class function findStartGuardPattern(const row: IBitArray)
: TArray<Integer>; static;
class function findGuardPattern(const row: IBitArray;
const rowOffset: Integer; const whiteFirst: Boolean;
const pattern: TArray<Integer>): TArray<Integer>; overload;
/// <summary>
/// Attempts to decode a single UPC/EAN-encoded digit.
/// </summary>
/// <param name="row">row of black/white values to decode</param>
/// <param name="counters">the counts of runs of observed black/white/black/... values</param>
/// <param name="rowOffset">horizontal offset to start decoding from</param>
/// <param name="patterns">the set of patterns to use to decode -- sometimes different encodings</param>
/// for the digits 0-9 are used, and this indicates the encodings for 0 to 9 that should
/// be used
/// <returns>horizontal offset of first pixel beyond the decoded digit</returns>
class function decodeDigit(const row: IBitArray;
const counters: TArray<Integer>; const rowOffset: Integer;
const patterns: TArray<TArray<Integer>>; var digit: Integer): Boolean;
/// <summary>
/// <p>Attempts to decode a one-dimensional barcode format given a single row of
/// an image.</p>
/// </summary>
/// <param name="rowNumber">row number from top of the row</param>
/// <param name="row">the black/white pixel data of the row</param>
/// <param name="hints">decode hints</param>
/// <returns>
/// <see cref="TReadResult"/>containing encoded string and start/end of barcode or null, if an error occurs or barcode cannot be found
/// </returns>
function decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
overload; override;
/// <summary>
/// <p>Like decodeRow(int, BitArray, java.util.Map), but
/// allows caller to inform method about where the UPC/EAN start pattern is
/// found. This allows this to be computed once and reused across many implementations.</p>
/// </summary>
/// <param name="rowNumber">row index into the image</param>
/// <param name="row">encoding of the row of the barcode image</param>
/// <param name="startGuardRange">start/end column where the opening start pattern was found</param>
/// <param name="hints">optional hints that influence decoding</param>
/// <returns><see cref="TReadResult"/> encapsulating the result of decoding a barcode in the row</returns>
function DoDecodeRow(const rowNumber: Integer; const row: IBitArray;
const startGuardRange: TArray<Integer>;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
end;
implementation
{ TUPCEANReader }
constructor TUPCEANReader.Create;
begin
inherited;
decodeRowStringBuffer := TStringBuilder.Create(20);
extensionReader := TUPCEANExtensionSupport.Create;
eanManSupport := TEANManufacturerOrgSupport.Create;
end;
destructor TUPCEANReader.Destroy;
begin
eanManSupport.Free;
extensionReader.Free;
decodeRowStringBuffer.Free;
inherited;
end;
class procedure TUPCEANReader.InitializeClass;
var
i, j: Integer;
widths, reversedWidths: TArray<Integer>;
begin
MAX_AVG_VARIANCE :=
Trunc(TOneDReader.PATTERN_MATCH_RESULT_SCALE_FACTOR * 0.48);
MAX_INDIVIDUAL_VARIANCE :=
Trunc(TOneDReader.PATTERN_MATCH_RESULT_SCALE_FACTOR * 0.7);
START_END_PATTERN := TArray<Integer>.Create(1, 1, 1);
MIDDLE_PATTERN := TArray<Integer>.Create(1, 1, 1, 1, 1);
L_PATTERNS := TArray < TArray < Integer >>
.Create(TArray<Integer>.Create(3, 2, 1, 1), // 0
TArray<Integer>.Create(2, 2, 2, 1), // 1
TArray<Integer>.Create(2, 1, 2, 2), // 2
TArray<Integer>.Create(1, 4, 1, 1), // 3
TArray<Integer>.Create(1, 1, 3, 2), // 4
TArray<Integer>.Create(1, 2, 3, 1), // 5
TArray<Integer>.Create(1, 1, 1, 4), // 6
TArray<Integer>.Create(1, 3, 1, 2), // 7
TArray<Integer>.Create(1, 2, 1, 3), // 8
TArray<Integer>.Create(3, 1, 1, 2) // 9
);
L_AND_G_PATTERNS := L_PATTERNS;
SetLength(L_AND_G_PATTERNS, 20);
// Move(L_PATTERNS[0], L_AND_G_PATTERNS[0], 10);
for i := 10 to Pred(20) do
begin
widths := L_PATTERNS[(i - 10)];
reversedWidths := TArray<Integer>.Create();
SetLength(reversedWidths, Length(widths));
for j := 0 to Pred(Length(widths)) do
reversedWidths[j] := widths[((Length(widths) - j) - 1)];
L_AND_G_PATTERNS[i] := reversedWidths;
end;
end;
class procedure TUPCEANReader.FinalizeClass;
begin
START_END_PATTERN := nil;
MIDDLE_PATTERN := nil;
L_PATTERNS := nil;
L_AND_G_PATTERNS := nil;
end;
class function TUPCEANReader.checkChecksum(const s: String): Boolean;
begin
Result := checkStandardUPCEANChecksum(s);
end;
class function TUPCEANReader.checkStandardUPCEANChecksum
(const s: String): Boolean;
var
len, sum, i, digit, ZeroInt: Integer;
begin
{$ZEROBASEDSTRINGS ON}
Result := false;
len := Length(s);
if (len = 0) then
exit;
sum := 0;
ZeroInt := Ord('0');
i := (len - 2);
while ((i >= 0)) do
begin
digit := Ord(s[i]) - ZeroInt;
if ((digit < 0) or (digit > 9)) then
exit;
Inc(sum, digit);
Dec(i, 2);
end;
sum := (sum * 3);
i := (len - 1);
while ((i >= 0)) do
begin
digit := Ord(s[i]) - ZeroInt;
if ((digit < 0) or (digit > 9)) then
exit;
Inc(sum, digit);
Dec(i, 2);
end;
{$ZEROBASEDSTRINGS OFF}
Result := ((sum mod 10) = 0);
end;
class function TUPCEANReader.decodeEnd(const row: IBitArray;
const endStart: Integer): TArray<Integer>;
begin
Result := findGuardPattern(row, endStart, false, START_END_PATTERN);
end;
class function TUPCEANReader.findStartGuardPattern(const row: IBitArray)
: TArray<Integer>;
var
foundStart: Boolean;
startRange, counters: TArray<Integer>;
nextStart, start, quietStart, idx, l: Integer;
begin
Result := nil;
foundStart := false;
startRange := nil;
nextStart := 0;
counters := TArray<Integer>.Create();
l := Length(START_END_PATTERN);
SetLength(counters, l);
while (not foundStart) do
begin
for idx := 0 to l - 1 do
counters[idx] := 0;
startRange := findGuardPattern(row, nextStart, false, START_END_PATTERN,
counters);
if (startRange = nil) then
exit;
start := startRange[0];
nextStart := startRange[1];
// Make sure there is a quiet zone at least as big as the start pattern before the barcode.
// If this check would run off the left edge of the image, do not accept this barcode,
// as it is very likely to be a false positive.
quietStart := start - (nextStart - start);
if (quietStart >= 0) then
foundStart := row.isRange(quietStart, start, false);
end;
counters:=nil;
Result := startRange;
end;
class function TUPCEANReader.findGuardPattern(const row: IBitArray;
const rowOffset: Integer; const whiteFirst: Boolean;
const pattern: TArray<Integer>): TArray<Integer>;
var
counters: TArray<Integer>;
begin
counters := TArray<Integer>.Create();
SetLength(counters, Length(pattern));
Result := findGuardPattern(row, rowOffset, whiteFirst, pattern, counters);
counters:=nil;
end;
class function TUPCEANReader.findGuardPattern(const row: IBitArray;
rowOffset: Integer; const whiteFirst: Boolean; const pattern: TArray<Integer>;
counters: TArray<Integer>): TArray<Integer>;
var
patternLength, width, x: Integer;
isWhite: Boolean;
counterPosition, patternStart: Integer;
curCounter: TArray<Integer>;
begin
Result := nil;
patternLength := Length(pattern);
width := row.Size;
isWhite := whiteFirst;
if whiteFirst then
rowOffset := row.getNextUnset(rowOffset)
else
rowOffset := row.getNextSet(rowOffset);
counterPosition := 0;
patternStart := rowOffset;
for x := rowOffset to Pred(width) do
begin
if (row[x] xor isWhite) then
Inc(counters[counterPosition])
else
begin
if (counterPosition = (patternLength - 1)) then
begin
if (patternMatchVariance(counters, pattern, MAX_INDIVIDUAL_VARIANCE) <
MAX_AVG_VARIANCE) then
begin
Result := TArray<Integer>.Create(patternStart, x);
break;
end;
Inc(patternStart, (counters[0] + counters[1]));
curCounter := TArray<Integer>.Create();
SetLength(curCounter, Length(counters));
TArray.Copy<Integer>(counters, curCounter, 2, 0, (patternLength - 2));
{ curCounter[patternLength - 2] := 0;
curCounter[patternLength - 1] := 0; }
counters := curCounter;
Dec(counterPosition);
end
else
Inc(counterPosition);
counters[counterPosition] := 1;
isWhite := not isWhite;
end;
end;
end;
class function TUPCEANReader.decodeDigit(const row: IBitArray;
const counters: TArray<Integer>; const rowOffset: Integer;
const patterns: TArray<TArray<Integer>>; var digit: Integer): Boolean;
var
bestVariance, variance, i, max: Integer;
pattern: TArray<Integer>;
begin
Result := false;
digit := -1;
if (not TOneDReader.recordPattern(row, rowOffset, counters)) then
exit;
bestVariance := TUPCEANReader.MAX_AVG_VARIANCE; // worst variance we'll accept
max := Length(patterns);
for i := 0 to Pred(max) do
begin
pattern := patterns[i];
variance := TOneDReader.patternMatchVariance(counters, pattern,
TUPCEANReader.MAX_INDIVIDUAL_VARIANCE);
if (variance < bestVariance) then
begin
bestVariance := variance;
digit := i;
end;
end;
Result := (digit >= 0);
end;
function TUPCEANReader.decodeRow(const rowNumber: Integer; const row: IBitArray;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
startRange: TArray<Integer>;
begin
startRange := findStartGuardPattern(row);
if startRange = nil then
exit(nil);
try
Result := DoDecodeRow(rowNumber, row, startRange, hints);
except
result := nil;
end;
end;
function TUPCEANReader.DoDecodeRow(const rowNumber: Integer;
const row: IBitArray;
const startGuardRange: TArray<Integer>;
const hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
len: Integer;
res: TStringBuilder;
resultString: String;
endStart, ending, quietEnd: Integer;
endRange: TArray<Integer>;
resultPoints: TArray<IResultPoint>;
left, right: Single;
resultPointCallback: TResultPointCallback;
obj: TObject;
resPoint: IResultPoint;
decodeResult, extensionResult: TReadResult;
format: TBarcodeFormat;
allowedExtensions: TArray<Integer>;
valid: Boolean;
extensionLength: Integer;
countryID: String;
begin
Result := nil;
resultPointCallback := nil;
if ((hints <> nil) and
(hints.ContainsKey(TDecodeHintType.NEED_RESULT_POINT_CALLBACK))) then
begin
obj := hints[TDecodeHintType.NEED_RESULT_POINT_CALLBACK];
if (obj is TResultPointEventObject) then
resultPointCallback := TResultPointEventObject(obj).Event;
end;
res := decodeRowStringBuffer;
res.Length := 0;
endStart := DecodeMiddle(row, startGuardRange, res);
if (endStart < 0) then
exit;
if Assigned(resultPointCallback) then
begin
resPoint := TResultPointHelpers.CreateResultPoint(endStart, rowNumber);
resultPointCallback(resPoint);
end;
endRange := decodeEnd(row, endStart);
if (endRange = nil) then
exit;
if Assigned(resultPointCallback) then
begin
resPoint := TResultPointHelpers.CreateResultPoint
((endRange[0] + endRange[1]) div 2, rowNumber);
resultPointCallback(resPoint);
end;
ending := endRange[1];
quietEnd := (ending + (ending - endRange[0]));
if ((quietEnd >= row.Size) or not row.isRange(ending, quietEnd, false)) then
exit;
resultString := res.ToString;
if (Length(resultString) < 8) then
exit;
if (not checkChecksum(resultString)) then
exit;
left := ((startGuardRange[1] + startGuardRange[0]) div 2);
right := ((endRange[1] + endRange[0]) div 2);
format := BarcodeFormat;
resultPoints := TArray<IResultPoint>.Create
(TResultPointHelpers.CreateResultPoint(left, rowNumber),
TResultPointHelpers.CreateResultPoint(right, rowNumber));
decodeResult := TReadResult.Create(resultString, nil, resultPoints, format);
extensionResult := extensionReader.decodeRow(rowNumber, row, endRange[1]);
if (extensionResult <> nil) then
begin
decodeResult.putMetadata(TResultMetadataType.UPC_EAN_EXTENSION,
TResultMetaData.CreateStringMetadata(extensionResult.Text));
decodeResult.putAllMetadata(extensionResult.ResultMetadata);
decodeResult.addResultPoints(extensionResult.resultPoints);
extensionLength := Length(extensionResult.Text);
extensionResult.Free;
if (hints <> nil) and
(hints.ContainsKey(TDecodeHintType.ALLOWED_EAN_EXTENSIONS)) then
allowedExtensions := TArray<Integer>
(hints[TDecodeHintType.ALLOWED_EAN_EXTENSIONS])
else
allowedExtensions := nil;
if (allowedExtensions <> nil) then
begin
valid := false;
for len in allowedExtensions do
begin
if (extensionLength = len) then
begin
valid := true;
break;
end;
end;
if (not valid) then
exit;
end
end;
case format of
TBarcodeFormat.EAN_13, TBarcodeFormat.UPC_A:
begin
countryID := eanManSupport.lookupCountryIdentifier(resultString);
if (countryID <> '') then
decodeResult.putMetadata(TResultMetadataType.POSSIBLE_COUNTRY,
TResultMetaData.CreateStringMetadata(countryID));
end;
end;
Result := decodeResult;
end;
initialization
TUPCEANReader.InitializeClass;
finalization
TUPCEANReader.FinalizeClass;
end.
@@ -0,0 +1,235 @@
unit ZXing.OneD.UPCEReader;
{
* 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
* Delphi Implementation by E. Spelt
}
interface
uses
System.SysUtils,
System.Generics.Collections,
Math,
ZXing.OneD.OneDReader,
ZXing.Common.BitArray,
ZXing.BinaryBitmap,
ZXing.ReadResult,
ZXing.DecodeHintType,
ZXing.ResultPoint,
ZXing.BarcodeFormat,
ZXing.Helpers,
ZXing.OneD.EAN13Reader,
ZXing.OneD.UPCEANReader;
type
T2DIntArray = TArray<TArray<Integer>>;
TUPCEReader = class(TUPCEANReader)
private
class var decodeMiddleCounters: TArray<Integer>;
class var MIDDLE_END_PATTERN: TArray<Integer>;
class var NUMSYS_AND_CHECK_DIGIT_PATTERNS: T2DIntArray;
class procedure DoInitialize();
class procedure DoFinalize();
class function determineNumSysAndCheckDigit(resultString: TStringBuilder;
lgPatternFound: Integer): boolean; static;
protected
class function checkChecksum(const s: string): boolean; override;
class function decodeEnd(const row: IBitArray; const endStart: Integer)
: TArray<Integer>; override;
public
class function DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const res: TStringBuilder)
: Integer; override;
public
class function convertUPCEtoUPCA(upce: string): string; static;
function BarcodeFormat: TBarcodeFormat; override;
end;
implementation
{ TUPCEReader }
class function TUPCEReader.determineNumSysAndCheckDigit
(resultString: TStringBuilder; lgPatternFound: Integer): boolean;
var
numSys, d: Integer;
begin
numSys := 0;
while ((numSys <= 1)) do
begin
d := 0;
while ((d < 10)) do
begin
if (lgPatternFound = TUPCEReader.NUMSYS_AND_CHECK_DIGIT_PATTERNS
[numSys][d]) then
begin
resultString.Insert(0, Char($30 + numSys) );
resultString.Append(char($30 + d));
begin
Result := true;
exit
end
end;
inc(d)
end;
inc(numSys)
end;
Result := false;
end;
class function TUPCEReader.checkChecksum(const s: string): boolean;
begin
Result := inherited checkChecksum(TUPCEReader.convertUPCEtoUPCA(s))
end;
class function TUPCEReader.convertUPCEtoUPCA(upce: string): string;
var
upceChars: string;
res: TStringBuilder;
lastChar: char;
begin
upceChars := upce.Substring(1, 6);
res := TStringBuilder.Create(12);
res.Append(upce.Chars[0]);
lastChar := upceChars.Chars[5];
case lastChar of
'0', '1', '2':
begin
res.Append(upceChars, 0, 2);
res.Append(lastChar);
res.Append('0000');
res.Append(upceChars, 2, 3);
end;
'3':
begin
res.Append(upceChars, 0, 3);
res.Append('00000');
res.Append(upceChars, 3, 2);
end;
'4':
begin
res.Append(upceChars, 0, 4);
res.Append('00000');
res.Append(upceChars.Chars[4]);
end;
else
begin
res.Append(upceChars, 0, 5);
res.Append('0000');
res.Append(lastChar);
end;
end;
res.Append(upce.Chars[7]);
Result := res.ToString;
res.Free;
end;
class function TUPCEReader.decodeEnd(const row: IBitArray;
const endStart: Integer): TArray<Integer>;
begin
Result := TUPCEANReader.findGuardPattern(row, endStart, true,
TUPCEReader.MIDDLE_END_PATTERN);
end;
class function TUPCEReader.DecodeMiddle(const row: IBitArray;
const startRange: TArray<Integer>; const res: TStringBuilder): Integer;
var
bestMatch: Integer;
counter, ending, lgPatternFound, rowOffset, x: Integer;
counters: TArray<Integer>;
begin
counters := self.decodeMiddleCounters;
counters[0] := 0;
counters[1] := 0;
counters[2] := 0;
counters[3] := 0;
ending := row.Size;
rowOffset := startRange[1];
lgPatternFound := 0;
x := 0;
while ((x < 6) and (rowOffset < ending)) do
begin
if (not TUPCEANReader.decodeDigit(row, counters, rowOffset,
TUPCEANReader.L_AND_G_PATTERNS, bestMatch)) then
begin
exit(-1);
end;
res.Append(Char(ord('0') + bestMatch mod 10));
for counter in counters do
begin
inc(rowOffset, counter)
end;
if (bestMatch >= 10) then
lgPatternFound := lgPatternFound or (1 shl (5 - x));
inc(x)
end;
if (not TUPCEReader.determineNumSysAndCheckDigit(res, lgPatternFound)) then
begin
exit(-1);
end;
Result := rowOffset;
end;
function TUPCEReader.BarcodeFormat: TBarcodeFormat;
begin
Result := TBarcodeFormat.UPC_E;
end;
class procedure TUPCEReader.DoInitialize;
begin
MIDDLE_END_PATTERN := TArray<Integer>.Create(1, 1, 1, 1, 1, 1);
NUMSYS_AND_CHECK_DIGIT_PATTERNS :=
T2DIntArray.Create(TArray<Integer>.Create($38, $34, 50, $31, $2C, $26, $23,
$2A, $29, $25), TArray<Integer>.Create(7, 11, 13, 14, $13, $19, $1C, $15,
$16, $1A));
decodeMiddleCounters := TArray<Integer>.Create(0,0,0,0);
end;
class procedure TUPCEReader.DoFinalize;
begin
MIDDLE_END_PATTERN := nil;
NUMSYS_AND_CHECK_DIGIT_PATTERNS := nil;
decodeMiddleCounters := nil;
end;
initialization
TUPCEReader.DoInitialize;
finalization
TUPCEReader.DoFinalize;
end.
@@ -0,0 +1,564 @@
{
* 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 K. Gossens
}
unit ZXing.Datamatrix.Internal.BitMatrixParser;
interface
uses
System.SysUtils,
System.Generics.Collections,
ZXing.DecodeHintType,
ZXing.Common.BitMatrix,
ZXing.QrCode.Internal.FormatInformation,
ZXing.Common.Detector.MathUtils,
ZXing.Datamatrix.Internal.Version;
type
TBitMatrixParser = class sealed
private
mappingBitMatrix: TBitMatrix;
readMappingMatrix: TBitMatrix;
Fversion: TVersion;
/// <summary>
/// <p>Reads a bit of the mapping matrix accounting for boundary wrapping.</p>
///
/// <param name="row">Row to read in the mapping matrix</param>
/// <param name="column">Column to read in the mapping matrix</param>
/// <param name="numRows">Number of rows in the mapping matrix</param>
/// <param name="numColumns">Number of columns in the mapping matrix</param>
/// <returns>value of the given bit in the mapping matrix</returns>
/// </summary>
function readModule(row, column, numRows, numColumns: Integer): Boolean;
/// <summary>
/// <p>Reads the 8 bits of the standard Utah-shaped pattern.</p>
///
/// <p>See ISO 16022:2006, 5.8.1 Figure 6</p>
///
/// <param name="row">Current row in the mapping matrix, anchored at the 8th bit (LSB) of the pattern</param>
/// <param name="column">Current column in the mapping matrix, anchored at the 8th bit (LSB) of the pattern</param>
/// <param name="numRows">Number of rows in the mapping matrix</param>
/// <param name="numColumns">Number of columns in the mapping matrix</param>
/// <returns>byte from the utah shape</returns>
/// </summary>
function readUtah(row, column, numRows, numColumns: Integer): Integer;
/// <summary>
/// <p>Reads the 8 bits of the special corner condition 1.</p>
///
/// <p>See ISO 16022:2006, Figure F.3</p>
///
/// <param name="numRows">Number of rows in the mapping matrix</param>
/// <param name="numColumns">Number of columns in the mapping matrix</param>
/// <returns>byte from the Corner condition 1</returns>
/// </summary>
function readCorner1(numRows, numColumns: Integer): Integer;
/// <summary>
/// <p>Reads the 8 bits of the special corner condition 2.</p>
///
/// <p>See ISO 16022:2006, Figure F.4</p>
///
/// <param name="numRows">Number of rows in the mapping matrix</param>
/// <param name="numColumns">Number of columns in the mapping matrix</param>
/// <returns>byte from the Corner condition 2</returns>
/// </summary>
function readCorner2(numRows, numColumns: Integer): Integer;
/// <summary>
/// <p>Reads the 8 bits of the special corner condition 3.</p>
///
/// <p>See ISO 16022:2006, Figure F.5</p>
///
/// <param name="numRows">Number of rows in the mapping matrix</param>
/// <param name="numColumns">Number of columns in the mapping matrix</param>
/// <returns>byte from the Corner condition 3</returns>
/// </summary>
function readCorner3(numRows, numColumns: Integer): Integer;
/// <summary>
/// <p>Reads the 8 bits of the special corner condition 4.</p>
///
/// <p>See ISO 16022:2006, Figure F.6</p>
///
/// <param name="numRows">Number of rows in the mapping matrix</param>
/// <param name="numColumns">Number of columns in the mapping matrix</param>
/// <returns>byte from the Corner condition 4</returns>
/// </summary>
function readCorner4(numRows, numColumns: Integer): Integer;
/// <summary>
/// <p>Creates the version object based on the dimension of the original bit matrix from
/// the datamatrix code.</p>
///
/// <p>See ISO 16022:2006 Table 7 - ECC 200 symbol attributes</p>
///
/// <param name="bitMatrix">Original <see cref="BitMatrix" />including alignment patterns</param>
/// <returns><see cref="Version" />encapsulating the Data Matrix Code's "version"</returns>
/// <exception cref="FormatException">if the dimensions of the mapping matrix are not valid</exception>
/// Data Matrix dimensions.
/// </summary>
function readVersion(BitMatrix: TBitMatrix): TVersion;
public
/// <param name="bitMatrix">{@link TBitMatrix} to parse</param>
/// <throws>ReaderException if dimension is not >= 21 and 1 mod 4</throws>
constructor Create(const BitMatrix: TBitMatrix);
/// <summary>
/// <p>Extracts the data region from a <see cref="BitMatrix" />that contains
/// alignment patterns.</p>
///
/// <param name="bitMatrix">Original <see cref="BitMatrix" />with alignment patterns</param>
/// <returns>BitMatrix that has the alignment patterns removed</returns>
/// </summary>
function extractDataRegion(BitMatrix: TBitMatrix): TBitMatrix;
/// <summary>
/// <p>Reads the bits in the <see cref="BitMatrix" />representing the mapping matrix (No alignment patterns)
/// in the correct order in order to reconstitute the codewords bytes contained within the
/// Data Matrix Code.</p>
///
/// <returns>bytes encoded within the Data Matrix Code</returns>
/// <exception cref="FormatException">if the exact number of bytes expected is not read</exception>
/// </summary>
function readCodewords: TArray<Byte>;
destructor Destroy; override;
property Version: TVersion read Fversion;
end;
implementation
{ TBitMatrixParser }
constructor TBitMatrixParser.Create(const BitMatrix: TBitMatrix);
var
dimension: Integer;
begin
dimension := BitMatrix.Height;
if (((dimension >= 8) and (dimension <= 144)) and ((dimension and $01) = 0))
then
begin
self.Fversion := readVersion(BitMatrix);
if (self.Version <> nil) then
begin
self.mappingBitMatrix := extractDataRegion(BitMatrix);
self.readMappingMatrix := TBitMatrix.Create(self.mappingBitMatrix.Width,
self.mappingBitMatrix.Height)
end;
end;
end;
destructor TBitMatrixParser.Destroy;
begin
self.mappingBitMatrix.Free;
self.readMappingMatrix.Free;
inherited;
end;
function TBitMatrixParser.readVersion(BitMatrix: TBitMatrix): TVersion;
begin
Result := TVersion.getVersionForDimensions(BitMatrix.Height, BitMatrix.Width);
end;
function TBitMatrixParser.readCodewords: TArray<Byte>;
var
resultOffset, row, column, numRows, numColumns: Integer;
corner1Read, corner2Read, corner3Read, corner4Read: Boolean;
begin
Result := TArray<Byte>.Create();
SetLength(Result, Version.TotalCodewords);
resultOffset := 0;
row := 4;
column := 0;
numRows := self.mappingBitMatrix.Height;
numColumns := self.mappingBitMatrix.Width;
corner1Read := false;
corner2Read := false;
corner3Read := false;
corner4Read := false;
// Read all of the codewords
while ((row < numRows) or (column < numColumns)) do
begin
// Check the four corner cases
if ((row = numRows) and (column = 0) and (not corner1Read)) then
begin
Result[resultOffset] := Byte(readCorner1(numRows, numColumns));
Inc(resultOffset);
Dec(row, 2);
Inc(column, 2);
corner1Read := true;
end
else
begin
if ((row = (numRows - 2)) and (column = 0) and ((numColumns and $03) <> 0)
and (not corner2Read)) then
begin
Result[resultOffset] := Byte(readCorner2(numRows, numColumns));
Inc(resultOffset);
Dec(row, 2);
Inc(column, 2);
corner2Read := true;
end
else
begin
if ((row = (numRows + 4)) and (column = 2) and
((numColumns and $07) = 0) and (not corner3Read)) then
begin
Result[resultOffset] := Byte(readCorner3(numRows, numColumns));
Inc(resultOffset);
Dec(row, 2);
Inc(column, 2);
corner3Read := true;
end
else
begin
if ((row = (numRows - 2)) and (column = 0) and
((numColumns and $07) = 4) and (not corner4Read)) then
begin
Result[resultOffset] := Byte(readCorner4(numRows, numColumns));
Inc(resultOffset);
Dec(row, 2);
Inc(column, 2);
corner4Read := true;
end
else
begin
// Sweep upward diagonally to the right
while ((row >= 0) and (column < numColumns)) do
begin
if ((row < numRows) and (column >= 0) and
(not readMappingMatrix[column, row])) then
begin
Result[resultOffset] :=
Byte(readUtah(row, column, numRows, numColumns));
Inc(resultOffset);
end;
Dec(row, 2);
Inc(column, 2)
end;
Inc(row);
Inc(column, 3);
// Sweep downward diagonally to the left
while ((row < numRows) and (column >= 0)) do
begin
if ((row >= 0) and (column < numColumns) and
(not readMappingMatrix[column, row])) then
begin
Result[resultOffset] :=
Byte(readUtah(row, column, numRows, numColumns));
Inc(resultOffset);
end;
Inc(row, 2);
Dec(column, 2)
end;
Inc(row, 3);
Inc(column)
end;
end;
end;
end;
end;
if (resultOffset <> Version.TotalCodewords) then
Result := nil;
end;
function TBitMatrixParser.readModule(row, column, numRows,
numColumns: Integer): Boolean;
begin
// Adjust the row and column indices based on boundary wrapping
if (row < 0) then
begin
Inc(row, numRows);
Inc(column, (4 - ((numRows + 4) and $07)))
end;
if (column < 0) then
begin
Inc(column, numColumns);
Inc(row, (4 - ((numColumns + 4) and $07)))
end;
readMappingMatrix[column, row] := true;
Result := mappingBitMatrix[column, row];
end;
function TBitMatrixParser.readUtah(row, column, numRows,
numColumns: Integer): Integer;
var
currentByte: Byte;
begin
currentByte := 0;
if (readModule((row - 2), (column - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((row - 2), (column - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((row - 1), (column - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((row - 1), (column - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((row - 1), column, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(row, (column - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(row, (column - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(row, column, numRows, numColumns)) then
currentByte := (currentByte or 1);
Result := currentByte;
end;
function TBitMatrixParser.readCorner1(numRows, numColumns: Integer): Integer;
var
currentByte: Byte;
begin
currentByte := 0;
if (readModule((numRows - 1), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((numRows - 1), 1, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((numRows - 1), 2, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(1, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(2, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(3, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
Result := currentByte;
end;
function TBitMatrixParser.readCorner2(numRows, numColumns: Integer): Integer;
var
currentByte: Byte;
begin
currentByte := 0;
if (readModule((numRows - 3), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((numRows - 2), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((numRows - 1), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 4), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 3), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(1, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
Result := currentByte;
end;
function TBitMatrixParser.readCorner3(numRows, numColumns: Integer): Integer;
var
currentByte: Byte;
begin
currentByte := 0;
if (readModule((numRows - 1), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((numRows - 1), (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 3), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(1, (numColumns - 3), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(1, (numColumns - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(1, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
Result := currentByte;
end;
function TBitMatrixParser.readCorner4(numRows, numColumns: Integer): Integer;
var
currentByte: Byte;
begin
currentByte := 0;
if (readModule((numRows - 3), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((numRows - 2), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule((numRows - 1), 0, numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (self.readModule(0, (numColumns - 2), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(0, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(1, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(2, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
currentByte := (currentByte shl 1);
if (readModule(3, (numColumns - 1), numRows, numColumns)) then
currentByte := (currentByte or 1);
Result := currentByte;
end;
function TBitMatrixParser.extractDataRegion(BitMatrix: TBitMatrix): TBitMatrix;
var
i, j, symbolSizeRows, dataRegionSizeRows,
dataRegionSizeColumns, numDataRegionsRow, numDataRegionsColumn,
sizeDataRegionRow, sizeDataRegionColumn, dataRegionRow, dataRegionRowOffset,
dataRegionColumn, dataRegionColumnOffset, readRowOffset, writeRowOffset,
readColumnOffset, writeColumnOffset: Integer;
bitMatrixWithoutAlignment: TBitMatrix;
begin
symbolSizeRows := Version.symbolSizeRows;
if (BitMatrix.Height <> symbolSizeRows) then
raise EArgumentException.Create
('Dimension of bitMarix must match the version size');
dataRegionSizeRows := Version.dataRegionSizeRows;
dataRegionSizeColumns := Version.dataRegionSizeColumns;
numDataRegionsRow := (symbolSizeRows div dataRegionSizeRows);
numDataRegionsColumn := (Version.symbolSizeColumns div dataRegionSizeColumns);
sizeDataRegionRow := (numDataRegionsRow * dataRegionSizeRows);
sizeDataRegionColumn := (numDataRegionsColumn * dataRegionSizeColumns);
bitMatrixWithoutAlignment := TBitMatrix.Create(sizeDataRegionColumn,
sizeDataRegionRow);
for dataRegionRow := 0 to Pred(numDataRegionsRow) do
begin
dataRegionRowOffset := (dataRegionRow * dataRegionSizeRows);
for dataRegionColumn := 0 to Pred(numDataRegionsColumn) do
begin
dataRegionColumnOffset := (dataRegionColumn * dataRegionSizeColumns);
for i := 0 to Pred(dataRegionSizeRows) do
begin
readRowOffset := (dataRegionRow * (dataRegionSizeRows + 2)) + 1 + i;
writeRowOffset := (dataRegionRowOffset + i);
for j := 0 to Pred(dataRegionSizeColumns) do
begin
readColumnOffset :=
(dataRegionColumn * (dataRegionSizeColumns + 2)) + 1 + j;
if (BitMatrix[readColumnOffset, readRowOffset]) then
begin
writeColumnOffset := (dataRegionColumnOffset + j);
bitMatrixWithoutAlignment[writeColumnOffset,
writeRowOffset] := true;
end;
end;
end;
end;
end;
Result := bitMatrixWithoutAlignment;
end;
end.
@@ -0,0 +1,179 @@
{
* 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 K. Gossens
}
unit ZXing.Datamatrix.Internal.DataBlock;
interface
uses
System.SysUtils,
ZXing.Datamatrix.Internal.Version;
type
/// <summary>
/// <p>Encapsulates a block of data within a Data Matrix Code. Data Matrix Codes may split their data into
/// multiple blocks, each of which is a unit of data and error-correction codewords. Each
/// is represented by an instance of this class.</p>
/// </summary>
TDataBlock = class sealed
private
Fcodewords: TArray<Byte>;
FNumDataCodewords: Integer;
public
constructor Create(const Acodewords: TArray<Byte>;
const ANumDataCodewords: Integer);
destructor Destroy;override;
class function getDataBlocks(rawCodewords: TArray<Byte>;
version: TVersion): TArray<TDataBlock>;
property codewords: TArray<Byte> read Fcodewords;
property NumDataCodewords: Integer read FNumDataCodewords;
end;
implementation
{ TDataBlock }
constructor TDataBlock.Create(const Acodewords: TArray<Byte>;
const ANumDataCodewords: Integer);
begin
FnumDataCodewords := AnumDataCodewords;
Fcodewords := Acodewords;
end;
destructor TDataBlock.Destroy;
begin
Fcodewords := nil;
inherited;
end;
class function TDataBlock.getDataBlocks(rawCodewords: TArray<Byte>;
version: TVersion): TArray<TDataBlock>;
var
i, j: Integer;
ecBlock : TVersion.TECB;
ecBlocks : TVersion.TECBlocks;
totalBlocks : Integer;
ecBlockArray : TArray<TVersion.TECB>;
byteArray : TArray<Byte>;
numResultBlocks,
numDataCodewords,
numBlockCodewords,
longerBlocksTotalCodewords,
//shorterBlocksTotalCodewords
longerBlocksNumDataCodewords,
shorterBlocksNumDataCodewords,
rawCodewordsOffset,
numLongerBlocks,
max,
iOffset,
jOffset : Integer;
specialVersion: Boolean;
begin
// Figure out the number and size of data blocks used by this version
ecBlocks := version.ecBlocks;
// First count the total number of data blocks
totalBlocks := 0;
ecBlockArray := ecBlocks.ECBBlocksValue;
for ecBlock in ecBlockArray do
begin
inc(totalBlocks, ecBlock.Count)
end;
// Now establish DataBlocks of the appropriate size and number of data codewords
result := TArray<TDataBlock>.Create();
SetLength(result, totalBlocks);
numResultBlocks := 0;
for ecBlock in ecBlockArray do
begin
for i := 0 to Pred(ecBlock.Count) do
begin
numDataCodewords := ecBlock.DataCodewords;
numBlockCodewords := (ecBlocks.ECCodewords + numDataCodewords);
byteArray := TArray<Byte>.Create();
SetLength(byteArray, numBlockCodewords);
result[numResultBlocks] := TDataBlock.Create(byteArray, numDataCodewords);
Inc(numResultBlocks);
end
end;
// All blocks have the same amount of data, except that the last n
// (where n may be 0) have 1 less byte. Figure out where these start.
// TODO: There is only one case where there is a difference for Data Matrix for size 144
longerBlocksTotalCodewords := Length(result[0].codewords);
//shorterBlocksTotalCodewords := (longerBlocksTotalCodewords - 1);
longerBlocksNumDataCodewords := (longerBlocksTotalCodewords - ecBlocks.ECCodewords);
shorterBlocksNumDataCodewords := (longerBlocksNumDataCodewords - 1);
// The last elements of result may be 1 element shorter for 144 matrix
// first fill out as many elements as all of them have minus 1
rawCodewordsOffset := 0;
for i := 0 to Pred(shorterBlocksNumDataCodewords) do
begin
for j := 0 to Pred(numResultBlocks) do
begin
result[j].codewords[i] := rawCodewords[rawCodewordsOffset];
Inc(rawCodewordsOffset);
end;
end;
// Fill out the last data block in the longer ones
specialVersion := (version.versionNumber = 24);
if specialVersion
then
numLongerBlocks := 8
else
numLongerBlocks := numResultBlocks;
for j := 0 to Pred(numLongerBlocks) do
begin
result[j].codewords[(longerBlocksNumDataCodewords - 1)] := rawCodewords[rawCodewordsOffset];
Inc(rawCodewordsOffset);
end;
// Now add in error correction blocks
max := Length(result[0].codewords);
for i := longerBlocksNumDataCodewords to Pred(max) do
begin
for j := 0 to Pred(numResultBlocks) do
begin
if (specialVersion)
then
jOffset := (j + 8) mod numResultBlocks
else
jOffset := j;
if (specialVersion and (jOffset > 7))
then
iOffset := (i - 1)
else
iOffset := i;
result[jOffset].codewords[iOffset] := rawCodewords[rawCodewordsOffset];
Inc(rawCodewordsOffset);
end;
end;
if (not (rawCodewordsOffset = Length(rawCodewords)))
then
raise EArgumentException.Create('Arguments error');
end;
end.
@@ -0,0 +1,903 @@
{
* 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: bbrown@google.com (Brian Brown) and Sean Owen
* Delphi Implementation by K. Gossens
}
unit ZXing.Datamatrix.Internal.DecodedBitStreamParser;
interface
uses
System.SysUtils,
System.Generics.Collections,
ZXing.DecoderResult,
ZXing.ByteSegments,
ZXing.BitSource;
type
/// <summary>
/// <p>Data Matrix Codes can encode text as bits in one of several modes, and can use multiple modes
/// in one Data Matrix Code. This class decodes the bits back into text.</p>
///
/// <p>See ISO 16022:2006, 5.2.1 - 5.2.9.2</p>
/// </summary>
TDecodedBitStreamParser = class abstract
type
TMode = (PAD_ENCODE, // Not really a mode
ASCII_ENCODE, C40_ENCODE, TEXT_ENCODE, ANSIX12_ENCODE, EDIFACT_ENCODE,
BASE256_ENCODE);
private
class var C40_BASIC_SET_CHARS, C40_SHIFT2_SET_CHARS, TEXT_BASIC_SET_CHARS,
TEXT_SHIFT2_SET_CHARS, TEXT_SHIFT3_SET_CHARS: TArray<Char>;
class procedure InitializeClass;
class procedure FinalizeClass;
class function decodeC40Segment(bits: TBitSource;
res: TStringBuilder): boolean;
class function decodeTextSegment(bits: TBitSource;
res: TStringBuilder): boolean;
class function decodeAnsiX12Segment(bits: TBitSource;
res: TStringBuilder): boolean;
class function decodeEdifactSegment(bits: TBitSource;
res: TStringBuilder): boolean;
class function decodeBase256Segment(bits: TBitSource; res: TStringBuilder;
byteSegments:IByteSegments ): boolean;
class function decodeAsciiSegment(bits: TBitSource; res: TStringBuilder;
resultTrailer: TStringBuilder; var mode: TMode): boolean;
class procedure parseTwoBytes(firstByte: Integer; secondByte: Integer;
result: TArray<Integer>);
class function unrandomize255State(randomizedBase256Codeword: Integer;
base256CodewordPosition: Integer): Integer;
public
class function decode(bytes: TArray<Byte>): TDecoderResult;
end;
implementation
{ TDecodedBitStreamParser }
class function TDecodedBitStreamParser.decode(bytes: TArray<Byte>)
: TDecoderResult;
var
bits: TBitSource;
res, resultTrailer: TStringBuilder;
byteSegments: IByteSegments;
mode: TMode;
begin
bits := TBitSource.Create(bytes);
res := TStringBuilder.Create(100);
resultTrailer := TStringBuilder.Create(0);
byteSegments := ByteSegmentsCreate;
try
byteSegments.Add(TArray<Byte>.Create()); // TODO (KG): Validation
mode := TMode.ASCII_ENCODE;
while ((mode <> TMode.PAD_ENCODE) and (bits.available() > 0)) do
begin
if (mode = TMode.ASCII_ENCODE) then
begin
if (not TDecodedBitStreamParser.decodeAsciiSegment(bits, res,
resultTrailer, mode)) then
begin
result := nil; // this line was totally missing. I assume the correct thing is to set result = nil.
exit;
end;
end
else
begin
case mode of
TMode.C40_ENCODE:
begin
if (not TDecodedBitStreamParser.decodeC40Segment(bits, res)) then
begin
result := nil;
exit;
end;
end;
TMode.TEXT_ENCODE:
begin
if (not TDecodedBitStreamParser.decodeTextSegment(bits, res)) then
begin
result := nil;
exit;
end;
end;
TMode.ANSIX12_ENCODE:
begin
if (not TDecodedBitStreamParser.decodeAnsiX12Segment(bits, res))
then
begin
result := nil;
exit;
end;
end;
TMode.EDIFACT_ENCODE:
begin
if (not TDecodedBitStreamParser.decodeEdifactSegment(bits, res))
then
begin
result := nil;
exit;
end;
end;
TMode.BASE256_ENCODE:
begin
if (not TDecodedBitStreamParser.decodeBase256Segment(bits, res,
byteSegments)) then
begin
result := nil;
exit;
end;
end;
else
begin
result := nil;
exit;
end;
end;
mode := TMode.ASCII_ENCODE;
end;
end;
if (resultTrailer.Length > 0) then
res.Append(resultTrailer.ToString);
if (byteSegments.Count = 0) then
result := TDecoderResult.Create(bytes, res.ToString, nil, '')
else
result := TDecoderResult.Create(bytes, res.ToString, byteSegments, '');
finally
bits.Free;
res.Free;
resultTrailer.Free;
//
// for i := 0 to byteSegments.Count - 1 do
// begin
//
// end;
//
// byteSegments.Free;
end;
end;
/// <summary>
/// See ISO 16022:2006, 5.2.7
/// </summary>
class function TDecodedBitStreamParser.decodeAnsiX12Segment(bits: TBitSource;
res: TStringBuilder): boolean;
var
i: Integer;
cValues: TArray<Integer>;
firstByte: Integer;
cValue: Integer;
begin
// Three ANSI X12 values are encoded in a 16-bit value as
// (1600 * C1) + (40 * C2) + C3 + 1
cValues := TArray<Integer>.Create(0, 0, 0);
while (bits.available() > 0) do
begin
// If there is only one byte left then it will be encoded as ASCII
if (bits.available = 8) then
begin
result := true;
exit;
end;
firstByte := bits.readBits(8);
if (firstByte = 254) then
begin
// Unlatch codeword
result := true;
exit;
end;
TDecodedBitStreamParser.parseTwoBytes(firstByte, bits.readBits(8), cValues);
for i := 0 to 2 do
begin
cValue := cValues[i];
case cValue of
0:
begin
// X12 segment terminator <CR>
res.Append(#13);
end;
1:
begin
// X12 segment separator *
res.Append('*');
end;
2:
begin
// X12 sub-element separator >
res.Append('>');
end;
3:
begin
// space
res.Append(' ');
end;
else
begin
if (cValue < 14) then
// 0 - 9
res.Append(Char(cValue + 44))
else if (cValue < 40) then
// A - Z
res.Append(Char(cValue + 51))
else
begin
result := false;
exit;
end;
end;
end;
end;
end;;
result := true;
end;
/// <summary>
/// See ISO 16022:2006, 5.2.3 and Annex C, Table C.2
/// </summary>
class function TDecodedBitStreamParser.decodeAsciiSegment(bits: TBitSource;
res: TStringBuilder; resultTrailer: TStringBuilder; var mode: TMode): boolean;
var
oneByte: Integer;
upperShift: boolean;
value: Byte;
begin
upperShift := false;
mode := TMode.ASCII_ENCODE;
while (bits.available() > 0) do
begin
oneByte := bits.readBits(8);
if (oneByte = 0) then
begin
result := false;
exit;
end
else
begin
if (oneByte <= 128) then
begin
// ASCII data (ASCII value + 1)
if (upperShift) then
begin
Inc(oneByte, 128);
// upperShift := false;
end;
res.Append(Char(oneByte - 1));
mode := TMode.ASCII_ENCODE;
result := true;
exit;
end
else
begin
if (oneByte = 129) then
begin
// Pad
mode := TMode.PAD_ENCODE;
result := true;
exit;
end
else
begin
if (oneByte <= 229) then
begin
// 2-digit data 00-99 (Numeric Value + 130)
value := (oneByte - 130);
if (value < 10) then
// pad with '0' for single digit values
res.Append('0');
res.Append(value);
end
else
begin
if (oneByte = 230) then
begin
// Latch to C40 encodation
mode := TMode.C40_ENCODE;
result := true;
exit;
end
else
begin
if (oneByte = 231) then
begin
// Latch to Base 256 encodation
mode := TMode.BASE256_ENCODE;
result := true;
exit;
end
else
begin
if (oneByte = 232) then
begin
// FNC1
res.Append(Char(29)); // translate as ASCII 29
end
else
begin
if ((oneByte = 233) or (oneByte = 234)) then
begin
// Structured Append, Reader Programming
// Ignore these symbols for now
// throw EReaderException.Instance;
end
else
begin
if (oneByte = 235) then
begin
// Upper Shift (shift to Extended ASCII)
upperShift := true;
end
else
begin
if (oneByte = 236) then
begin
// 05 Macro
res.Append('[)>' + #$001E05 + #$001D);
res.Insert(0, #$001E + #$0004);
end
else
begin
if (oneByte = 237) then
begin
// 06 Macro
res.Append('[)>' + #$001E06 + #$001D);
res.Insert(0, #$001E + #$0004);
end
else
begin
if (oneByte = 238) then
begin
// Latch to ANSI X12 encodation
mode := TMode.ANSIX12_ENCODE;
result := true;
exit;
end
else
begin
if (oneByte = 239) then
begin
// Latch to Text encodation
mode := TMode.TEXT_ENCODE;
result := true;
exit;
end
else
begin
if (oneByte = 240) then
begin
mode := TMode.EDIFACT_ENCODE;
result := true;
exit;
end
else
begin
if (oneByte = 241) then
begin
// ECI Character
// TODO: I think we need to support ECI
// throw TReaderException.Instance;
// Ignore this symbol for now
end
else if (oneByte >= 242) then
begin
// Not to be used in ASCII encodation
// ... but work around encoders that end with 254, latch back to ASCII
if ((oneByte <> 254) or (bits.available() <> 0)) then
begin
result := false;
exit;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
mode := TMode.ASCII_ENCODE;
result := true;
end;
/// <summary>
/// See ISO 16022:2006, 5.2.9 and Annex B, B.2
/// </summary>
class function TDecodedBitStreamParser.decodeBase256Segment(bits: TBitSource;
res: TStringBuilder; byteSegments: IByteSegments ): boolean;
var
i, Count, codewordPosition, d1: Integer;
bytes: TArray<Byte>;
begin
// Figure out how long the Base 256 Segment is.
codewordPosition := (1 + bits.ByteOffset); // position is 1-indexed
d1 := TDecodedBitStreamParser.unrandomize255State(bits.readBits(8),
codewordPosition);
Inc(codewordPosition);
if (d1 = 0) then
// Read the remainder of the symbol
Count := (bits.available div 8)
else if (d1 < 250) then
Count := d1
else
begin
Count := ((250 * (d1 - 249)) + TDecodedBitStreamParser.unrandomize255State
(bits.readBits(8), codewordPosition));
Inc(codewordPosition);
end;
// We're seeing NegativeArraySizeException errors from users.
if (Count < 0) then
begin
result := false;
exit;
end;
bytes := TArray<Byte>.Create();
SetLength(bytes, Count);
for i := 0 to Pred(Count) do
begin
// Have seen this particular error in the wild, such as at
// http://www.bcgen.com/demo/IDAutomationStreamingDataMatrix.aspx?MODE=3&D=Fred&PFMT=3&PT=F&X=0.3&O=0&LM=0.2
if (bits.available() < 8) then
begin
result := false;
exit;
end;
bytes[i] := Byte(TDecodedBitStreamParser.unrandomize255State
(bits.readBits(8), codewordPosition));
Inc(codewordPosition);
end;
byteSegments.Add(bytes);
try
res.Append(TEncoding.GetEncoding('ISO-8859-1').GetString(bytes))
except
on uee: Exception do
raise EInvalidOpException.Create
('Platform does not support required encoding: ' + uee.Message)
end;
result := true;
end;
/// <summary>
/// See ISO 16022:2006, 5.2.5 and Annex C, Table C.1
/// </summary>
class function TDecodedBitStreamParser.decodeC40Segment(bits: TBitSource;
res: TStringBuilder): boolean;
var
i: Integer;
c40char: Char;
cValues: TArray<Integer>;
upperShift: boolean;
shift: Integer;
firstByte: Byte;
cValue: Integer;
begin
// Three C40 values are encoded in a 16-bit value as
// (1600 * C1) + (40 * C2) + C3 + 1
// TODO: The Upper Shift with C40 doesn't work in the 4 value scenario all the time
upperShift := false;
cValues := TArray<Integer>.Create(0, 0, 0);
shift := 0;
while (bits.available() > 0) do
begin
// If there is only one byte left then it will be encoded as ASCII
if (bits.available() = 8) then
begin
result := true;
exit;
end;
firstByte := bits.readBits(8);
if (firstByte = 254) then
begin
// Unlatch codeword
result := true;
exit;
end;
TDecodedBitStreamParser.parseTwoBytes(firstByte, bits.readBits(8), cValues);
for i := 0 to 2 do
begin
cValue := cValues[i];
case shift of
0:
begin
if (cValue < 3) then
shift := (cValue + 1)
else
begin
if (cValue < Length(C40_BASIC_SET_CHARS)) then
begin
c40char := C40_BASIC_SET_CHARS[cValue];
if (upperShift) then
begin
res.Append(Char(c40char) + Char(128));
upperShift := false;
end
else
res.Append(c40char);
end
else
begin
result := false;
exit;
end;
end;
end;
1:
begin
if (upperShift) then
begin
res.Append(Char(cValue) + Char(128));
upperShift := false;
end
else
res.Append(Char(cValue));
shift := 0;
end;
2:
begin
if (cValue < Length(C40_SHIFT2_SET_CHARS)) then
begin
c40char := C40_SHIFT2_SET_CHARS[cValue];
if (upperShift) then
begin
res.Append(Char(c40char) + Char(128));
upperShift := false;
end
else
res.Append(c40char);
end
else
begin
if (cValue = 27) then
// FNC1
res.Append(Char(29)) // translate as ASCII 29
else if (cValue = 30) then
// Upper Shift
upperShift := true
else
begin
result := false;
exit;
end;
end;
shift := 0;
end;
3:
begin
if (upperShift) then
begin
res.Append(Char(cValue + 254));
upperShift := false;
end
else
res.Append(Char(cValue + 96));
shift := 0;
end;
else
begin
result := false;
exit;
end;
end;
end;
end;
result := true;
end;
/// <summary>
/// See ISO 16022:2006, 5.2.8 and Annex C Table C.3
/// </summary>
class function TDecodedBitStreamParser.decodeEdifactSegment(bits: TBitSource;
res: TStringBuilder): boolean;
var
i: Integer;
edifactValue: Integer;
bitsLeft: Integer;
begin
while (bits.available() > 0) do
begin
// If there is only two or less bytes left then it will be encoded as ASCII
if (bits.available() <= 16) then
begin
result := true;
exit;
end;
for i := 0 to 3 do
begin
edifactValue := bits.readBits(6);
// Check for the unlatch character
if (edifactValue = $1F) then
begin
// 011111
// Read rest of byte, which should be 0, and stop
bitsLeft := (8 - bits.BitOffset);
if (not bitsLeft = 8) then
bits.readBits(bitsLeft);
result := true;
exit;
end;
if ((edifactValue and $20) = 0) then
begin
// no 1 in the leading (6th) bit
edifactValue := (edifactValue or $40);
// Add a leading 01 to the 6 bit binary value
end;
res.Append(Char(edifactValue));
end;
end;
result := true;
end;
/// <summary>
/// See ISO 16022:2006, 5.2.6 and Annex C, Table C.2
/// </summary>
class function TDecodedBitStreamParser.decodeTextSegment(bits: TBitSource;
res: TStringBuilder): boolean;
var
textChar: Char;
cValues: TArray<Integer>;
upperShift: boolean;
i, shift: Integer;
firstByte: Integer;
cValue: Integer;
begin
// Three Text values are encoded in a 16-bit value as
// (1600 * C1) + (40 * C2) + C3 + 1
// TODO: The Upper Shift with Text doesn't work in the 4 value scenario all the time
upperShift := false;
cValues := TArray<Integer>.Create(0, 0, 0);
shift := 0;
while (bits.available() > 0) do
begin
// If there is only one byte left then it will be encoded as ASCII
if (bits.available() = 8) then
begin
result := true;
exit;
end;
firstByte := bits.readBits(8);
if (firstByte = 254) then
begin
// Unlatch codeword
result := true;
exit;
end;
TDecodedBitStreamParser.parseTwoBytes(firstByte, bits.readBits(8), cValues);
for i := 0 to 2 do
begin
cValue := cValues[i];
case (shift) of
0:
begin
if (cValue < 3) then
shift := (cValue + 1)
else
begin
if (cValue < Length(TEXT_BASIC_SET_CHARS)) then
begin
textChar := TEXT_BASIC_SET_CHARS[cValue];
if (upperShift) then
begin
res.Append(Char(textChar) + Char(128));
upperShift := false;
end
else
res.Append(textChar);
end
else
begin
result := false;
exit;
end;
end;
end;
1:
begin
if (upperShift) then
begin
res.Append(Char(cValue + 128));
upperShift := false;
end
else
res.Append(Char(cValue));
shift := 0;
end;
2:
begin
// Shift 2 for Text is the same encoding as C40
if (cValue < Length(TEXT_SHIFT2_SET_CHARS)) then
begin
textChar := TEXT_SHIFT2_SET_CHARS[cValue];
if (upperShift) then
begin
res.Append(Char(textChar) + Char(128));
upperShift := false;
end
else
res.Append(textChar);
end
else
begin
if (cValue = 27) then
// FNC1
res.Append(Char(29)) // translate as ASCII 29
else if (cValue = 30) then
// Upper Shift
upperShift := true
else
begin
result := false;
exit;
end;
end;
shift := 0;
end;
3:
begin
if (cValue < Length(TEXT_SHIFT3_SET_CHARS)) then
begin
textChar := TEXT_SHIFT3_SET_CHARS[cValue];
if (upperShift) then
begin
res.Append(Char(textChar) + Char(128));
upperShift := false;
end
else
res.Append(textChar);
shift := 0;
end
else
begin
result := false;
exit;
end;
end;
else
begin
result := false;
exit;
end;
end;
end;
end;
result := true;
end;
class procedure TDecodedBitStreamParser.parseTwoBytes(firstByte: Integer;
secondByte: Integer; result: TArray<Integer>);
var
fullBitValue, temp: Integer;
begin
fullBitValue := (((firstByte shl 8) + secondByte) - 1);
temp := (fullBitValue div $640);
result[0] := temp;
dec(fullBitValue, (temp * $640));
temp := (fullBitValue div 40);
result[1] := temp;
result[2] := (fullBitValue - (temp * 40))
end;
/// <summary>
/// See ISO 16022:2006, Annex B, B.2
/// </summary>
class function TDecodedBitStreamParser.unrandomize255State
(randomizedBase256Codeword: Integer;
base256CodewordPosition: Integer): Integer;
var
pseudoRandomNumber: Integer;
tempVariable: Integer;
begin
pseudoRandomNumber := (((149 * base256CodewordPosition) mod 255) + 1);
tempVariable := (randomizedBase256Codeword - pseudoRandomNumber);
if (tempVariable >= 0) then
result := tempVariable
else
result := (tempVariable + 256);
end;
class procedure TDecodedBitStreamParser.InitializeClass;
begin
/// <summary>
/// See ISO 16022:2006, Annex C Table C.1
/// The C40 Basic Character Set (*'s used for placeholders for the shift values)
/// </summary>
C40_BASIC_SET_CHARS := TArray<Char>.Create('*', '*', '*', ' ', '0', '1', '2',
'3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
'X', 'Y', 'Z');
C40_SHIFT2_SET_CHARS := TArray<Char>.Create('!', '"', '#', '$', '%', '&',
'''', '(', ')', '*', '+', ',', '-', '.', '/', ':', ';', '<', '=', '>', '?',
'@', '[', '\', ']', '^', '_');
/// <summary>
/// See ISO 16022:2006, Annex C Table C.2
/// The Text Basic Character Set (*'s used for placeholders for the shift values)
/// </summary>
TEXT_BASIC_SET_CHARS := TArray<Char>.Create('*', '*', '*', ' ', '0', '1', '2',
'3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
'x', 'y', 'z');
// Shift 2 for Text is the same encoding as C40
TEXT_SHIFT2_SET_CHARS := C40_SHIFT2_SET_CHARS;
TEXT_SHIFT3_SET_CHARS := TArray<Char>.Create('`', 'A', 'B', 'C', 'D', 'E',
'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
'U', 'V', 'W', 'X', 'Y', 'Z', '{', '|', '}', '~', '');
end;
class procedure TDecodedBitStreamParser.FinalizeClass;
begin
C40_BASIC_SET_CHARS := nil;
C40_SHIFT2_SET_CHARS := nil;
TEXT_BASIC_SET_CHARS := nil;
TEXT_SHIFT2_SET_CHARS := nil;
TEXT_SHIFT3_SET_CHARS := nil;
end;
initialization
TDecodedBitStreamParser.InitializeClass;
finalization
TDecodedBitStreamParser.FinalizeClass;
end.
@@ -0,0 +1,229 @@
{
* 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 K. Gossens
}
unit ZXing.Datamatrix.Internal.Decoder;
interface
uses
System.SysUtils,
System.Generics.Collections,
ZXing.DecodeHintType,
ZXing.Common.BitMatrix,
ZXing.Datamatrix.Internal.BitMatrixParser,
ZXing.Datamatrix.Internal.DataBlock,
ZXing.Common.ReedSolomon.ReedSolomonDecoder,
ZXing.Common.ReedSolomon.GenericGF,
ZXing.DecoderResult,
ZXing.Datamatrix.Internal.DecodedBitStreamParser;
type
/// <summary>
/// <p>The main class which implements Data Matrix Code decoding -- as opposed to locating and extracting
/// the Data Matrix Code from an image.</p>
/// </summary>
TDataMatrixDecoder = class sealed
private
rsDecoder: TReedSolomonDecoder;
public
constructor Create;
destructor Destroy; override;
function correctErrors(codewordBytes: TArray<Byte>; numDataCodewords: Integer): boolean;
function decode(bits: TBitMatrix): TDecoderResult; overload;
function decode(image: TArray < TArray < boolean >> ): TDecoderResult; overload;
end;
implementation
{ TDataMatrixDecoder }
/// <summary>
/// Initializes a new instance of the <see cref="Decoder"/> class.
/// </summary>
constructor TDataMatrixDecoder.Create;
begin
rsDecoder := TReedSolomonDecoder.Create(TGenericGF.DATA_MATRIX_FIELD_256);
end;
destructor TDataMatrixDecoder.Destroy;
begin
FreeAndNil(rsDecoder);
inherited;
end;
/// <summary>
/// <p>Convenience method that can decode a Data Matrix Code represented as a 2D array of booleans.
/// "true" is taken to mean a black module.</p>
///
/// <param name="image">booleans representing white/black Data Matrix Code modules</param>
/// <returns>text and bytes encoded within the Data Matrix Code</returns>
/// <exception cref="FormatException">if the Data Matrix Code cannot be decoded</exception>
/// <exception cref="ChecksumException">if error correction fails</exception>
/// </summary>
function TDataMatrixDecoder.decode(image: TArray < TArray < boolean >> ): TDecoderResult;
var
i, j: Integer;
dimension: Integer;
bits: TBitMatrix;
begin
dimension := Length(image);
bits := TBitMatrix.Create(dimension);
for i := 0 to Pred(dimension) do
begin
for j := 0 to Pred(dimension) do
begin
if (image[i][j]) then
bits[j, i] := true;
end;
end;
Result := decode(bits);
end;
/// <summary>
/// <p>Decodes a Data Matrix Code represented as a <see cref="BitMatrix" />. A 1 or "true" is taken
/// to mean a black module.</p>
/// </summary>
/// <param name="bits">booleans representing white/black Data Matrix Code modules</param>
/// <returns>text and bytes encoded within the Data Matrix Code</returns>
function TDataMatrixDecoder.decode(bits: TBitMatrix): TDecoderResult;
var
i, j: Integer;
db: TDataBlock;
parser: TBitMatrixParser;
codewords: TArray<Byte>;
dataBlocks: TArray<TDataBlock>;
dataBlocksCount, totalBytes: Integer;
resultBytes: TArray<Byte>;
DataBlock: TDataBlock;
codewordBytes: TArray<Byte>;
numDataCodewords: Integer;
begin
// Construct a parser and read version, error-correction level
parser := TBitMatrixParser.Create(bits);
DataBlock := nil;
try
if (parser.Version = nil) then
begin
Result := nil;
exit;
end;
// Read codewords
codewords := parser.readCodewords;
if (codewords = nil) then
begin
Result := nil;
exit;
end;
// Separate into data blocks
dataBlocks := TDataBlock.getDataBlocks(codewords, parser.Version);
dataBlocksCount := Length(dataBlocks);
// Count total number of data bytes
totalBytes := 0;
for db in dataBlocks do
begin
Inc(totalBytes, db.numDataCodewords)
end;
resultBytes := TArray<Byte>.Create();
SetLength(resultBytes, totalBytes);
// Error-correct and copy data blocks together into a stream of bytes
for j := 0 to Pred(dataBlocksCount) do
begin
DataBlock := dataBlocks[j];
codewordBytes := DataBlock.codewords;
numDataCodewords := DataBlock.numDataCodewords;
if (not correctErrors(codewordBytes, numDataCodewords)) then
begin
if Assigned(DataBlock) then
DataBlock.Free;
DataBlock := nil;
resultBytes := nil;
codewordBytes := nil;
Result := nil;
exit;
end;
for i := 0 to Pred(numDataCodewords) do
begin
// De-interlace data blocks.
resultBytes[(i * dataBlocksCount) + j] := codewordBytes[i];
end;
DataBlock.Free;
DataBlock := nil;
end;
// Decode the contents of that stream of bytes
Result := TDecodedBitStreamParser.decode(resultBytes);
finally
if Assigned(DataBlock) then
DataBlock.Free;
resultBytes := nil;
codewordBytes := nil;
parser.Free;
end;
end;
/// <summary>
/// <p>Given data and error-correction codewords received, possibly corrupted by errors, attempts to
/// correct the errors in-place using Reed-Solomon error correction.</p>
///
/// <param name="codewordBytes">data and error correction codewords</param>
/// <param name="numDataCodewords">number of codewords that are data bytes</param>
/// </summary>
function TDataMatrixDecoder.correctErrors(codewordBytes: TArray<Byte>; numDataCodewords: Integer): boolean;
var
i, numCodewords, numECCodewords: Integer;
codewordsInts: TArray<Integer>;
begin
numCodewords := Length(codewordBytes);
// First read into an array of ints
codewordsInts := TArray<Integer>.Create();
SetLength(codewordsInts, numCodewords);
for i := 0 to Pred(numCodewords) do
begin
codewordsInts[i] := (codewordBytes[i] and $FF);
end;
numECCodewords := (Length(codewordBytes) - numDataCodewords);
if (not rsDecoder.decode(codewordsInts, numECCodewords)) then
begin
Result := false;
exit;
end;
// Copy back into array of bytes -- only need to worry about the bytes that were data
// We don't care about errors in the error-correction codewords
for i := 0 to Pred(numDataCodewords) do
begin
codewordBytes[i] := Byte(codewordsInts[i]);
end;
Result := true;
end;
end.
@@ -0,0 +1,290 @@
{
* 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: bbrown@google.com (Brian Brown)
* Delphi Implementation by K. Gossens
}
unit ZXing.Datamatrix.Internal.Version;
interface
uses
System.SysUtils,
ZXing.Common.BitMatrix,
ZXing.QrCode.Internal.FormatInformation,
ZXing.Common.Detector.MathUtils;
type
/// <summary>
/// The Version object encapsulates attributes about a particular
/// size Data Matrix Code.
/// </summary>
TVersion = class sealed
type
/// <summary>
/// <p>Encapsualtes the parameters for one error-correction block in one symbol version.
/// This includes the number of data codewords, and the number of times a block with these
/// parameters is used consecutively in the Data Matrix code version's format.</p>
/// </summary>
TECB = class
private
Fcount: Integer;
FdataCodewords: Integer;
public
constructor Create(count: Integer; dataCodewords: Integer);
property count: Integer read Fcount;
property dataCodewords: Integer read FdataCodewords;
end;
/// <summary>
/// <p>Encapsulates a set of error-correction blocks in one symbol version. Most versions will
/// use blocks of differing sizes within one version, so, this encapsulates the parameters for
/// each set of blocks. It also holds the number of error-correction codewords per block since it
/// will be the same across all blocks within one version.</p>
/// </summary>
TECBlocks = class
private
_ecBlocksValue: TArray<TECB>;
_ecCodewords: Integer;
public
property ECBBlocksValue: TArray<TECB> read _ecBlocksValue;
property ECCodewords: Integer read _ecCodewords;
constructor Create(ECCodewords: Integer; ecBlocks: TECB); overload;
constructor Create(ECCodewords: Integer; ecBlocks1: TECB;
ecBlocks2: TECB); overload;
destructor Destroy; override;
end;
private
FdataRegionSizeColumns: Integer;
FdataRegionSizeRows: Integer;
FecBlocks: TECBlocks;
FsymbolSizeColumns: Integer;
FsymbolSizeRows: Integer;
FtotalCodewords: Integer;
FversionNumber: Integer;
class var buildVersions: TArray<TVersion>;
class procedure ClassInit; static;
class procedure ClassFinal; static;
class function GetBuildVersions: TArray<TVersion>; static;
constructor Create(versionNumber, symbolSizeRows, symbolSizeColumns,
dataRegionSizeRows, dataRegionSizeColumns: Integer; ecBlocks: TECBlocks);
public
destructor Destroy; override;
function ToString: string; override;
class function getVersionForDimensions(numRows: Integer;
numColumns: Integer): TVersion;
property dataRegionSizeColumns: Integer read FdataRegionSizeColumns;
property dataRegionSizeRows: Integer read FdataRegionSizeRows;
property ecBlocks: TECBlocks read FecBlocks;
property symbolSizeColumns: Integer read FsymbolSizeColumns;
property symbolSizeRows: Integer read FsymbolSizeRows;
property totalCodewords: Integer read FtotalCodewords;
property versionNumber: Integer read FversionNumber;
end;
implementation
{ TVersion.TECB }
constructor TVersion.TECB.Create(count, dataCodewords: Integer);
begin
self.Fcount := count;
self.FdataCodewords := dataCodewords;
end;
{ TVersion.TECBlocks }
constructor TVersion.TECBlocks.Create(ECCodewords: Integer; ecBlocks: TECB);
begin
self._ecCodewords := ECCodewords;
self._ecBlocksValue := TArray<TECB>.Create(ecBlocks);
end;
constructor TVersion.TECBlocks.Create(ECCodewords: Integer; ecBlocks1: TECB;
ecBlocks2: TECB);
begin
self._ecCodewords := ECCodewords;
self._ecBlocksValue := TArray<TECB>.Create(ecBlocks1, ecBlocks2);
end;
destructor TVersion.TECBlocks.Destroy;
var
ecb: TECB;
i: Integer;
begin
for i := 0 to Length(_ecBlocksValue) - 1 do
begin
ecb := _ecBlocksValue[i];
FreeAndNil(ecb);
end;
_ecBlocksValue := nil;
inherited;
end;
{ TVersion }
class procedure TVersion.ClassInit();
begin
TVersion.buildVersions := TVersion.GetBuildVersions;
end;
class procedure TVersion.ClassFinal();
var
Version: TVersion;
begin
for Version in TVersion.buildVersions do
begin
Version.Free;
end;
TVersion.buildVersions := nil;
end;
constructor TVersion.Create(versionNumber, symbolSizeRows, symbolSizeColumns,
dataRegionSizeRows, dataRegionSizeColumns: Integer; ecBlocks: TECBlocks);
var
ecBlock: TECB;
total: Integer;
ECCodewords: Integer;
begin
self.FversionNumber := versionNumber;
self.FsymbolSizeRows := symbolSizeRows;
self.FsymbolSizeColumns := symbolSizeColumns;
self.FdataRegionSizeRows := dataRegionSizeRows;
self.FdataRegionSizeColumns := dataRegionSizeColumns;
self.FecBlocks := ecBlocks;
total := 0;
ECCodewords := ecBlocks.ECCodewords;
for ecBlock in ecBlocks.ECBBlocksValue do
begin
Inc(total, (ecBlock.count * (ecBlock.dataCodewords + ECCodewords)))
end;
self.FtotalCodewords := total;
end;
destructor TVersion.Destroy;
begin
FreeAndNil(FecBlocks);
inherited;
end;
/// <summary>
/// See ISO 16022:2006 5.5.1 Table 7
/// </summary>
class function TVersion.GetBuildVersions: TArray<TVersion>;
begin
Result := TArray<TVersion>.Create(TVersion.Create(1, 10, 10, 8, 8,
TECBlocks.Create(5, TECB.Create(1, 3))), TVersion.Create(2, 12, 12, 10, 10,
TECBlocks.Create(7, TECB.Create(1, 5))), TVersion.Create(3, 14, 14, 12, 12,
TECBlocks.Create(10, TECB.Create(1, 8))), TVersion.Create(4, $10, $10, 14,
14, TECBlocks.Create(12, TECB.Create(1, 12))), TVersion.Create(5, $12, $12,
$10, $10, TECBlocks.Create(14, TECB.Create(1, $12))),
TVersion.Create(6, 20, 20, $12, $12, TECBlocks.Create($12,
TECB.Create(1, $16))), TVersion.Create(7, $16, $16, 20, 20,
TECBlocks.Create(20, TECB.Create(1, 30))), TVersion.Create(8, $18, $18, $16,
$16, TECBlocks.Create($18, TECB.Create(1, $24))),
TVersion.Create(9, $1A, $1A, $18, $18, TECBlocks.Create($1C,
TECB.Create(1, $2C))), TVersion.Create(10, $20, $20, 14, 14,
TECBlocks.Create($24, TECB.Create(1, $3E))), TVersion.Create(11, $24, $24,
$10, $10, TECBlocks.Create($2A, TECB.Create(1, $56))),
TVersion.Create(12, 40, 40, $12, $12, TECBlocks.Create($30,
TECB.Create(1, $72))), TVersion.Create(13, $2C, $2C, 20, 20,
TECBlocks.Create($38, TECB.Create(1, $90))), TVersion.Create(14, $30, $30,
$16, $16, TECBlocks.Create($44, TECB.Create(1, $AE))),
TVersion.Create(15, $34, $34, $18, $18, TECBlocks.Create($2A,
TECB.Create(2, $66))), TVersion.Create($10, $40, $40, 14, 14,
TECBlocks.Create($38, TECB.Create(2, 140))), TVersion.Create($11, $48, $48,
$10, $10, TECBlocks.Create($24, TECB.Create(4, $5C))),
TVersion.Create($12, 80, 80, $12, $12, TECBlocks.Create($30,
TECB.Create(4, $72))), TVersion.Create($13, $58, $58, 20, 20,
TECBlocks.Create($38, TECB.Create(4, $90))), TVersion.Create(20, $60, $60,
$16, $16, TECBlocks.Create($44, TECB.Create(4, $AE))),
TVersion.Create($15, $68, $68, $18, $18, TECBlocks.Create($38,
TECB.Create(6, $88))), TVersion.Create($16, 120, 120, $12, $12,
TECBlocks.Create($44, TECB.Create(6, $AF))), TVersion.Create($17, $84, $84,
20, 20, TECBlocks.Create($3E, TECB.Create(8, $A3))),
TVersion.Create($18, $90, $90, $16, $16, TECBlocks.Create($3E,
TECB.Create(8, $9C), TECB.Create(2, $9B))), TVersion.Create($19, 8, $12, 6,
$10, TECBlocks.Create(7, TECB.Create(1, 5))), TVersion.Create($1A, 8, $20,
6, 14, TECBlocks.Create(11, TECB.Create(1, 10))),
TVersion.Create($1B, 12, $1A, 10, $18, TECBlocks.Create(14,
TECB.Create(1, $10))), TVersion.Create($1C, 12, $24, 10, $10,
TECBlocks.Create($12, TECB.Create(1, $16))), TVersion.Create($1D, $10, $24,
14, $10, TECBlocks.Create($18, TECB.Create(1, $20))),
TVersion.Create(30, $10, $30, 14, $16, TECBlocks.Create($1C,
TECB.Create(1, $31))));
end;
/// <summary>
/// <p>Deduces version information from Data Matrix dimensions.</p>
///
/// <param name="numRows">Number of rows in modules</param>
/// <param name="numColumns">Number of columns in modules</param>
/// <returns>Version for a Data Matrix Code of those dimensions</returns>
/// <exception cref="FormatException">if dimensions do correspond to a valid Data Matrix size</exception>
/// </summary>
class function TVersion.getVersionForDimensions(numRows: Integer;
numColumns: Integer): TVersion;
var
Version: TVersion;
begin
Result := nil;
if (((numRows and $01) = 0) and ((numColumns and $01) = 0)) then
begin
for Version in TVersion.buildVersions do
begin
if ((Version.symbolSizeRows = numRows) and
(Version.symbolSizeColumns = numColumns)) then
begin
Result := Version;
break;
end;
end;
end;
end;
function TVersion.ToString: string;
begin
Result := versionNumber.ToString();
end;
Initialization
TVersion.ClassInit();
Finalization
TVersion.ClassFinal();
end.
@@ -0,0 +1,361 @@
{
* 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
}
unit ZXing.QrCode.Internal.BitMatrixParser;
interface
uses
SysUtils,
Generics.Collections,
ZXing.DecodeHintType,
ZXing.Common.BitMatrix,
ZXing.QrCode.Internal.Version,
ZXing.QrCode.Internal.FormatInformation,
ZXing.Common.Detector.MathUtils,
ZXing.QrCode.Internal.DataMask;
type
TBitMatrixParser = class
private
BitMatrix: TBitMatrix;
mirrored: boolean;
parsedVersion: TVersion;
function copyBit(const i, j, versionBits: Integer): Integer;
public
parsedFormatInfo: TFormatInformation;
constructor Create(const BitMatrix: TBitMatrix);
/// <param name="bitMatrix">{@link TBitMatrix} to parse</param>
/// <throws>ReaderException if dimension is not >= 21 and 1 mod 4</throws>
class function createBitMatrixParser(
const bitMatrix: TBitMatrix): TBitMatrixParser; static;
(** Mirror the bit matrix in order to attempt a second reading. *)
procedure mirror;
(**
* Revert the mask removal done while reading the code words. The bit matrix should revert to its original state.
*)
procedure remask;
(**
* Prepare the parser for a mirrored operation.
* This flag has effect only on the {@link #readFormatInformation()} and the
* {@link #readVersion()}. Before proceeding with {@link #readCodewords()} the
* {@link #mirror()} method should be called.
*
* @param mirror Whether to read version and format information mirrored.
*)
procedure setMirror(const mirror: Boolean);
/// <summary> <p>Reads format information from one of its two locations within the QR Code.</p>
///
/// </summary>
/// <returns> {@link FormatInformation} encapsulating the QR Code's format info
/// </returns>
/// <throws> ReaderException if both format information locations cannot be parsed as </throws>
/// <summary> the valid encoding of format information
/// </summary>
function readFormatInformation: TFormatInformation;
/// <summary> <p>Reads version information from one of its two locations within the QR Code.</p>
///
/// </summary>
/// <returns> {@link Version} encapsulating the QR Code's version
/// </returns>
/// <throws> ReaderException if both version information locations cannot be parsed as </throws>
/// <summary> the valid encoding of version information
/// </summary>
function readVersion: TVersion;
// <summary> <p>Reads the bits in the {@link BitMatrix} representing the finder pattern in the
// correct order in order to reconstruct the codewords bytes contained within the
/// QR Code.</p>
///
/// </summary>
/// <returns> bytes encoded within the QR Code
/// </returns>
/// <throws> ReaderException if the exact number of bytes expected is not read </throws>
function readCodewords: TArray<Byte>;
end;
implementation
{ TBitMatrixParser }
constructor TBitMatrixParser.Create(const bitMatrix: TBitMatrix);
begin
// Should only be called from createBitMatrixParser with the important checks before
Self.bitMatrix := BitMatrix;
end;
class function TBitMatrixParser.createBitMatrixParser(
const bitMatrix: TBitMatrix): TBitMatrixParser;
var
dimension: Integer;
begin
dimension := BitMatrix.Height;
if ((dimension < 21) and ((dimension and $03) <> 1))
then
Result := nil
else
Result := TBitMatrixParser.Create(bitMatrix);
end;
function TBitMatrixParser.copyBit(const i, j, versionBits: Integer): Integer;
var
bit: Boolean;
begin
if (mirrored)
then
bit := BitMatrix[j, i]
else
bit := BitMatrix[i, j];
if (bit)
then
Result := ((versionBits shl 1) or $1)
else
Result := (versionBits shl 1);
end;
procedure TBitMatrixParser.mirror;
var
x, y: Integer;
begin
for x := 0 to Pred(bitMatrix.width) do
for y := (x + 1) to Pred(bitMatrix.height) do
if (bitMatrix[x, y] <> bitMatrix[y, x]) then
begin
bitMatrix.flip(y, x);
bitMatrix.flip(x, y);
end;
end;
function TBitMatrixParser.readCodewords: TArray<Byte>;
var
formatInfo: TFormatInformation;
dimension, resultOffset,
currentByte, bitsRead,
j, i, count, col: Integer;
functionPattern: TBitMatrix;
readingUp: boolean;
Version: TVersion;
DataMask: TDataMask;
begin
Result := nil;
formatInfo := readFormatInformation;
if (formatInfo = nil)
then
exit;
Version := readVersion;
if (Version = nil)
then
exit;
// Get the data mask for the format used in this QR Code. This will exclude
// some bits from reading as we wind through the bit matrix.
DataMask := TDataMask.forReference(formatInfo.DataMask);
dimension := bitMatrix.Height;
DataMask.unmaskBitMatrix(BitMatrix, dimension);
functionPattern := Version.buildFunctionPattern;
try
readingUp := true;
Result := TArray<Byte>.Create();
SetLength(Result, version.TotalCodewords);
resultOffset := 0;
currentByte := 0;
bitsRead := 0;
j := (dimension - 1);
// Read columns in pairs, from right to left
while ((j > 0)) do
begin
if (j = 6)
then
// Skip whole column with vertical alignment pattern;
// saves time and makes the other code proceed more cleanly
Dec(j);
// Read alternatingly from bottom to top then top to bottom
for count := 0 to Pred(dimension) do
begin
if (readingUp)
then
i := ((dimension - 1) - count)
else
i := count;
for col := 0 to Pred(2) do
begin
// Ignore bits covered by the function pattern
if (not functionPattern[(j - col), i]) then
begin
// Read a bit
Inc(bitsRead);
currentByte := (currentByte shl 1);
if (bitMatrix[(j - col), i])
then
currentByte := (currentByte or 1);
// If we've made a whole byte, save it off
if (bitsRead = 8) then
begin
// if resultoffset > high(Result) then
// raise EProgrammerNotFound.CreateFmt('resultoffset %d> high(Result) %d',[resultOffset,high(Result)])
// else if resultoffset < 0 then
// raise EProgrammerNotFound.CreateFmt('resultoffset %d<0!',[resultOffset]);
if (resultoffset>=0) and (resultoffset <= high(Result)) then // minchiata aggiunta da carlo
Result[resultOffset] := Byte(currentByte);
Inc(resultOffset);
bitsRead := 0;
currentByte := 0;
end
end;
end;
end;
readingUp := not readingUp; // readingUp = !readingUp; // switch directions
Dec(j, 2);
end;
if (resultOffset <> version.TotalCodewords)
then
Result := nil;
finally
FreeAndNil(functionPattern);
end;
end;
function TBitMatrixParser.readFormatInformation: TFormatInformation;
var
formatInfoBits1,
formatInfoBits2,
dimension,
i, j, jMin: Integer;
begin
if (Self.parsedFormatInfo <> nil) then
begin
Result := Self.parsedFormatInfo;
exit;
end;
// Read top-left format info bits
formatInfoBits1 := 0;
for i := 0 to Pred(6) do
formatInfoBits1 := self.copyBit(i, 8, formatInfoBits1);
// .. and skip a bit in the timing pattern ...
formatInfoBits1 := self.copyBit(7, 8, formatInfoBits1);
formatInfoBits1 := self.copyBit(8, 8, formatInfoBits1);
formatInfoBits1 := self.copyBit(8, 7, formatInfoBits1);
// .. and skip a bit in the timing pattern ...
for j := 5 downto 0 do
formatInfoBits1 := self.copyBit(8, j, formatInfoBits1);
// Read the top-right/bottom-left pattern too
dimension := Self.bitMatrix.Height;
formatInfoBits2 := 0;
jMin := (dimension - 7);
for j := (dimension - 1) downto jMin do
formatInfoBits2 := self.copyBit(8, j, formatInfoBits2);
for i := (dimension - 8) to Pred(dimension) do
formatInfoBits2 := self.copyBit(i, 8, formatInfoBits2);
parsedFormatInfo := TFormatInformation.DecodeFormatInformation(formatInfoBits1, formatInfoBits2);
if (parsedFormatInfo <> nil)
then
Result := Self.parsedFormatInfo
else
Result := nil;
end;
function TBitMatrixParser.readVersion: TVersion;
var
dimension,
provisionalVersion,
versionBits,
i, j, ijMin: Integer;
begin
if (Self.parsedVersion <> nil) then
begin
Result := Self.parsedVersion;
exit;
end;
dimension := Self.bitMatrix.Height;
provisionalVersion := TMathUtils.Asr((dimension - 17), 2);
if (provisionalVersion <= 6) then
begin
Result := TVersion.getVersionForNumber(provisionalVersion);
exit;
end;
// Read top-right version info: 3 wide by 6 tall
versionBits := 0;
ijMin := (dimension - 11);
for j := 5 downto 0 do
for i := (dimension - 9) downto ijMin do
versionBits := Self.copyBit(i, j, versionBits);
parsedVersion := TVersion.decodeVersionInformation(versionBits);
if ((parsedVersion <> nil) and
(parsedVersion.DimensionForVersion = dimension)) then
begin
Result := parsedVersion;
exit;
end;
// Hmm, failed. Try bottom left: 6 wide by 3 tall
versionBits := 0;
for i := 5 downto 0 do
for j := (dimension - 9) downto ijMin do
versionBits := self.copyBit(i, j, versionBits);
parsedVersion := TVersion.decodeVersionInformation(versionBits);
if ((parsedVersion <> nil) and
(parsedVersion.DimensionForVersion = dimension))
then
Result := self.parsedVersion
else
Result := nil;
end;
procedure TBitMatrixParser.remask;
var
dimension: Integer;
begin
if (parsedFormatInfo <> nil) then
begin
dimension := bitMatrix.Height;
TDataMask.forReference(parsedFormatInfo.DataMask)
.unmaskBitMatrix(bitMatrix, dimension);
end;
end;
procedure TBitMatrixParser.setMirror(const mirror: Boolean);
begin
Self.parsedVersion := nil;
Self.parsedFormatInfo := nil;
Self.mirrored := mirror;
end;
end.
@@ -0,0 +1,187 @@
{
* 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.QrCode.Internal.DataBlock;
interface
uses
System.SysUtils,
ZXing.QrCode.Internal.Version,
ZXing.QrCode.Internal.ErrorCorrectionLevel;
type
/// <summary> <p>Encapsulates a block of data within a QR Code. QR Codes may split their data into
/// multiple blocks, each of which is a unit of data and error-correction codewords. Each
/// is represented by an instance of this class.</p>
/// </summary>
TDataBlock = class sealed
private
Fcodewords: TArray<Byte>;
FnumDataCodewords: Integer;
public
constructor Create(const codewords: TArray<Byte>;
const NumDataCodewords: Integer);
destructor Destroy; override;
/// <summary> <p>When QR Codes use multiple data blocks, they are actually interleaved.
/// That is, the first byte of data block 1 to n is written, then the second bytes, and so on. This
/// method will separate the data into original blocks.</p>
///
/// </summary>
/// <param name="rawCodewords">bytes as read directly from the QR Code
/// </param>
/// <param name="version">version of the QR Code
/// </param>
/// <param name="ecLevel">error-correction level of the QR Code
/// </param>
/// <returns> {@link TDataBlock}s containing original bytes, "de-interleaved" from representation in the
/// QR Code
/// </returns>
class function getDataBlocks(const rawCodewords: TArray<Byte>;
const version: TVersion; const ecLevel: TErrorCorrectionLevel): TArray<TDataBlock>; static;
property codewords : TArray<Byte> read Fcodewords;
property numDataCodewords : Integer read FnumDataCodewords;
end;
implementation
{ TDataBlock }
constructor TDataBlock.Create(const codewords: TArray<Byte>;
const numDataCodewords: Integer);
begin
Fcodewords := codewords;
FnumDataCodewords := numDataCodewords;
end;
destructor TDataBlock.Destroy;
begin
Fcodewords := nil;
inherited;
end;
class function TDataBlock.getDataBlocks(const rawCodewords: TArray<Byte>;
const version: TVersion; const ecLevel: TErrorCorrectionLevel): TArray<TDataBlock>;
var
numResultBlocks,
shorterBlocksTotalCodewords,
longerBlocksStartAt,
shorterBlocksNumDataCodewords,
max, i, j,
totalBlocks,
numBlockCodewords,
iOffset,
rawCodewordsOffset,
NumDataCodewords: Integer;
ecBlock: Tversion.TECB;
ecBlocks: Tversion.TECBlocks;
ecBlockArray: TArray<Tversion.TECB>;
numBlockCodewordsBytes: TArray<Byte>;
begin
if (Length(rawCodewords) <> Version.TotalCodewords)
then
raise EArgumentException.Create('Invalid arguments');
// Figure out the number and size of data blocks used by this version and
// error correction level
ecBlocks := version.getECBlocksForLevel(ecLevel);
// First count the total number of data blocks
totalBlocks := 0;
ecBlockArray := ecBlocks.getECBlocks;
for ecBlock in ecBlockArray do
Inc(totalBlocks, ecBlock.Count);
// Now establish DataBlocks of the appropriate size and number of data codewords
Result := TArray<TDataBlock>.Create();
SetLength(result, totalBlocks);
numResultBlocks := 0;
for ecBlock in ecBlockArray do
begin
for i := 0 to Pred(ecBlock.count) do
begin
numDataCodewords := ecBlock.DataCodewords;
numBlockCodewords := ecBlocks.ECCodewordsPerBlock + numDataCodewords;
numBlockCodewordsBytes := TArray<Byte>.Create();
SetLength(numBlockCodewordsBytes, numBlockCodewords);
Result[numResultBlocks] := TDataBlock.Create(numBlockCodewordsBytes, numDataCodewords);
Inc(numResultBlocks);
end
end;
numBlockCodewordsBytes := nil;
// All blocks have the same amount of data, except that the last n
// (where n may be 0) have 1 more byte. Figure out where these start.
shorterBlocksTotalCodewords := Length(Result[0].codewords);
longerBlocksStartAt := Length(result) - 1;
while ((longerBlocksStartAt >= 0)) do
begin
if (Length(Result[longerBlocksStartAt].codewords) = shorterBlocksTotalCodewords)
then
break;
Dec(longerBlocksStartAt);
end;
Inc(longerBlocksStartAt);
shorterBlocksNumDataCodewords := (shorterBlocksTotalCodewords - ecBlocks.ECCodewordsPerBlock);
// The last elements of result may be 1 element longer;
// first fill out as many elements as all of them have
rawCodewordsOffset := 0;
for i := 0 to Pred(shorterBlocksNumDataCodewords) do
begin
for j := 0 to Pred(numResultBlocks) do
begin
Result[j].codewords[i] := rawCodewords[rawCodewordsOffset];
Inc(rawCodewordsOffset);
end;
end;
// Fill out the last data block in the longer ones
for j := longerBlocksStartAt to Pred(numResultBlocks) do
begin
result[j].codewords[shorterBlocksNumDataCodewords] :=
rawCodewords[rawCodewordsOffset];
Inc(rawCodewordsOffset);
end;
// Now add in error correction blocks
max := Length(result[0].codewords);
for i := shorterBlocksNumDataCodewords to Pred(max) do
begin
for j := 0 to Pred(numResultBlocks) do
begin
if (j < longerBlocksStartAt)
then
iOffset := i
else
iOffset := i + 1;
Result[j].codewords[iOffset] := rawCodewords[rawCodewordsOffset];
Inc(rawCodewordsOffset);
end;
end;
end;
end.
@@ -0,0 +1,226 @@
{
* 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.QrCode.Internal.DataMask;
interface
uses
SysUtils,
ZXing.Common.BitMatrix,
ZXing.Common.Detector.MathUtils;
type
/// <summary> <p>Encapsulates data masks for the data bits in a QR code, per ISO 18004:2006 6.8. Implementations
/// of this class can un-mask a raw BitMatrix. For simplicity, they will unmask the entire BitMatrix,
/// including areas used for finder patterns, timing patterns, etc. These areas should be unused
/// after the point they are unmasked anyway.</p>
///
/// <p>Note that the diagram in section 6.8.1 is misleading since it indicates that i is column position
/// and j is row position. In fact, as the text says, i is row position and j is column position.</p>
/// </summary>
TDataMask = class abstract
private
/// <summary> See ISO 18004:2006 6.8.1</summary>
class var DATA_MASKS: TArray<TDataMask>;
class procedure InitializeClass;
class procedure FinalizeClass;
function isMasked(const i, j: Integer): Boolean; virtual; abstract;
public
/// <param name="reference">a value between 0 and 7 indicating one of the eight possible
/// data mask patterns a QR Code may use
/// </param>
/// <returns> {@link DataMask} encapsulating the data mask pattern
/// </returns>
class function forReference(const reference: Integer): TDataMask; static;
/// <summary> <p>Implementations of this method reverse the data masking process applied to a QR Code and
/// make its bits ready to read.</p>
/// </summary>
/// <param name="bits">representation of QR Code bits
/// </param>
/// <param name="dimension">dimension of QR Code, represented by bits, being unmasked
/// </param>
procedure unmaskBitMatrix(const bits: TBitMatrix; const dimension: Integer);
end;
/// <summary> 000: mask bits for which (x + y) mod 2 == 0</summary>
TDataMask000 = class(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
/// <summary> 001: mask bits for which x mod 2 == 0</summary>
TDataMask001 = class sealed(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
/// <summary> 010: mask bits for which y mod 3 == 0</summary>
TDataMask010 = class sealed(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
/// <summary> 011: mask bits for which (x + y) mod 3 == 0</summary>
TDataMask011 = class sealed(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
/// <summary> 100: mask bits for which (x/2 + y/3) mod 2 == 0</summary>
TDataMask100 = class sealed(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
/// <summary> 101: mask bits for which xy mod 2 + xy mod 3 == 0</summary>
TDataMask101 = class sealed(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
/// <summary> 110: mask bits for which (xy mod 2 + xy mod 3) mod 2 == 0</summary>
TDataMask110 = class sealed(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
/// <summary> 111: mask bits for which ((x+y)mod 2 + xy mod 3) mod 2 == 0</summary>
TDataMask111 = class sealed(TDataMask)
private
function isMasked(const i, j: Integer): Boolean; override;
end;
implementation
{ TDataMask }
class procedure TDataMask.InitializeClass;
begin
TDataMask.DATA_MASKS := TArray<TDataMask>.Create(TDataMask000.Create,
TDataMask001.Create,
TDataMask010.Create,
TDataMask011.Create,
TDataMask100.Create,
TDataMask101.Create,
TDataMask110.Create,
TDataMask111.Create);
end;
class procedure TDataMask.FinalizeClass;
var
dam: TDataMask;
begin
for dam in TDataMask.DATA_MASKS do
dam.Free;
DATA_MASKS := nil;
end;
class function TDataMask.forReference(const reference: Integer): TDataMask;
begin
if ((reference < 0) or (reference > 7))
then
raise EArgumentException.Create('Invalid arguments');
Result := TDataMask.DATA_MASKS[reference];
end;
procedure TDataMask.unmaskBitMatrix(const bits: TBitMatrix;
const dimension: Integer);
var
i, j: Integer;
begin
for i := 0 to Pred(dimension) do
for j := 0 to Pred(dimension) do
if (self.isMasked(i, j))
then
bits.flip(j, i);
end;
{ TDataMask000 }
function TDataMask000.isMasked(const i, j: Integer): Boolean;
begin
Result := ((i + j) and $01) = 0;
end;
{ TDataMask001 }
function TDataMask001.isMasked(const i, j: Integer): Boolean;
begin
Result := (i and $01) = 0;
end;
{ TDataMask010 }
function TDataMask010.isMasked(const i, j: Integer): Boolean;
begin
Result := (j mod 3) = 0;
end;
{ TDataMask011 }
function TDataMask011.isMasked(const i, j: Integer): Boolean;
begin
Result := (((i + j) mod 3) = 0)
end;
{ TDataMask100 }
function TDataMask100.isMasked(const i, j: Integer): Boolean;
begin
Result := (( TMathUtils.Asr(UInt32(i),1) + (j div 3)) and $01) = 0;
end;
{ TDataMask101 }
function TDataMask101.isMasked(const i, j: Integer): Boolean;
var
temp: Integer;
begin
temp := (i * j);
Result := ((temp and $01) + (temp mod 3)) = 0;
end;
{ TDataMask110 }
function TDataMask110.isMasked(const i, j: Integer): Boolean;
var
temp: Integer;
begin
temp := (i * j);
Result := (((temp and $01) + (temp mod 3)) and 1) = 0;
end;
{ TDataMask111 }
function TDataMask111.isMasked(const i, j: Integer): Boolean;
begin
Result := ((((i + j) and $01) + ((i * j) mod 3)) and $01) = 0;
end;
initialization
TDataMask.InitializeClass;
finalization
TDataMask.FinalizeClass;
end.
@@ -0,0 +1,587 @@
{
* 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
}
unit ZXing.QrCode.Internal.DecodedBitStreamParser;
interface
uses
ZXing.BitSource,
SysUtils,
ZXing.DecodeHintType,
Generics.Collections,
ZXing.QrCode.Internal.ErrorCorrectionLevel,
ZXing.QrCode.Internal.Version,
ZXing.DecoderResult,
ZXing.CharacterSetECI,
ZXing.StringUtils,
ZXing.ByteSegments,
ZXing.QrCode.Internal.Mode,
ZXing.Common.Detector.MathUtils;
type
/// <summary> <p>QR Codes can encode text as bits in one of several modes, and can use multiple modes
/// in one QR Code. This class decodes the bits back into text.</p>
///
/// <p>See ISO 18004:2006, 6.4.3 - 6.4.7</p>
/// </summary>
TDecodedBitStreamParser = class abstract
private
/// <summary>
/// See ISO 18004:2006, 6.4.4 Table 5
/// </summary>
class var ALPHANUMERIC_CHARS: TArray<Char>;
const
GB2312_SUBSET: Integer = 1;
class procedure InitializeClass;
class procedure FinalizeClass;
class function decodeAlphanumericSegment(const bits: TBitSource;
const res: TStringBuilder; count: Integer;
const fc1InEffect: Boolean): Boolean; static;
class function decodeByteSegment(const bits: TBitSource;
const res: TStringBuilder; count: Integer;
const currentCharacterSetECI: TCharacterSetECI;
const byteSegments: IByteSegments;
const hints: TDictionary<TDecodeHintType, TObject>): Boolean; static;
/// <summary>
/// See specification GBT 18284-2000
/// </summary>
/// <param name="bits">The bits.</param>
/// <param name="result">The result.</param>
/// <param name="count">The count.</param>
/// <returns></returns>
class function decodeHanziSegment(const bits: TBitSource;
const res: TStringBuilder; count: Integer): Boolean; static;
class function decodeKanjiSegment(const bits: TBitSource;
const res: TStringBuilder; count: Integer): boolean; static;
class function decodeNumericSegment(const bits: TBitSource;
const res: TStringBuilder; count: Integer): Boolean; static;
class function parseECIValue(const bits: TBitSource): Integer; static;
class function toAlphaNumericChar(const value: Integer): Char; static;
public
class function decode(const bytes: TArray<Byte>; const version: TVersion;
const ecLevel: TErrorCorrectionLevel;
const hints: TDictionary<TDecodeHintType, TObject>): TDecoderResult; static;
end;
implementation
{ TDecodedBitStreamParser }
class procedure TDecodedBitStreamParser.InitializeClass;
begin
ALPHANUMERIC_CHARS := TArray<Char>.Create('0', '1', '2', '3', '4', '5', '6',
'7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L',
'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', ' ',
'$', '%', '*', '+', '-', '.', '/', ':');
end;
class procedure TDecodedBitStreamParser.FinalizeClass;
begin
ALPHANUMERIC_CHARS := nil;
end;
class function TDecodedBitStreamParser.decode(const bytes: TArray<Byte>;
const version: TVersion; const ecLevel: TErrorCorrectionLevel;
const hints: TDictionary<TDecodeHintType, TObject>): TDecoderResult;
var
Mode: TMode;
bits: TBitSource;
byteSegments: IByteSegments;
fc1InEffect: Boolean;
symbolSequence,
parityData,
count, value,
countHanzi, subSet: Integer;
currentCharacterSetECI: TCharacterSetECI;
ecstring,s: String;
res: TStringBuilder;
begin
Result := nil;
bits := TBitSource.Create(bytes);
res := TStringBuilder.Create(50);
byteSegments := ByteSegmentsCreate();
byteSegments.Capacity := 1;
symbolSequence := -1;
parityData := -1;
try
try
currentCharacterSetECI := nil;
fc1InEffect := false;
repeat
// While still another segment to read...
if (bits.available < 4)
then
// OK, assume we're done. Really, a TERMINATOR mode should have been recorded here
Mode := TMode.TERMINATOR
else
begin
try
Mode := TMode.forBits(bits.readBits(4)); // mode is encoded by 4 bits
except
on E: EArgumentException do
exit;
end;
end;
if (Mode <> TMode.TERMINATOR) then
begin
if ((Mode = TMode.FNC1_FIRST_POSITION) or
(Mode = TMode.FNC1_SECOND_POSITION)) then
begin
// We do little with FNC1 except alter the parsed result a bit according to the spec
fc1InEffect := true;
end else
begin
if (Mode = TMode.STRUCTURED_APPEND) then
begin
if (bits.available() < 16)
then
exit;
// not really supported; but sequence number and parity is added later to the result metadata
// Read next 8 bits (symbol sequence #) and 8 bits (parity data), then continue
symbolSequence := bits.readBits(8);
parityData := bits.readBits(8);
end else
begin
if (Mode = TMode.ECI) then
begin
// Count doesn't apply to ECI
value := parseECIValue(bits);
currentCharacterSetECI := TCharacterSetECI.getCharacterSetECIByValue(value);
if (currentCharacterSetECI = nil)
then
exit;
end else
begin
// First handle Hanzi mode which does not start with character count
if (Mode = TMode.HANZI) then
begin
// chinese mode contains a sub set indicator right after mode indicator
subSet := bits.readBits(4);
countHanzi := bits.readBits(Mode.getCharacterCountBits(version));
if (subSet = GB2312_SUBSET) then
begin
if (not TDecodedBitStreamParser.decodeHanziSegment(bits,
res, countHanzi))
then
exit;
end;
end else
begin
// "Normal" QR code modes:
// How many characters will follow, encoded in this mode?
count := bits.readBits(Mode.getCharacterCountBits(version));
if (Mode = TMode.NUMERIC) then
begin
if (not TDecodedBitStreamParser.decodeNumericSegment(bits,
res, count))
then
exit;
end else
begin
if (Mode = TMode.ALPHANUMERIC) then
begin
if (not TDecodedBitStreamParser.
decodeAlphanumericSegment(bits, res, count, fc1InEffect))
then
exit;
end else
begin
if (Mode = TMode.BYTE) then
begin
if (not TDecodedBitStreamParser.
decodeByteSegment(bits, res, count,
currentCharacterSetECI, byteSegments, hints))
then
exit;
end else
begin
if (Mode <> TMode.KANJI) then
begin
if (not TDecodedBitStreamParser.
decodeKanjiSegment(bits, res, count))
then
exit;
end else exit;
end;
end;
end;
end;
end;
end;
end;
end;
until (Mode = TMode.TERMINATOR)
except
on E: EArgumentException do
exit;
end;
if (byteSegments.count = 0)
then
byteSegments := nil;
if (ecLevel = nil)
then
ecstring := ''
else
ecstring := ecLevel.toString();
s:= res.toString.Replace(#13+#10, #10).Replace(#10, #13);
Result := TDecoderResult.Create(bytes, s, byteSegments, ecstring, symbolSequence,
parityData);
finally
// FreeAndNil(byteSegments);
res.Clear();
FreeAndNil(res);
FreeAndNil(bits);
end;
end;
class function TDecodedBitStreamParser.decodeAlphanumericSegment(
const bits: TBitSource; const res: TStringBuilder; count: Integer;
const fc1InEffect: Boolean): Boolean;
var
start, i, nextTwoCharsBits: Integer;
charArray: TArray<Char>;
begin
Result := false;
// Read two characters at a time
start := res.Length;
while ((count > 1)) do
begin
if (bits.available < 11)
then
exit;
nextTwoCharsBits := bits.readBits(11);
res.Append(TDecodedBitStreamParser.toAlphaNumericChar
((nextTwoCharsBits div 45)));
res.Append(TDecodedBitStreamParser.toAlphaNumericChar
((nextTwoCharsBits mod 45)));
Dec(count, 2);
end;
if (count = 1) then
begin
// special case: one character left
if (bits.available < 6)
then
exit;
res.Append(TDecodedBitStreamParser.toAlphaNumericChar(bits.readBits(6)))
end;
// See section 6.4.8.1, 6.4.8.2
if (fc1InEffect) then
begin
// We need to massage the result a bit if in an FNC1 mode:
for i := start to Pred(res.Length) do
begin
if (res.Chars[i] = '%') then
begin
if ((i < (res.Length - 1)) and (res.Chars[(i + 1)] = '%'))
then
// %% is rendered as %
res.Remove((i + 1), 1)
else
begin
// In alpha mode, % should be converted to FNC1 separator 0x1D
res.Remove(i, 1);
charArray := TArray<Char>.Create(Char($1D));
res.Insert(i, charArray);
end;
end;
end;
end;
Result := true;
end;
class function TDecodedBitStreamParser.decodeByteSegment(const bits: TBitSource;
const res: TStringBuilder; count: Integer;
const currentCharacterSetECI: TCharacterSetECI;
const byteSegments: IByteSegments;
const hints: TDictionary<TDecodeHintType, TObject>): Boolean;
var
Enc:TEncoding;
encodingS, s: string;
readBytes: TArray<Byte>;
i: Integer;
begin
Result := false;
// Don't crash trying to read more bits than we have available.
if ((count shl 3) > bits.available)
then
exit;
readBytes := TArray<Byte>.Create();
SetLength(readBytes, count);
for i := 0 to Pred(count) do
readBytes[i] := Byte(bits.readBits(8));
if (currentCharacterSetECI = nil)
then
// The spec isn't clear on this mode; see
// section 6.4.5: t does not say which encoding to assuming
// upon decoding. I have seen ISO-8859-1 used as well as
// Shift_JIS -- without anything like an ECI designator to
// give a hint.
encodingS := TStringUtils.guessEncoding(readBytes, hints)
else
encodingS := currentCharacterSetECI.EncodingName;
try
enc := TEncoding.GetEncoding(encodingS);
try
s := enc.GetString(readBytes, 0, Length(readBytes));
res.Append(s);
finally
FreeAndNil(enc);
end;
except
on E: Exception do
exit;
end;
byteSegments.Add(readBytes);
result := true;
end;
class function TDecodedBitStreamParser.decodeHanziSegment(
const bits: TBitSource; const res: TStringBuilder; count: Integer): Boolean;
var
buffer: TArray<Byte>;
offset, twoBytes,
assembledTwoBytes: Integer;
begin
Result := false;
// Don't crash trying to read more bits than we have available.
if ((count * 13) > bits.available)
then
exit;
// Each character will require 2 bytes. Read the characters as 2-byte pairs
// and decode as GB2312 afterwards
buffer := TArray<Byte>.Create();
SetLength(buffer, 2 * count);
offset := 0;
while ((count > 0)) do
begin
// Each 13 bits encodes a 2-byte character
twoBytes := bits.readBits(13);
assembledTwoBytes := (((twoBytes div $60) shl 8) or (twoBytes mod $60));
if (assembledTwoBytes < $00A00)
then
// In the 0xA1A1 to 0xAAFE range
Inc(assembledTwoBytes, $0A1A1)
else
// In the 0xB0A1 to 0xFAFE range
Inc(assembledTwoBytes, $0A6A1);
buffer[offset] := Byte(TMathUtils.Asr(assembledTwoBytes, 8) and $FF);
buffer[(offset + 1)] := Byte(assembledTwoBytes and $FF);
Inc(offset, 2);
Dec(count);
end;
try
res.Append(Tencoding.GetEncoding(TStringUtils.GB2312).GetString(buffer, 0,
Length(buffer)))
except
on E: Exception do
exit;
end;
Result := true;
end;
class function TDecodedBitStreamParser.decodeKanjiSegment(
const bits: TBitSource; const res: TStringBuilder; count: Integer): Boolean;
var
buffer: TArray<Byte>;
twoBytes, offset,
assembledTwoBytes: Integer;
begin
Result := false;
// Don't crash trying to read more bits than we have available.
if ((count * 13) > bits.available)
then
exit;
// Each character will require 2 bytes. Read the characters as 2-byte pairs
// and decode as Shift_JIS afterwards
buffer := TArray<Byte>.Create();
SetLength(buffer, 2 * count);
offset := 0;
while ((count > 0)) do
begin
// Each 13 bits encodes a 2-byte character
twoBytes := bits.readBits(13);
assembledTwoBytes := (((twoBytes div $0C0) shl 8) or (twoBytes mod $0C0));
if (assembledTwoBytes < $1F00)
then
// In the 0x8140 to 0x9FFC range
Inc(assembledTwoBytes, $08140)
else
Inc(assembledTwoBytes, $0C140);
buffer[offset] := Byte( TMathUtils.Asr(assembledTwoBytes,8));
buffer[(offset + 1)] := Byte(assembledTwoBytes);
Inc(offset, 2);
Dec(count);
end;
try
res.Append(Tencoding.GetEncoding(TStringUtils.SHIFT_JIS).GetString(buffer,
0, Length(buffer)))
except
on E: Exception do
exit;
end;
Result := true;
end;
class function TDecodedBitStreamParser.decodeNumericSegment(
const bits: TBitSource; const res: TStringBuilder; count: Integer): Boolean;
var
threeDigitsBits,
twoDigitsBits,
digitBits: Integer;
begin
Result := false;
// Read three digits at a time
while ((count >= 3)) do
begin
if (bits.available < 10)
then
exit;
threeDigitsBits := bits.readBits(10);
if (threeDigitsBits >= 1000)
then
exit;
res.Append(TDecodedBitStreamParser.toAlphaNumericChar
((threeDigitsBits div 100)));
res.Append(TDecodedBitStreamParser.toAlphaNumericChar
(((threeDigitsBits div 10) mod 10)));
res.Append(TDecodedBitStreamParser.toAlphaNumericChar
((threeDigitsBits mod 10)));
Dec(count, 3)
end;
if (count = 2) then
begin
// Two digits left over to read, encoded in 7 bits
if (bits.available < 7)
then
exit;
twoDigitsBits := bits.readBits(7);
if (twoDigitsBits >= 100)
then
exit;
res.Append(TDecodedBitStreamParser.toAlphaNumericChar
((twoDigitsBits div 10)));
res.Append(TDecodedBitStreamParser.toAlphaNumericChar
((twoDigitsBits mod 10)));
end else
begin
if (count = 1) then
begin
// One digit left over to read
if (bits.available < 4)
then
exit;
digitBits := bits.readBits(4);
if (digitBits >= 10)
then
exit;
res.Append(TDecodedBitStreamParser.toAlphaNumericChar(digitBits))
end;
end;
Result := true;
end;
class function TDecodedBitStreamParser.parseECIValue(
const bits: TBitSource): Integer;
var
firstByte,
secondByte,
SecondThirdBytes: Integer;
begin
firstByte := bits.readBits(8);
if ((firstByte and $80) = 0) then
begin
// just one byte
Result := (firstByte and $7F);
exit;
end;
if ((firstByte and $C0) = $80) then
begin
// two bytes
secondByte := bits.readBits(8);
Result := (((firstByte and $3F) shl 8) or secondByte);
exit;
end;
if ((firstByte and $E0) = $C0) then
begin
// three bytes
SecondThirdBytes := bits.readBits(16);
Result := (((firstByte and $1F) shl 16) or SecondThirdBytes);
exit;
end;
raise EArgumentException.Create('Bad ECI bits starting with byte ' +
firstByte.toString());
end;
class function TDecodedBitStreamParser.toAlphaNumericChar(
const value: Integer): Char;
begin
if (value >= Length(ALPHANUMERIC_CHARS))
then
raise Exception.Create('Format exception');
Result := ALPHANUMERIC_CHARS[value];
end;
initialization
TDecodedBitStreamParser.InitializeClass;
finalization
TDecodedBitStreamParser.FinalizeClass;
end.
@@ -0,0 +1,278 @@
{
* 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
}
unit ZXing.QrCode.Internal.Decoder;
interface
uses
System.SysUtils,
System.Generics.Collections,
ZXing.DecodeHintType,
ZXing.Common.BitMatrix,
ZXing.QrCode.Internal.BitMatrixParser,
ZXing.DecoderResult,
ZXing.Common.ReedSolomon.ReedSolomonDecoder,
ZXing.Common.ReedSolomon.GenericGF,
ZXing.QrCode.Internal.QRCodeDecoderMetaData,
ZXing.QrCode.Internal.Version,
ZXing.QrCode.Internal.FormatInformation,
ZXing.QrCode.Internal.ErrorCorrectionLevel,
ZXing.QrCode.Internal.DataBlock,
ZXing.QrCode.Internal.DecodedBitStreamParser;
type
/// <summary>
/// <p>The main class which implements QR Code decoding -- as opposed to locating and extracting
/// the QR Code from an image.</p>
/// </summary>
TQRDecoder = class
private
rsDecoder: TReedSolomonDecoder;
/// <summary>
/// <p>Given data and error-correction codewords received, possibly corrupted by errors, attempts to
/// correct the errors in-place using Reed-Solomon error correction.</p>
/// </summary>
/// <param name="codewordBytes">data and error correction codewords</param>
/// <param name="numDataCodewords">number of codewords that are data bytes</param>
/// <returns></returns>
function correctErrors(const codewordBytes: TArray<Byte>;
const numDataCodewords: Integer): Boolean;
function decode(const parser: TBitMatrixParser;
const hints: TDictionary<TDecodeHintType, TObject>)
: TDecoderResult; overload;
public
/// <summary>
/// Initializes a new instance of the <see cref="Decoder"/> class.
/// </summary>
constructor Create;
destructor Destroy; override;
/// <summary>
/// <p>Convenience method that can decode a QR Code represented as a 2D array of booleans.
/// "true" is taken to mean a black module.</p>
/// </summary>
/// <param name="image">booleans representing white/black QR Code modules</param>
/// <param name="hints">decoding hints that should be used to influence decoding</param>
/// <returns>
/// text and bytes encoded within the QR Code
/// </returns>
function decode(const image: TArray<TArray<Boolean>>;
const hints: TDictionary<TDecodeHintType, TObject>)
: TDecoderResult; overload;
/// <summary>
/// <p>Decodes a QR Code represented as a {@link BitMatrix}. A 1 or "true" is taken to mean a black module.</p>
/// </summary>
/// <param name="bits">booleans representing white/black QR Code modules</param>
/// <param name="hints">decoding hints that should be used to influence decoding</param>
/// <returns>
/// text and bytes encoded within the QR Code
/// </returns>
function decode(const bits: TBitMatrix;
const hints: TDictionary<TDecodeHintType, TObject>)
: TDecoderResult; overload;
end;
implementation
{ TQRDecoder }
constructor TQRDecoder.Create;
begin
rsDecoder := TReedSolomonDecoder.Create(TGenericGF.QR_CODE_FIELD_256);
end;
destructor TQRDecoder.Destroy;
begin
FreeAndNil(rsDecoder);
inherited;
end;
function TQRDecoder.correctErrors(const codewordBytes: TArray<Byte>;
const numDataCodewords: Integer): Boolean;
var
i, numCodewords, numECCodewords: Integer;
codewordsInts: TArray<Integer>;
begin
Result := false;
numCodewords := Length(codewordBytes);
// First read into an array of ints
codewordsInts := TArray<Integer>.Create();
SetLength(codewordsInts, numCodewords);
for i := 0 to Pred(numCodewords) do
codewordsInts[i] := (codewordBytes[i] and $FF);
numECCodewords := Length(codewordBytes) - numDataCodewords;
if (not rsDecoder.decode(codewordsInts, numECCodewords)) then
exit;
// Copy back into array of bytes -- only need to worry about the bytes that were data
// We don't care about errors in the error-correction codewords
for i := 0 to Pred(numDataCodewords) do
codewordBytes[i] := Byte(codewordsInts[i]);
Result := true;
end;
function TQRDecoder.decode(const image: TArray<TArray<Boolean>>;
const hints: TDictionary<TDecodeHintType, TObject>): TDecoderResult;
var
dimension, i, j: Integer;
bits: TBitMatrix;
begin
dimension := Length(image);
bits := TBitMatrix.Create(dimension);
try
for i := 0 to Pred(dimension) do
for j := 0 to Pred(dimension) do
bits[j, i] := image[i][j];
Result := decode(bits, hints);
finally
bits.Free;
end;
end;
function TQRDecoder.decode(const bits: TBitMatrix;
const hints: TDictionary<TDecodeHintType, TObject>): TDecoderResult;
var
parser: TBitMatrixParser;
begin
Result := nil;
// Construct a parser and read version, error-correction level
parser := TBitMatrixParser.createBitMatrixParser(bits);
if Assigned(parser) then
begin
try
Result := decode(parser, hints);
if (Result = nil) then
begin
// Revert the bit matrix
parser.remask;
// Will be attempting a mirrored reading of the version and format info.
parser.setMirror(true);
// Preemptively read the version.
if (parser.readVersion = nil) then
exit;
// Preemptively read the format information.
if (parser.readFormatInformation = nil) then
exit;
(*
* Since we're here, this means we have successfully detected some kind
* of version and format information when mirrored. This is a good sign,
* that the QR code may be mirrored, and we should try once more with a
* mirrored content.
*)
// Prepare for a mirrored reading.
parser.mirror;
Result := decode(parser, hints);
if (Result <> nil) then
// Success! Notify the caller that the code was mirrored.
Result.Other := TQRCodeDecoderMetaData.Create(true);
end;
finally
parser.Free;
end;
end;
end;
function TQRDecoder.decode(const parser: TBitMatrixParser;
const hints: TDictionary<TDecodeHintType, TObject>): TDecoderResult;
var
DataBlock: TDataBlock;
dataBlocks: TArray<TDataBlock>;
Version: TVersion;
formatInfo: TFormatInformation;
ecLevel: TErrorCorrectionLevel;
codeWords, resultBytes, codewordBytes: TArray<Byte>;
totalBytes, resultOffset, i, numDataCodewords: Integer;
begin
Result := nil;
Version := parser.readVersion;
if (Version = nil) then
exit;
formatInfo := parser.readFormatInformation;
if (formatInfo = nil) then
exit;
ecLevel := formatInfo.ErrorCorrectionLevel;
// Read codewords
codeWords := parser.readCodewords;
if (codeWords = nil) then
begin
FreeAndNil(formatInfo);
exit;
end;
// Separate into data blocks
dataBlocks := TDataBlock.getDataBlocks(codeWords, Version, ecLevel);
// Count total number of data bytes
totalBytes := 0;
for DataBlock in dataBlocks do
Inc(totalBytes, DataBlock.numDataCodewords);
resultBytes := TArray<Byte>.Create();
SetLength(resultBytes, totalBytes);
try
resultOffset := 0;
// Error-correct and copy data blocks together into a stream of bytes
for DataBlock in dataBlocks do
begin
codewordBytes := DataBlock.codeWords;
numDataCodewords := DataBlock.numDataCodewords;
if (not self.correctErrors(codewordBytes, numDataCodewords)) then
begin
exit(nil);
end;
for i := 0 to Pred(numDataCodewords) do
begin
resultBytes[resultOffset] := codewordBytes[i];
Inc(resultOffset);
end;
end;
// Decode the contents of that stream of bytes
Result := TDecodedBitStreamParser.decode(resultBytes, Version,
ecLevel, hints);
finally
for DataBlock in dataBlocks do
DataBlock.Free;
FreeAndNil(formatInfo);
end;
end;
end.
@@ -0,0 +1,149 @@
{
* 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
}
unit ZXing.QrCode.Internal.ErrorCorrectionLevel;
interface
uses SysUtils;
type
/// <summary>
/// <p>See ISO 18004:2006, 6.5.1. This enum encapsulates the four error correction levels
/// defined by the QR code standard.</p>
/// </summary>
TErrorCorrectionLevel = class sealed
private
Fbits: Integer;
Fname: string;
Fordinal_Renamed_Field: Integer;
class var FOR_BITS: TArray<TErrorCorrectionLevel>;
class procedure InitalizeClass; static;
class procedure FinalizeClass; static;
public
constructor Create(const ordinal, bits: Integer; const name: String);
/// <summary>
/// Fors the bits.
/// </summary>
/// <param name="bits">int containing the two bits encoding a QR Code's error correction level</param>
/// <returns>
/// <see cref="ErrorCorrectionLevel"/> representing the encoded error correction level
/// </returns>
class function forBits(const bits: Integer): TErrorCorrectionLevel; static;
/// <summary> L = ~7% correction</summary>
class var L: TErrorCorrectionLevel;
/// <summary> M = ~15% correction</summary>
class var M: TErrorCorrectionLevel;
/// <summary> Q = ~25% correction</summary>
class var Q: TErrorCorrectionLevel;
/// <summary> H = ~30% correction</summary>
class var H: TErrorCorrectionLevel;
/// <summary>
/// Ordinals this instance.
/// </summary>
/// <returns></returns>
function ordinal: Integer;
/// <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;
/// <summary>
/// Gets the bits.
/// </summary>
property Bits: Integer read Fbits;
/// <summary>
/// Gets the name.
/// </summary>
property Name: String read Fname;
end;
implementation
{ TErrorCorrectionLevel }
constructor TErrorCorrectionLevel.Create(const ordinal, bits: Integer;
const name: String);
begin
Fordinal_Renamed_Field := ordinal;
Fbits := bits;
Fname := name
end;
class procedure TErrorCorrectionLevel.InitalizeClass;
begin
H := TErrorCorrectionLevel.Create(3, 2, 'H');
L := TErrorCorrectionLevel.Create(0, 1, 'L');
M := TErrorCorrectionLevel.Create(1, 0, 'M');
Q := TErrorCorrectionLevel.Create(2, 3, 'Q');
FOR_BITS := TArray<TErrorCorrectionLevel>.Create(M, L, H, Q);
end;
class procedure TErrorCorrectionLevel.FinalizeClass;
begin
H.FOR_BITS := nil;
L.FOR_BITS := nil;
M.FOR_BITS := nil;
Q.FOR_BITS := nil;
FreeAndNil(H);
FreeAndNil(L);
FreeAndNil(M);
FreeAndNil(Q);
FOR_BITS := nil;
end;
class function TErrorCorrectionLevel.forBits(const bits: Integer): TErrorCorrectionLevel;
begin
if ((bits < 0) or
(bits >= Length(TErrorCorrectionLevel.FOR_BITS)))
then
raise EArgumentException.Create('Invalid argument');
Result := TErrorCorrectionLevel.FOR_BITS[bits];
end;
function TErrorCorrectionLevel.ordinal: Integer;
begin
Result := Fordinal_Renamed_Field;
end;
function TErrorCorrectionLevel.ToString: string;
begin
Result := Fname
end;
initialization
TErrorCorrectionLevel.InitalizeClass;
finalization
TErrorCorrectionLevel.FinalizeClass;
end.
@@ -0,0 +1,256 @@
{
* 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.QrCode.Internal.FormatInformation;
interface
uses
Generics.Collections,
ZXing.QrCode.Internal.ErrorCorrectionLevel,
Classes,
ZXing.Common.Detector.MathUtils;
type
/// <summary> <p>Encapsulates a QR Code's format information, including the data mask used and
/// error correction level.</p>
///
/// </summary>
/// <seealso cref="TDataMask">
/// </seealso>
/// <seealso cref="TErrorCorrectionLevel">
/// </seealso>
TFormatInformation = class sealed
private
FErrorCorrectionLevel: TErrorCorrectionLevel;
FDataMask: Byte;
const
FORMAT_INFO_MASK_QR: Integer = $5412;
/// <summary> See ISO 18004:2006, Annex C, Table C.1</summary>
class var FORMAT_INFO_DECODE_LOOKUP: TArray<TArray<Integer>>;
/// <summary> Offset i holds the number of 1 bits in the binary representation of i</summary>
class var BITS_SET_IN_HALF_BYTE: TArray<Integer>;
class procedure InitializeClass; static;
class procedure FinalizeClass; static;
class function doDecodeFormatInformation(const maskedFormatInfo1,
maskedFormatInfo2: Integer): TFormatInformation; static;
public
constructor Create(const formatInfo: Integer);
function Equals(o: TObject): Boolean; override;
function GetHashCode: Integer; override;
class function numBitsDiffering(a, b: Integer): Integer; static;
/// <summary>
/// Decodes the format information.
/// </summary>
/// <param name="maskedFormatInfo1">format info indicator, with mask still applied</param>
/// <param name="maskedFormatInfo2">The masked format info2.</param>
/// <returns>
/// information about the format it specifies, or <code>null</code>
/// if doesn't seem to match any known pattern
/// </returns>
class function decodeFormatInformation(const maskedFormatInfo1,
maskedFormatInfo2: Integer): TFormatInformation; static;
property ErrorCorrectionLevel: TErrorCorrectionLevel
read FErrorCorrectionLevel;
property DataMask: Byte read FDataMask;
end;
implementation
{ TFormatInformation }
constructor TFormatInformation.Create(const formatInfo: Integer);
begin
// Bits 3,4
FErrorCorrectionLevel := TErrorCorrectionLevel.forBits
(TMathUtils.Asr(formatInfo, 3) and $03);
// Bottom 3 bits
FDataMask := Byte(formatInfo and 7);
end;
class function TFormatInformation.decodeFormatInformation
(const maskedFormatInfo1, maskedFormatInfo2: Integer): TFormatInformation;
var
formatInfo: TFormatInformation;
begin
formatInfo := doDecodeFormatInformation(maskedFormatInfo1, maskedFormatInfo2);
if (formatInfo <> nil) then
Result := formatInfo
else
// Should return null, but, some QR codes apparently
// do not mask this info. Try again by actually masking the pattern
// first
Result := TFormatInformation.doDecodeFormatInformation
((maskedFormatInfo1 xor FORMAT_INFO_MASK_QR),
(maskedFormatInfo2 xor FORMAT_INFO_MASK_QR));
end;
class function TFormatInformation.doDecodeFormatInformation
(const maskedFormatInfo1, maskedFormatInfo2: Integer): TFormatInformation;
var
bestDifference, bestFormatInfo, bitsDifference, targetInfo: Integer;
decodeInfo: TArray<Integer>;
begin
Result := nil;
// Find the int in FORMAT_INFO_DECODE_LOOKUP with fewest bits differing
bestDifference := High(Integer);
bestFormatInfo := 0;
for decodeInfo in FORMAT_INFO_DECODE_LOOKUP do
begin
targetInfo := decodeInfo[0];
if ((targetInfo = maskedFormatInfo1) or (targetInfo = maskedFormatInfo2))
then
begin
// Found an exact match
Result := TFormatInformation.Create(decodeInfo[1]);
exit;
end;
bitsDifference := numBitsDiffering(maskedFormatInfo1, targetInfo);
if (bitsDifference < bestDifference) then
begin
bestFormatInfo := decodeInfo[1];
bestDifference := bitsDifference;
end;
if (maskedFormatInfo1 <> maskedFormatInfo2) then
begin
// also try the other option
bitsDifference := numBitsDiffering(maskedFormatInfo2, targetInfo);
if (bitsDifference < bestDifference) then
begin
bestFormatInfo := decodeInfo[1];
bestDifference := bitsDifference;
end;
end;
end;
// Hamming distance of the 32 masked codes is 7, by construction, so <= 3 bits
// differing means we found a match
if (bestDifference <= 3) then
begin
Result := TFormatInformation.Create(bestFormatInfo);
exit;
end;
end;
function TFormatInformation.Equals(o: TObject): Boolean;
var
other: TFormatInformation;
begin
Result := false;
if (not(o is TFormatInformation)) then
exit;
other := TFormatInformation(o);
Result := ((FErrorCorrectionLevel = other.ErrorCorrectionLevel) and
(FDataMask = other.DataMask));
end;
function TFormatInformation.GetHashCode: Integer;
begin
Result := ((FErrorCorrectionLevel.ordinal shl 3) or FDataMask)
end;
class procedure TFormatInformation.InitializeClass;
begin
SetLength(FORMAT_INFO_DECODE_LOOKUP, $20);
FORMAT_INFO_DECODE_LOOKUP[0] := TArray<Integer>.Create($5412, 0);
FORMAT_INFO_DECODE_LOOKUP[1] := TArray<Integer>.Create($5125, 1);
FORMAT_INFO_DECODE_LOOKUP[2] := TArray<Integer>.Create($5E7C, 2);
FORMAT_INFO_DECODE_LOOKUP[3] := TArray<Integer>.Create($5B4B, 3);
FORMAT_INFO_DECODE_LOOKUP[4] := TArray<Integer>.Create($45F9, 4);
FORMAT_INFO_DECODE_LOOKUP[5] := TArray<Integer>.Create($40CE, 5);
FORMAT_INFO_DECODE_LOOKUP[6] := TArray<Integer>.Create($4F97, 6);
FORMAT_INFO_DECODE_LOOKUP[7] := TArray<Integer>.Create($4AA0, 7);
FORMAT_INFO_DECODE_LOOKUP[8] := TArray<Integer>.Create($77C4, 8);
FORMAT_INFO_DECODE_LOOKUP[9] := TArray<Integer>.Create($72F3, 9);
FORMAT_INFO_DECODE_LOOKUP[10] := TArray<Integer>.Create($7DAA, 10);
FORMAT_INFO_DECODE_LOOKUP[11] := TArray<Integer>.Create($789D, 11);
FORMAT_INFO_DECODE_LOOKUP[12] := TArray<Integer>.Create($662F, 12);
FORMAT_INFO_DECODE_LOOKUP[13] := TArray<Integer>.Create($6318, 13);
FORMAT_INFO_DECODE_LOOKUP[14] := TArray<Integer>.Create($6C41, 14);
FORMAT_INFO_DECODE_LOOKUP[15] := TArray<Integer>.Create($6976, 15);
FORMAT_INFO_DECODE_LOOKUP[$10] := TArray<Integer>.Create($1689, $10);
FORMAT_INFO_DECODE_LOOKUP[$11] := TArray<Integer>.Create($13BE, $11);
FORMAT_INFO_DECODE_LOOKUP[$12] := TArray<Integer>.Create($1CE7, $12);
FORMAT_INFO_DECODE_LOOKUP[$13] := TArray<Integer>.Create($19D0, $13);
FORMAT_INFO_DECODE_LOOKUP[20] := TArray<Integer>.Create($762, 20);
FORMAT_INFO_DECODE_LOOKUP[$15] := TArray<Integer>.Create($255, $15);
FORMAT_INFO_DECODE_LOOKUP[$16] := TArray<Integer>.Create($D0C, $16);
FORMAT_INFO_DECODE_LOOKUP[$17] := TArray<Integer>.Create($83B, $17);
FORMAT_INFO_DECODE_LOOKUP[$18] := TArray<Integer>.Create($355F, $18);
FORMAT_INFO_DECODE_LOOKUP[$19] := TArray<Integer>.Create($3068, $19);
FORMAT_INFO_DECODE_LOOKUP[$1A] := TArray<Integer>.Create($3F31, $1A);
FORMAT_INFO_DECODE_LOOKUP[$1B] := TArray<Integer>.Create($3A06, $1B);
FORMAT_INFO_DECODE_LOOKUP[$1C] := TArray<Integer>.Create($24B4, $1C);
FORMAT_INFO_DECODE_LOOKUP[$1D] := TArray<Integer>.Create($2183, $1D);
FORMAT_INFO_DECODE_LOOKUP[30] := TArray<Integer>.Create($2EDA, 30);
FORMAT_INFO_DECODE_LOOKUP[$1F] := TArray<Integer>.Create($2BED, $1F);
BITS_SET_IN_HALF_BYTE := TArray<Integer>.Create(0, 1, 1, 2, 1, 2, 2, 3, 1, 2,
2, 3, 2, 3, 3, 4);
end;
class procedure TFormatInformation.FinalizeClass;
var
i: Integer;
begin
for i := 0 to Pred(Length(FORMAT_INFO_DECODE_LOOKUP)) do
FORMAT_INFO_DECODE_LOOKUP[i] := nil;
FORMAT_INFO_DECODE_LOOKUP := nil;
BITS_SET_IN_HALF_BYTE := nil;
end;
class function TFormatInformation.numBitsDiffering(a, b: Integer): Integer;
begin
a := (a xor b); // a now has a 1 bit exactly where its bit differs with b's
// Count bits set quickly with a series of lookups:
Result := BITS_SET_IN_HALF_BYTE[(a and $0F)] + BITS_SET_IN_HALF_BYTE
[TMathUtils.Asr(UInt32(a), 4) and $0F] + BITS_SET_IN_HALF_BYTE
[TMathUtils.Asr(UInt32(a), 8) and $0F] + BITS_SET_IN_HALF_BYTE
[TMathUtils.Asr(UInt32(a), 12) and $0F] + BITS_SET_IN_HALF_BYTE
[TMathUtils.Asr(UInt32(a), 16) and $0F] + BITS_SET_IN_HALF_BYTE
[TMathUtils.Asr(UInt32(a), 20) and $0F] + BITS_SET_IN_HALF_BYTE
[TMathUtils.Asr(UInt32(a), 24) and $0F] + BITS_SET_IN_HALF_BYTE
[TMathUtils.Asr(UInt32(a), 28) and $0F];
end;
initialization
TFormatInformation.InitializeClass;
finalization
TFormatInformation.FinalizeClass;
end.
@@ -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
* Delphi Implementation by E.Spelt and K. Gossens
}
unit ZXing.QrCode.Internal.Mode;
interface
uses
System.SysUtils,
ZXing.QrCode.Internal.Version;
type
/// <summary>
/// <p>See ISO 18004:2006, 6.4.1, Tables 2 and 3. This enum encapsulates the various modes in which
/// data can be encoded to bits in the QR code standard.</p>
/// </summary>
TMode = class sealed
private
Fbits : Integer;
Fname : String;
characterCountBitsForVersions: TArray<Integer>;
class procedure InitializeClass; static;
class procedure FinalizeClass; static;
public
constructor Create(const characterCountBitsForVersions: TArray<Integer>;
const bits: Integer; const name: String); overload;
// No, we can't use an enum here. J2ME doesn't support it.
/// <summary>
///
/// </summary>
class var TERMINATOR: TMode;
/// <summary>
///
/// </summary>
class var NUMERIC: TMode;
/// <summary>
///
/// </summary>
class var ALPHANUMERIC: TMode;
/// <summary>
///
/// </summary>
class var STRUCTURED_APPEND: TMode;
/// <summary>
///
/// </summary>
class var BYTE: TMode;
/// <summary>
///
/// </summary>
class var ECI: TMode; // character counts don't apply
/// <summary>
///
/// </summary>
class var KANJI: TMode;
/// <summary>
///
/// </summary>
class var FNC1_FIRST_POSITION: TMode;
/// <summary>
///
/// </summary>
class var FNC1_SECOND_POSITION: TMode;
/// <summary>See GBT 18284-2000; "Hanzi" is a transliteration of this mode name.</summary>
class var HANZI: TMode;
/// <summary>
/// Fors the bits.
/// </summary>
/// <param name="bits">four bits encoding a QR Code data mode</param>
/// <returns>
/// <see cref="Mode"/> encoded by these bits
/// </returns>
/// <exception cref="ArgumentException">if bits do not correspond to a known mode</exception>
class function forBits(const bits: Integer): TMode; static;
/// <param name="version">version in question
/// </param>
/// <returns> number of bits used, in this QR Code symbol {@link Version}, to encode the
/// count of characters that will follow encoded in this {@link Mode}
/// </returns>
function getCharacterCountBits(const version: TVersion): Integer;
/// <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;
/// <summary>
/// Gets the name.
/// </summary>
property Name: String read Fname;
/// <summary>
/// Gets the bits.
/// </summary>
property Bits: Integer read Fbits;
end;
implementation
{ TMode }
constructor TMode.Create(const characterCountBitsForVersions: TArray<Integer>;
const bits: Integer; const name: String);
begin
Self.characterCountBitsForVersions := characterCountBitsForVersions;
Self.Fbits := bits;
Self.Fname := name
end;
class procedure TMode.InitializeClass;
begin
TMode.TERMINATOR := TMode.Create(TArray<Integer>.Create(0, 0, 0), 0, 'TERMINATOR');
TMode.NUMERIC := TMode.Create(TArray<Integer>.Create(10, 12, 14), 1,
'NUMERIC');
TMode.ALPHANUMERIC := TMode.Create(TArray<Integer>.Create(9, 11, 13), 2,
'ALPHANUMERIC');
TMode.STRUCTURED_APPEND := TMode.Create(TArray<Integer>.Create(0, 0, 0), 3,
'STRUCTURED_APPEND');
TMode.BYTE := TMode.Create(TArray<Integer>.Create(8, $10, $10), 4, 'BYTE');
TMode.ECI := TMode.Create(nil, 7, 'ECI');
TMode.KANJI := TMode.Create(TArray<Integer>.Create(8, 10, 12), 8, 'KANJI');
TMode.FNC1_FIRST_POSITION := TMode.Create(nil, 5, 'FNC1_FIRST_POSITION');
TMode.FNC1_SECOND_POSITION := TMode.Create(nil, 9, 'FNC1_SECOND_POSITION');
TMode.HANZI := TMode.Create(TArray<Integer>.Create(8, 10, 12), 13, 'HANZI')
end;
class procedure TMode.FinalizeClass;
begin
TMode.TERMINATOR.characterCountBitsForVersions := nil;
TMode.NUMERIC.characterCountBitsForVersions := nil;
TMode.ALPHANUMERIC.characterCountBitsForVersions := nil;
TMode.STRUCTURED_APPEND.characterCountBitsForVersions := nil;
TMode.BYTE.characterCountBitsForVersions := nil;
TMode.ECI.characterCountBitsForVersions := nil;
TMode.KANJI.characterCountBitsForVersions := nil;
TMode.FNC1_FIRST_POSITION.characterCountBitsForVersions := nil;
TMode.FNC1_SECOND_POSITION.characterCountBitsForVersions := nil;
TMode.HANZI.characterCountBitsForVersions := nil;
// SetLength(TMode.TERMINATOR.name, 0);
// SetLength(TMode.NUMERIC.name, 0);
// SetLength(TMode.ALPHANUMERIC.name, 0);
// SetLength(TMode.STRUCTURED_APPEND.name, 0);
// SetLength(TMode.BYTE.name, 0);
// SetLength(TMode.ECI.name, 0);
// SetLength(TMode.KANJI.name, 0);
// SetLength(TMode.FNC1_FIRST_POSITION.name, 0);
// SetLength(TMode.FNC1_SECOND_POSITION.name, 0);
// SetLength(TMode.HANZI.name, 0);
FreeAndNil(TMode.TERMINATOR);
FreeAndNil(TMode.NUMERIC);
FreeAndNil(TMode.ALPHANUMERIC);
FreeAndNil(TMode.STRUCTURED_APPEND);
FreeAndNil(TMode.BYTE);
FreeAndNil(TMode.ECI);
FreeAndNil(TMode.KANJI);
FreeAndNil(TMode.FNC1_FIRST_POSITION);
FreeAndNil(TMode.FNC1_SECOND_POSITION);
FreeAndNil(TMode.HANZI);
end;
class function TMode.forBits(const bits: Integer): TMode;
begin
case bits of
$0: Result := TMode.TERMINATOR;
$1: Result := TMode.NUMERIC;
$2: Result := TMode.ALPHANUMERIC;
$3: Result := TMode.STRUCTURED_APPEND;
$4: Result := TMode.BYTE;
$5: Result := TMode.FNC1_FIRST_POSITION;
$7: Result := TMode.ECI;
$8: Result := TMode.KANJI;
$9: Result := TMode.FNC1_SECOND_POSITION;
$D: Result := TMode.HANZI; // 0xD is defined in GBT 18284-2000, may not be supported in foreign country
else
raise EArgumentException.Create('Invalid arguments');
end;
end;
function TMode.getCharacterCountBits(const version: TVersion): Integer;
var
offset,
number : Integer;
begin
if (Self.characterCountBitsForVersions = nil)
then
raise EArgumentException.Create('Character count doesn''t apply to this mode');
number := version.VersionNumber;
if (number <= 9)
then
offset := 0
else
if (number <= 26)
then
offset := 1
else
offset := 2;
Result := Self.characterCountBitsForVersions[offset];
end;
function TMode.ToString: string;
begin
Result := Self.name;
end;
initialization
TMode.InitializeClass;
finalization
TMode.FinalizeClass;
end.
@@ -0,0 +1,77 @@
{
* Copyright 2013 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.
* Delphi Implementation by E. Spelt and K. Gossens
}
unit ZXing.QrCode.Internal.QRCodeDecoderMetaData;
interface
uses
ZXing.ResultPoint;
type
/// <summary>
/// Meta-data container for QR Code decoding. Instances of this class may be used to convey information back to the
/// decoding caller. Callers are expected to process this.
/// </summary>
TQRCodeDecoderMetaData = class sealed
private
Fmirrored: Boolean;
public
/// <summary>
/// Initializes a new instance of the <see cref="TQRCodeDecoderMetaData"/> class.
/// </summary>
/// <param name="mirrored">if set to <c>true</c> [mirrored].</param>
constructor Create(const mirrored: Boolean);
/// <summary>
/// Apply the result points' order correction due to mirroring.
/// </summary>
/// <param name="points">Array of points to apply mirror correction to.</param>
procedure applyMirroredCorrection(const points: TArray<IResultPoint>);
/// <summary>
/// true if the QR Code was mirrored.
/// </summary>
property IsMirrored: boolean read Fmirrored;
end;
implementation
{ TQRCodeDecoderMetaData }
constructor TQRCodeDecoderMetaData.Create(const mirrored: Boolean);
begin
Fmirrored := mirrored;
end;
procedure TQRCodeDecoderMetaData.applyMirroredCorrection(
const points: TArray<IResultPoint>);
var
bottomLeft: IResultPoint;
begin
if ((FMirrored and (points <> nil)) and (Length(points) >= 3)) then
begin
bottomLeft := points[0];
points[0] := points[2];
points[2] := bottomLeft;
// No need to 'fix' top-left and alignment pattern.
end
end;
end.
@@ -0,0 +1,681 @@
{
* 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
}
unit ZXing.QrCode.Internal.Version;
interface
uses
System.SysUtils,
ZXing.Common.Bitmatrix,
ZXing.QrCode.Internal.ErrorCorrectionLevel,
ZXing.QrCode.Internal.FormatInformation,
ZXing.Common.Detector.MathUtils;
type
/// <summary>
/// See ISO 18004:2006 Annex D
/// </summary>
TVersion = class
type
TECB = class
public
count: Integer;
dataCodewords: Integer;
constructor Create(count: Integer; dataCodewords: Integer);
end;
TECBlocks = class sealed
private
ecBlocks: TArray<TECB>;
function getTotalECCodeWords: Integer;
function get_NumBlocks: Integer;
public
ecCodewordsPerBlock: Integer;
constructor Create(ecCodewordsPerBlock: Integer; ecBlocks: TArray<TECB>);
destructor Destroy; override;
function getECBlocks: TArray<TECB>;
{ property ecCodewordsPerBlock: Integer read get_ECCodewordsPerBlock;
property NumBlocks: Integer read get_NumBlocks;
property TotalECCodewords: Integer read get_TotalECCodewords;
}
property NumBlocks: Integer read get_NumBlocks;
property TotalECCodewords: Integer read getTotalECCodeWords;
end;
private
FalignmentPatternCenters: TArray<Integer>;
FecBlocks: TArray<TECBlocks>;
FTotalCodewords: Integer;
FversionNumber: Integer;
class var BuildVersions : TArray<TVersion>;
/// <summary> See ISO 18004:2006 Annex D.
/// Element i represents the raw version bits that specify version i + 7
/// </summary>
class var VERSION_DECODE_INFO: TArray<Integer>;
function CalcDimensionForVersion: Integer;
class function GetBuildVersions: TArray<TVersion>; static;
class procedure ClassInit; static;
class procedure ClassFinal; static;
public
constructor Create(const versionNumber: Integer;
const alignmentPatternCenters: TArray<Integer>;
const ecBlocks: TArray<TECBlocks>);
destructor Destroy; override;
class function decodeVersionInformation(versionBits: Integer)
: TVersion; static;
function buildFunctionPattern: TBitMatrix;
function getECBlocksForLevel(ecLevel: TErrorCorrectionLevel): TECBlocks;
class function getProvisionalVersionForDimension(
const dimension: Integer): TVersion; static;
class function getVersionForNumber(
const versionNumber: Integer): TVersion; static;
function ToString: String; override;
property DimensionForVersion: Integer read CalcDimensionForVersion;
property alignmentPatternCenters: TArray<Integer>
read FalignmentPatternCenters;
property TotalCodewords: Integer read FTotalCodewords;
property versionNumber: Integer read FversionNumber;
end;
implementation
{ TVersion.TECB }
constructor TVersion.TECB.Create(count, dataCodewords: Integer);
begin
self.count := count;
self.dataCodewords := dataCodewords;
end;
{ TVersion.TECBlocks }
constructor TVersion.TECBlocks.Create(ecCodewordsPerBlock: Integer;
ecBlocks: TArray<TECB>);
begin
self.ecBlocks := ecBlocks;
self.ecCodewordsPerBlock := ecCodewordsPerBlock;
end;
destructor TVersion.TECBlocks.Destroy;
begin
ecBlocks :=nil;
inherited;
end;
function TVersion.TECBlocks.getECBlocks: TArray<TECB>;
begin
result := self.ecBlocks;
end;
function TVersion.TECBlocks.getTotalECCodeWords: Integer;
begin
result := ecCodewordsPerBlock * NumBlocks;
end;
function TVersion.TECBlocks.get_NumBlocks: Integer;
var
total: Integer;
ecBlock: TECB;
begin
total := 0;
for ecBlock in ecBlocks do
begin
inc(total, ecBlock.count);
end;
result := total;
end;
{ TVersion }
constructor TVersion.Create(const versionNumber: Integer;
const alignmentPatternCenters: TArray<Integer>;
const ecBlocks: TArray<TECBlocks>);
var
ecBlock: TECB;
total, ecCodewords: Integer;
ecbArray: TArray<TECB>;
begin
FversionNumber := versionNumber;
FalignmentPatternCenters := alignmentPatternCenters;
FecBlocks := ecBlocks;
total := 0;
ecCodewords := ecBlocks[0].ecCodewordsPerBlock;
ecbArray := ecBlocks[0].getECBlocks;
for ecBlock in ecbArray do
Inc(total, (ecBlock.count * (ecBlock.dataCodewords + ecCodewords)));
FTotalCodewords := total;
ecbArray := nil;
end;
destructor TVersion.Destroy;
var
ecBlocks : TECBlocks;
ECB : TECB;
begin
FalignmentPatternCenters := nil;
for ecBlocks in FecBlocks do
begin
for ecb in ecBlocks.ecBlocks do
begin
ECB.Free;
//ECB := nil;
end;
ecBlocks.free;
end;
FecBlocks := nil;
inherited;
end;
function TVersion.buildFunctionPattern: TBitMatrix;
var
dimension, max, x, i, y: Integer;
begin
dimension := DimensionForVersion;
result := TBitMatrix.Create(dimension);
result.setRegion(0, 0, 9, 9);
result.setRegion((dimension - 8), 0, 8, 9);
result.setRegion(0, (dimension - 8), 9, 8);
max := Length(FalignmentPatternCenters);
x := 0;
while ((x < max)) do
begin
i := (FalignmentPatternCenters[x] - 2);
y := 0;
while ((y < max)) do
begin
if (((x <> 0) or ((y <> 0) and (y <> (max - 1)))) and
((x <> (max - 1)) or (y <> 0))) then
result.setRegion((self.alignmentPatternCenters[y] - 2), i, 5, 5);
inc(y)
end;
inc(x)
end;
result.setRegion(6, 9, 1, (dimension - $11));
result.setRegion(9, 6, (dimension - $11), 1);
if (self.versionNumber > 6) then
begin
result.setRegion((dimension - 11), 0, 3, 6);
result.setRegion(0, (dimension - 11), 6, 3)
end;
end;
class function TVersion.GetBuildVersions: TArray<TVersion>;
begin
Result := TArray<TVersion>.Create(
TVersion.Create(1, TArray<Integer>.Create(),
TArray<TECBlocks>.Create(TECBlocks.Create(7,
TArray<TECB>.Create(TECB.Create(1, 19))), TECBlocks.Create(10,
TArray<TECB>.Create(TECB.Create(1, 16))), TECBlocks.Create(13,
TArray<TECB>.Create(TECB.Create(1, 13))), TECBlocks.Create(17,
TArray<TECB>.Create(TECB.Create(1, 9))))),
TVersion.Create(2, TArray<Integer>.Create(6, 18),
TArray<TECBlocks>.Create(TECBlocks.Create(10,
TArray<TECB>.Create(TECB.Create(1, 34))), TECBlocks.Create(16,
TArray<TECB>.Create(TECB.Create(1, 28))), TECBlocks.Create(22,
TArray<TECB>.Create(TECB.Create(1, 22))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(1, 16))))),
TVersion.Create(3, TArray<Integer>.Create(6, 22),
TArray<TECBlocks>.Create(TECBlocks.Create(15,
TArray<TECB>.Create(TECB.Create(1, 55))), TECBlocks.Create(26,
TArray<TECB>.Create(TECB.Create(1, 44))), TECBlocks.Create(18,
TArray<TECB>.Create(TECB.Create(2, 17))), TECBlocks.Create(22,
TArray<TECB>.Create(TECB.Create(2, 13))))),
TVersion.Create(4, TArray<Integer>.Create(6, 26),
TArray<TECBlocks>.Create(TECBlocks.Create(20,
TArray<TECB>.Create(TECB.Create(1, 80))), TECBlocks.Create(18,
TArray<TECB>.Create(TECB.Create(2, 32))), TECBlocks.Create(26,
TArray<TECB>.Create(TECB.Create(2, 24))), TECBlocks.Create(16,
TArray<TECB>.Create(TECB.Create(4, 9))))),
TVersion.Create(5, TArray<Integer>.Create(6, 30),
TArray<TECBlocks>.Create(TECBlocks.Create(26,
TArray<TECB>.Create(TECB.Create(1, 108))), TECBlocks.Create(24,
TArray<TECB>.Create(TECB.Create(2, 43))), TECBlocks.Create(18,
TArray<TECB>.Create(TECB.Create(2, 15), TECB.Create(2, 16))),
TECBlocks.Create(22, TArray<TECB>.Create(TECB.Create(2, 11),
TECB.Create(2, 12))))),
TVersion.Create(6, TArray<Integer>.Create(6, 34),
TArray<TECBlocks>.Create(TECBlocks.Create(18,
TArray<TECB>.Create(TECB.Create(2, 68))), TECBlocks.Create(16,
TArray<TECB>.Create(TECB.Create(4, 27))), TECBlocks.Create(24,
TArray<TECB>.Create(TECB.Create(4, 19))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(4, 15))))),
TVersion.Create(7, TArray<Integer>.Create(6, 22, 38),
TArray<TECBlocks>.Create(TECBlocks.Create(20,
TArray<TECB>.Create(TECB.Create(2, 78))), TECBlocks.Create(18,
TArray<TECB>.Create(TECB.Create(4, 31))), TECBlocks.Create(18,
TArray<TECB>.Create(TECB.Create(2, 14), TECB.Create(4, 15))),
TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(4, 13),
TECB.Create(1, 14))))),
TVersion.Create(8, TArray<Integer>.Create(6, 24, 42),
TArray<TECBlocks>.Create(TECBlocks.Create(24,
TArray<TECB>.Create(TECB.Create(2, 97))), TECBlocks.Create(22,
TArray<TECB>.Create(TECB.Create(2, 38), TECB.Create(2, 39))),
TECBlocks.Create(22, TArray<TECB>.Create(TECB.Create(4, 18), TECB.Create(2,
19))), TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(4, 14),
TECB.Create(2, 15))))),
TVersion.Create(9, TArray<Integer>.Create(6, 26, 46),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(2, 116))), TECBlocks.Create(22,
TArray<TECB>.Create(TECB.Create(3, 36), TECB.Create(2, 37))),
TECBlocks.Create(20, TArray<TECB>.Create(TECB.Create(4, 16), TECB.Create(4,
17))), TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(4, 12),
TECB.Create(4, 13))))),
TVersion.Create(10, TArray<Integer>.Create(6, 28, 50),
TArray<TECBlocks>.Create(TECBlocks.Create(18,
TArray<TECB>.Create(TECB.Create(2, 68), TECB.Create(2, 69))),
TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(4, 43), TECB.Create(1,
44))), TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(6, 19),
TECB.Create(2, 20))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(6, 15), TECB.Create(2, 16))))),
TVersion.Create(11, TArray<Integer>.Create(6, 30, 54),
TArray<TECBlocks>.Create(TECBlocks.Create(20,
TArray<TECB>.Create(TECB.Create(4, 81))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(1, 50), TECB.Create(4, 51))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(4, 22), TECB.Create(4,
23))), TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(3, 12),
TECB.Create(8, 13))))),
TVersion.Create(12, TArray<Integer>.Create(6, 32, 58),
TArray<TECBlocks>.Create(TECBlocks.Create(24,
TArray<TECB>.Create(TECB.Create(2, 92), TECB.Create(2, 93))),
TECBlocks.Create(22, TArray<TECB>.Create(TECB.Create(6, 36), TECB.Create(2,
37))), TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(4, 20),
TECB.Create(6, 21))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(7, 14), TECB.Create(4, 15))))),
TVersion.Create(13, TArray<Integer>.Create(6, 34, 62),
TArray<TECBlocks>.Create(TECBlocks.Create(26,
TArray<TECB>.Create(TECB.Create(4, 107))), TECBlocks.Create(22,
TArray<TECB>.Create(TECB.Create(8, 37), TECB.Create(1, 38))),
TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(8, 20), TECB.Create(4,
21))), TECBlocks.Create(22, TArray<TECB>.Create(TECB.Create(12, 11),
TECB.Create(4, 12))))),
TVersion.Create(14, TArray<Integer>.Create(6, 26, 46, 66),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(3, 115), TECB.Create(1, 116))),
TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(4, 40), TECB.Create(5,
41))), TECBlocks.Create(20, TArray<TECB>.Create(TECB.Create(11, 16),
TECB.Create(5, 17))), TECBlocks.Create(24,
TArray<TECB>.Create(TECB.Create(11, 12), TECB.Create(5, 13))))),
TVersion.Create(15, TArray<Integer>.Create(6, 26, 48, 70),
TArray<TECBlocks>.Create(TECBlocks.Create(22,
TArray<TECB>.Create(TECB.Create(5, 87), TECB.Create(1, 88))),
TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(5, 41), TECB.Create(5,
42))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(5, 24),
TECB.Create(7, 25))), TECBlocks.Create(24,
TArray<TECB>.Create(TECB.Create(11, 12), TECB.Create(7, 13))))),
TVersion.Create(16, TArray<Integer>.Create(6, 26, 50, 74),
TArray<TECBlocks>.Create(TECBlocks.Create(24,
TArray<TECB>.Create(TECB.Create(5, 98), TECB.Create(1, 99))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(7, 45), TECB.Create(3,
46))), TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(15, 19),
TECB.Create(2, 20))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(3, 15), TECB.Create(13, 16))))),
TVersion.Create(17, TArray<Integer>.Create(6, 30, 54, 78),
TArray<TECBlocks>.Create(TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(1, 107), TECB.Create(5, 108))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(10, 46), TECB.Create(1,
47))), TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(1, 22),
TECB.Create(15, 23))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(2, 14), TECB.Create(17, 15))))),
TVersion.Create(18, TArray<Integer>.Create(6, 30, 56, 82),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(5, 120), TECB.Create(1, 121))),
TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(9, 43), TECB.Create(4,
44))), TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(17, 22),
TECB.Create(1, 23))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(2, 14), TECB.Create(19, 15))))),
TVersion.Create(19, TArray<Integer>.Create(6, 30, 58, 86),
TArray<TECBlocks>.Create(TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(3, 113), TECB.Create(4, 114))),
TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(3, 44), TECB.Create(11,
45))), TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(17, 21),
TECB.Create(4, 22))), TECBlocks.Create(26,
TArray<TECB>.Create(TECB.Create(9, 13), TECB.Create(16, 14))))),
TVersion.Create(20, TArray<Integer>.Create(6, 34, 62, 90),
TArray<TECBlocks>.Create(TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(3, 107), TECB.Create(5, 108))),
TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(3, 41), TECB.Create(13,
42))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(15, 24),
TECB.Create(5, 25))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(15, 15), TECB.Create(10, 16))))),
TVersion.Create(21, TArray<Integer>.Create(6, 28, 50, 72, 94),
TArray<TECBlocks>.Create(TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(4, 116), TECB.Create(4, 117))),
TECBlocks.Create(26, TArray<TECB>.Create(TECB.Create(17, 42))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(17, 22), TECB.Create(6,
23))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(19, 16),
TECB.Create(6, 17))))),
TVersion.Create(22, TArray<Integer>.Create(6, 26, 50, 74, 98),
TArray<TECBlocks>.Create(TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(2, 111), TECB.Create(7, 112))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(17, 46))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(7, 24), TECB.Create(16,
25))), TECBlocks.Create(24, TArray<TECB>.Create(TECB.Create(34, 13))))),
TVersion.Create(23, TArray<Integer>.Create(6, 30, 54, 78, 102),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(4, 121), TECB.Create(5, 122))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(4, 47), TECB.Create(14,
48))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(11, 24),
TECB.Create(14, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(16, 15), TECB.Create(14, 16))))),
TVersion.Create(24, TArray<Integer>.Create(6, 28, 54, 80, 106),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(6, 117), TECB.Create(4, 118))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(6, 45), TECB.Create(14,
46))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(11, 24),
TECB.Create(16, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(30, 16), TECB.Create(2, 17))))),
TVersion.Create(25, TArray<Integer>.Create(6, 32, 58, 84, 110),
TArray<TECBlocks>.Create(TECBlocks.Create(26,
TArray<TECB>.Create(TECB.Create(8, 106), TECB.Create(4, 107))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(8, 47), TECB.Create(13,
48))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(7, 24),
TECB.Create(22, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(22, 15), TECB.Create(13, 16))))),
TVersion.Create(26, TArray<Integer>.Create(6, 30, 58, 86, 114),
TArray<TECBlocks>.Create(TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(10, 114), TECB.Create(2, 115))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(19, 46), TECB.Create(4,
47))), TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(28, 22),
TECB.Create(6, 23))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(33, 16), TECB.Create(4, 17))))),
TVersion.Create(27, TArray<Integer>.Create(6, 34, 62, 90, 118),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(8, 122), TECB.Create(4, 123))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(22, 45), TECB.Create(3,
46))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(8, 23),
TECB.Create(26, 24))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(12, 15), TECB.Create(28, 16))))),
TVersion.Create(28, TArray<Integer>.Create(6, 26, 50, 74, 98, 122),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(3, 117), TECB.Create(10, 118))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(3, 45), TECB.Create(23,
46))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(4, 24),
TECB.Create(31, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(11, 15), TECB.Create(31, 16))))),
TVersion.Create(29, TArray<Integer>.Create(6, 30, 54, 78, 102, 126),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(7, 116), TECB.Create(7, 117))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(21, 45), TECB.Create(7,
46))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(1, 23),
TECB.Create(37, 24))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(19, 15), TECB.Create(26, 16))))),
TVersion.Create(30, TArray<Integer>.Create(6, 26, 52, 78, 104, 130),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(5, 115), TECB.Create(10, 116))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(19, 47),
TECB.Create(10, 48))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(15, 24), TECB.Create(25, 25))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(23, 15),
TECB.Create(25, 16))))),
TVersion.Create(31, TArray<Integer>.Create(6, 30, 56, 82, 108, 134),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(13, 115), TECB.Create(3, 116))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(2, 46), TECB.Create(29,
47))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(42, 24),
TECB.Create(1, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(23, 15), TECB.Create(28, 16))))),
TVersion.Create(32, TArray<Integer>.Create(6, 34, 60, 86, 112, 138),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(17, 115))), TECBlocks.Create(28,
TArray<TECB>.Create(TECB.Create(10, 46), TECB.Create(23, 47))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(10, 24),
TECB.Create(35, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(19, 15), TECB.Create(35, 16))))),
TVersion.Create(33, TArray<Integer>.Create(6, 30, 58, 86, 114, 142),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(17, 115), TECB.Create(1, 116))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(14, 46),
TECB.Create(21, 47))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(29, 24), TECB.Create(19, 25))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(11, 15),
TECB.Create(46, 16))))),
TVersion.Create(34, TArray<Integer>.Create(6, 34, 62, 90, 118, 146),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(13, 115), TECB.Create(6, 116))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(14, 46),
TECB.Create(23, 47))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(44, 24), TECB.Create(7, 25))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(59, 16),
TECB.Create(1, 17))))),
TVersion.Create(35, TArray<Integer>.Create(6, 30, 54, 78, 102, 126, 150),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(12, 121), TECB.Create(7, 122))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(12, 47),
TECB.Create(26, 48))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(39, 24), TECB.Create(14, 25))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(22, 15),
TECB.Create(41, 16))))),
TVersion.Create(36, TArray<Integer>.Create(6, 24, 50, 76, 102, 128, 154),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(6, 121), TECB.Create(14, 122))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(6, 47), TECB.Create(34,
48))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(46, 24),
TECB.Create(10, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(2, 15), TECB.Create(64, 16))))),
TVersion.Create(37, TArray<Integer>.Create(6, 28, 54, 80, 106, 132, 158),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(17, 122), TECB.Create(4, 123))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(29, 46),
TECB.Create(14, 47))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(49, 24), TECB.Create(10, 25))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(24, 15),
TECB.Create(46, 16))))),
TVersion.Create(38, TArray<Integer>.Create(6, 32, 58, 84, 110, 136, 162),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(4, 122), TECB.Create(18, 123))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(13, 46),
TECB.Create(32, 47))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(48, 24), TECB.Create(14, 25))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(42, 15),
TECB.Create(32, 16))))),
TVersion.Create(39, TArray<Integer>.Create(6, 26, 54, 82, 110, 138, 166),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(20, 117), TECB.Create(4, 118))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(40, 47), TECB.Create(7,
48))), TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(43, 24),
TECB.Create(22, 25))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(10, 15), TECB.Create(67, 16))))),
TVersion.Create(40, TArray<Integer>.Create(6, 30, 58, 86, 114, 142, 170),
TArray<TECBlocks>.Create(TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(19, 118), TECB.Create(6, 119))),
TECBlocks.Create(28, TArray<TECB>.Create(TECB.Create(18, 47),
TECB.Create(31, 48))), TECBlocks.Create(30,
TArray<TECB>.Create(TECB.Create(34, 24), TECB.Create(34, 25))),
TECBlocks.Create(30, TArray<TECB>.Create(TECB.Create(20, 15),
TECB.Create(61, 16)))))
);
end;
function TVersion.CalcDimensionForVersion: Integer;
begin
result := 17 + 4 * versionNumber;
end;
class function TVersion.decodeVersionInformation(versionBits: Integer)
: TVersion;
var
bestDifference, bestversion, i, targetVersion, bitsDifference: Integer;
begin
bestDifference := $7FFFFFFF;
bestversion := 0;
i := 0;
while ((i < Length(TVersion.VERSION_DECODE_INFO))) do
begin
targetVersion := TVersion.VERSION_DECODE_INFO[i];
if (targetVersion = versionBits) then
begin
result := TVersion.getVersionForNumber((i + 7));
exit
end;
bitsDifference := TFormatInformation.numBitsDiffering(versionBits,
targetVersion);
if (bitsDifference < bestDifference) then
begin
bestversion := (i + 7);
bestDifference := bitsDifference
end;
inc(i)
end;
if (bestDifference <= 3) then
begin
result := TVersion.getVersionForNumber(bestversion);
exit
end;
result := nil;
end;
function TVersion.getECBlocksForLevel(ecLevel: TErrorCorrectionLevel)
: TECBlocks;
begin
result := FecBlocks[ecLevel.ordinal]
end;
class function TVersion.getProvisionalVersionForDimension(
const dimension: Integer): TVersion;
begin
Result := nil;
if ((dimension mod 4) <> 1)
then
exit;
try
Result := TVersion.getVersionForNumber(TMathUtils.Asr(dimension - $11, 2));
except
on E: EArgumentException do
Result := nil;
end
end;
class function TVersion.getVersionForNumber(
const versionNumber: Integer): TVersion;
begin
if ((versionNumber < 1) or (versionNumber > 40)) then
raise EArgumentException.Create
('version number needs to be between 1 and 40');
Result := TVersion.BuildVersions[(versionNumber - 1)];
end;
function TVersion.ToString: string;
begin
result := self.versionNumber.ToString();
end;
class procedure TVersion.ClassInit();
begin
TVersion.VERSION_DECODE_INFO := TArray<Integer>.Create($7C94, $85BC, $9A99,
$A4D3, $BBF6, $C762, $D847, $E60D, $F928, $10B78, $1145D, $12A17, $13532,
$149A6, $15683, $168C9, $177EC, $18EC4, $191E1, $1AFAB, $1B08E, $1CC1A,
$1D33F, $1ED75, $1F250, $209D5, $216F0, $228BA, $2379F, $24B0B, $2542E,
$26A64, $27541, $28C69);
TVersion.BuildVersions := TVersion.GetBuildVersions;
end;
class procedure TVersion.ClassFinal();
var version :Tversion;
begin
TVersion.VERSION_DECODE_INFO := nil;
for version in TVersion.BuildVersions do
begin
version.Free;
end;
TVersion.BuildVersions :=nil;
end;
Initialization
TVersion.ClassInit();
Finalization
TVersion.ClassFinal();
end.
@@ -0,0 +1,632 @@
{
* 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 K. Gossens
}
unit ZXing.Datamatrix.Internal.Detector;
interface
uses
System.SysUtils,
System.Math,
System.Generics.Defaults,
System.Generics.Collections,
ZXing.Common.BitMatrix,
ZXing.DefaultGridSampler,
ZXing.Common.DetectorResult,
ZXing.ResultPoint,
ZXing.Common.GridSampler,
ZXing.Common.Detector.MathUtils,
ZXing.Common.Detector.WhiteRectangleDetector;
type
/// <summary>
/// <p>Encapsulates logic that can detect a Data Matrix Code in an image, even if the Data Matrix Code
/// is rotated or skewed, or partially obscured.</p>
/// </summary>
TDataMatrixDetector = class(TObject)
private
var
Fimage: TBitMatrix;
FrectangleDetector: TWhiteRectangleDetector;
type
/// <summary>
/// Simply encapsulates two points and a number of transitions between them.
/// </summary>
TResultPointsAndTransitions = class sealed
public
From: IResultPoint;
To_: IResultPoint;
Transitions: Integer;
constructor Create(From: IResultPoint; To_: IResultPoint;
Transitions: Integer);
destructor Destroy; override;
function ToString: String; override;
end;
/// <summary>
/// Orders ResultPointsAndTransitions by number of transitions, ascending.
/// </summary>
TResultPointsAndTransitionsComparator = class sealed
(TComparer<TResultPointsAndTransitions>)
public
function Compare(const o1, o2: TResultPointsAndTransitions)
: Integer; override;
end;
var
FtransCompare: TResultPointsAndTransitionsComparator;
public
constructor Create(const image: TBitMatrix);
destructor Destroy; override;
function detect: TDetectorResult;
function transitionsBetween(Afrom, Ato: IResultPoint)
: TResultPointsAndTransitions;
function distance(a: IResultPoint; b: IResultPoint): Integer;
procedure increment(table: TDictionary<IResultPoint, Integer>;
key: IResultPoint);
function sampleGrid(image: TBitMatrix; topLeft, bottomLeft, bottomRight,
topRight: IResultPoint; dimensionX, dimensionY: Integer): TBitMatrix;
function isValid(p: IResultPoint): Boolean;
function correctTopRight(bottomLeft, bottomRight, topLeft,
topRight: IResultPoint; dimension: Integer): IResultPoint;
function correctTopRightRectangular(bottomLeft, bottomRight, topLeft,
topRight: IResultPoint; dimensionTop, dimensionRight: Integer)
: IResultPoint;
end;
implementation
{ TDataMatrixDetector }
/// <summary>
/// Initializes a new instance of the <see cref="Detector"/> class.
/// </summary>
/// <param name="image">The image.</param>
constructor TDataMatrixDetector.Create(const image: TBitMatrix);
begin
Self.Fimage := image;
Self.FrectangleDetector := TWhiteRectangleDetector.New(image);
Self.FtransCompare := TResultPointsAndTransitionsComparator.Create;
end;
destructor TDataMatrixDetector.Destroy;
begin
if (FrectangleDetector <> nil) then
FrectangleDetector.Free;
FtransCompare.Free;
inherited;
end;
/// <summary>
/// <p>Detects a Data Matrix Code in an image.</p>
/// </summary>
/// <returns><see cref="DetectorResult" />encapsulating results of detecting a Data Matrix Code or null</returns>
function TDataMatrixDetector.detect(): TDetectorResult;
var
topRight, correctedTopRight, pointA, pointB, pointC, pointD, maybeTopLeft,
bottomLeft, bottomRight, topLeft, maybeBottomRight, point: IResultPoint;
cornerPoints: TArray<IResultPoint>;
bits: TBitMatrix;
entry: TPair<IResultPoint, Integer>; // TKeyValuePair
Transitions: TObjectList<TResultPointsAndTransitions>;
lSideOne, lSideTwo, transBetween, transA, transB: TResultPointsAndTransitions;
pointCount: TDictionary<IResultPoint, Integer>;
corners: TArray<IResultPoint>;
dimensionTop, dimensionRight, dimension, dimensionCorrected: Integer;
begin
Result := nil;
if (FrectangleDetector = nil) then
// can be null, if the image is to small
exit;
cornerPoints := FrectangleDetector.detect();
if (cornerPoints = nil) then
exit;
pointA := cornerPoints[0];
pointB := cornerPoints[1];
pointC := cornerPoints[2];
pointD := cornerPoints[3];
// Point A and D are across the diagonal from one another,
// as are B and C. Figure out which are the solid black lines
// by counting transitions
Transitions := TObjectList<TResultPointsAndTransitions>.Create;
pointCount := TDictionary<IResultPoint, Integer>.Create();
try
Transitions.Add(transitionsBetween(pointA, pointB));
Transitions.Add(transitionsBetween(pointA, pointC));
Transitions.Add(transitionsBetween(pointB, pointD));
Transitions.Add(transitionsBetween(pointC, pointD));
Transitions.Sort(FtransCompare);
// Sort by number of transitions. First two will be the two solid sides; last two
// will be the two alternating black/white sides
lSideOne := Transitions[0];
lSideTwo := Transitions[1];
// Figure out which point is their intersection by tallying up the number of times we see the
// endpoints in the four endpoints. One will show up twice.
increment(pointCount, lSideOne.From);
increment(pointCount, lSideOne.To_);
increment(pointCount, lSideTwo.From);
increment(pointCount, lSideTwo.To_);
maybeTopLeft := nil;
bottomLeft := nil;
maybeBottomRight := nil;
for entry in pointCount do
begin
point := entry.key;
if (entry.Value = 2) then
bottomLeft := point
// this is definitely the bottom left, then -- end of two L sides
else
begin
// Otherwise it's either top left or bottom right -- just assign the two arbitrarily now
if (maybeTopLeft = nil) then
maybeTopLeft := point
else
maybeBottomRight := point;
end;
end;
if ((maybeTopLeft = nil) or (bottomLeft = nil) or (maybeBottomRight = nil))
then
exit;
// Bottom left is correct but top left and bottom right might be switched
corners := TArray<IResultPoint>.Create(maybeTopLeft, bottomLeft,
maybeBottomRight);
// Use the dot product trick to sort them out
TResultPointHelpers.orderBestPatterns(corners);
// Now we know which is which:
bottomRight := corners[0];
bottomLeft := corners[1];
topLeft := corners[2];
// Which point didn't we find in relation to the "L" sides? that's the top right corner
if (not pointCount.ContainsKey(pointA)) then
topRight := pointA
else if (not pointCount.ContainsKey(pointB)) then
topRight := pointB
else if (not pointCount.ContainsKey(pointC)) then
topRight := pointC
else
topRight := pointD;
// Next determine the dimension by tracing along the top or right side and counting black/white
// transitions. Since we start inside a black module, we should see a number of transitions
// equal to 1 less than the code dimension. Well, actually 2 less, because we are going to
// end on a black module:
// The top right point is actually the corner of a module, which is one of the two black modules
// adjacent to the white module at the top right. Tracing to that corner from either the top left
// or bottom right should work here.
transBetween := transitionsBetween(topLeft, topRight);
dimensionTop := transBetween.Transitions;
transBetween.Free;
transBetween := transitionsBetween(bottomRight, topRight);
dimensionRight := transBetween.Transitions;
transBetween.Free;
if ((dimensionTop and $01) = 1) then
// it can't be odd, so, round... up?
Inc(dimensionTop);
Inc(dimensionTop, 2);
if ((dimensionRight and $01) = 1) then
// it can't be odd, so, round... up?
Inc(dimensionRight);
Inc(dimensionRight, 2);
// Rectangular symbols are 6x16, 6x28, 10x24, 10x32, 14x32, or 14x44. If one dimension is more
// than twice the other, it's certainly rectangular, but to cut a bit more slack we accept it as
// rectangular if the bigger side is at least 7/4 times the other:
if (((4 * dimensionTop) >= (7 * dimensionRight)) or
((4 * dimensionRight) >= (7 * dimensionTop))) then
begin
// The matrix is rectangular
correctedTopRight := correctTopRightRectangular(bottomLeft, bottomRight,
topLeft, topRight, dimensionTop, dimensionRight);
if (correctedTopRight = nil) then
correctedTopRight := topRight;
transBetween := transitionsBetween(topLeft, correctedTopRight);
dimensionTop := transBetween.Transitions;
transBetween.Free;
transBetween := transitionsBetween(bottomRight, correctedTopRight);
dimensionRight := transBetween.Transitions;
transBetween.Free;
if ((dimensionTop and $01) = 1) then
// it can't be odd, so, round... up?
Inc(dimensionTop);
if ((dimensionRight and $01) = 1) then
// it can't be odd, so, round... up?
Inc(dimensionRight);
bits := sampleGrid(Fimage, topLeft, bottomLeft, bottomRight,
correctedTopRight, dimensionTop, dimensionRight)
end
else
begin
// The matrix is square
dimension := System.Math.Min(dimensionRight, dimensionTop);
// correct top right point to match the white module
correctedTopRight := correctTopRight(bottomLeft, bottomRight, topLeft,
topRight, dimension);
if (correctedTopRight = nil) then
correctedTopRight := topRight;
// Redetermine the dimension using the corrected top right point
transA := transitionsBetween(topLeft, correctedTopRight);
transB := transitionsBetween(bottomRight, correctedTopRight);
dimensionCorrected :=
(System.Math.Max(transA.Transitions, transB.Transitions) + 1);
transA.Free;
transB.Free;
if ((dimensionCorrected and $01) = 1) then
Inc(dimensionCorrected);
bits := sampleGrid(Fimage, topLeft, bottomLeft, bottomRight,
correctedTopRight, dimensionCorrected, dimensionCorrected);
end;
if (bits = nil) then
exit;
Result := TDetectorResult.Create(bits, TArray<IResultPoint>.Create(topLeft,
bottomLeft, bottomRight, correctedTopRight));
finally
pointCount.Free;
Transitions.Free;
cornerPoints := nil;
end;
end;
/// <summary>
/// Calculates the position of the white top right module using the output of the rectangle detector
/// for a rectangular matrix
/// </summary>
function TDataMatrixDetector.correctTopRightRectangular(bottomLeft, bottomRight,
topLeft, topRight: IResultPoint; dimensionTop, dimensionRight: Integer)
: IResultPoint;
var
corr, norm, cos, sin: Single;
c1, c2: IResultPoint;
l1, l2: Integer;
rpT1, rpT2: TResultPointsAndTransitions;
begin
corr := (distance(bottomLeft, bottomRight) / dimensionTop);
norm := distance(topLeft, topRight);
if (norm = 0) then
begin
Result := nil;
exit
end;
cos := ((topRight.X - topLeft.X) / norm);
sin := ((topRight.Y - topLeft.Y) / norm);
c1 := TResultPointHelpers.CreateResultPoint((topRight.X + (corr * cos)),
(topRight.Y + (corr * sin)));
corr := (distance(bottomLeft, topLeft) / dimensionRight);
norm := distance(bottomRight, topRight);
if (norm = 0) then
begin
Result := nil;
exit;
end;
cos := ((topRight.X - bottomRight.X) / norm);
sin := ((topRight.Y - bottomRight.Y) / norm);
c2 := TResultPointHelpers.CreateResultPoint((topRight.X + (corr * cos)),
(topRight.Y + (corr * sin)));
if (not isValid(c1)) then
begin
if (isValid(c2)) then
begin
Result := c2;
exit;
end;
Result := nil;
exit;
end;
if (not isValid(c2)) then
begin
Result := c1;
exit;
end;
rpT1 := transitionsBetween(topLeft, c1);
rpT2 := transitionsBetween(bottomRight, c1);
l1 := (Abs((dimensionTop - rpT1.Transitions)) +
Abs((dimensionRight - rpT2.Transitions)));
FreeAndNil(rpT1);
FreeAndNil(rpT2);
rpT1 := transitionsBetween(topLeft, c2);
rpT2 := transitionsBetween(bottomRight, c2);
l2 := (Abs((dimensionTop - rpT1.Transitions)) +
Abs((dimensionRight - rpT2.Transitions)));
FreeAndNil(rpT1);
FreeAndNil(rpT2);
if (l1 <= l2) then
begin
Result := c1;
end
else
begin
Result := c2;
end;
end;
/// <summary>
/// Calculates the position of the white top right module using the output of the rectangle detector
/// for a square matrix
/// </summary>
function TDataMatrixDetector.correctTopRight(bottomLeft, bottomRight, topLeft,
topRight: IResultPoint; dimension: Integer): IResultPoint;
var
corr, cos, sin: Single;
norm: Integer;
c1, c2: IResultPoint;
l1, l2: Integer;
transA, transB: TResultPointsAndTransitions;
begin
corr := (distance(bottomLeft, bottomRight) / dimension);
norm := distance(topLeft, topRight);
if (norm = 0) then
begin
Result := nil;
exit;
end;
cos := ((topRight.X - topLeft.X) / norm);
sin := ((topRight.Y - topLeft.Y) / norm);
c1 := TResultPointHelpers.CreateResultPoint((topRight.X + (corr * cos)),
(topRight.Y + (corr * sin)));
corr := (distance(bottomLeft, topLeft) / dimension);
norm := distance(bottomRight, topRight);
if (norm = 0) then
begin
Result := nil;
exit;
end;
cos := ((topRight.X - bottomRight.X) / norm);
sin := ((topRight.Y - bottomRight.Y) / norm);
c2 := TResultPointHelpers.CreateResultPoint((topRight.X + (corr * cos)),
(topRight.Y + (corr * sin)));
if (not isValid(c1)) then
begin
if (isValid(c2)) then
begin
Result := c2;
exit;
end;
Result := nil;
exit;
end;
if (not isValid(c2)) then
begin
Result := c1;
exit;
end;
transA := transitionsBetween(topLeft, c1);
transB := transitionsBetween(bottomRight, c1);
l1 := (Abs(transA.Transitions - transB.Transitions));
transA.Free;
transB.Free;
transA := transitionsBetween(topLeft, c2);
transB := transitionsBetween(bottomRight, c2);
l2 := (Abs(transA.Transitions - transB.Transitions));
transA.Free;
transB.Free;
if (l1 <= l2) then
begin
Result := c1;
end
else
begin
Result := c2;
end;
end;
function TDataMatrixDetector.isValid(p: IResultPoint): Boolean;
begin
Result := ((((p.X >= 0) and (p.X < Fimage.Width)) and (p.Y > 0)) and
(p.Y < Fimage.Height))
end;
// L2 distance
function TDataMatrixDetector.distance(a: IResultPoint; b: IResultPoint)
: Integer;
begin
Result := TMathUtils.round(TResultPointHelpers.distance(a, b))
end;
/// <summary>
/// Increments the Integer associated with a key by one.
/// </summary>
procedure TDataMatrixDetector.increment
(table: TDictionary<IResultPoint, Integer>; key: IResultPoint);
var
Value: Integer;
begin
if (table.ContainsKey(key)) then
begin
Value := table[key];
table[key] := (Value + 1);
end
else
table.Add(key, 1); // table[key] := 1;
end;
function TDataMatrixDetector.sampleGrid(image: TBitMatrix;
topLeft, bottomLeft, bottomRight, topRight: IResultPoint;
dimensionX, dimensionY: Integer): TBitMatrix;
begin
// TGridSampler.instance
Result := TDefaultGridSampler.sampleGrid(image, dimensionX, dimensionY, 0.5,
0.5, (dimensionX - 0.5), 0.5, (dimensionX - 0.5), (dimensionY - 0.5), 0.5,
(dimensionY - 0.5), topLeft.X, topLeft.Y, topRight.X, topRight.Y,
bottomRight.X, bottomRight.Y, bottomLeft.X, bottomLeft.Y);
end;
/// <summary>
/// Counts the number of black/white transitions between two points, using something like Bresenham's algorithm.
/// </summary>
function TDataMatrixDetector.transitionsBetween(Afrom, Ato: IResultPoint)
: TResultPointsAndTransitions;
var
temp, fromX, fromY, toX, toY: Integer;
steep: Boolean;
dx, dy: Int64;
xstep, ystep, Transitions: Integer;
error: Int64;
inBlack, isBlack: Boolean;
X, Y: Integer;
begin
// See QR Code Detector, sizeOfBlackWhiteBlackRun()
fromX := Trunc(Afrom.X);
fromY := Trunc(Afrom.Y);
toX := Trunc(Ato.X);
toY := Trunc(Ato.Y);
steep := (Abs((toY - fromY)) > Abs((toX - fromX)));
if (steep) then
begin
temp := fromX;
fromX := fromY;
fromY := temp;
temp := toX;
toX := toY;
toY := temp;
end;
dx := Abs(toX - fromX);
dy := Abs(toY - fromY);
error := TMathUtils.Asr(-dx, 1);
if (fromY < toY) then
ystep := 1
else
ystep := -1;
if (fromX < toX) then
xstep := 1
else
xstep := -1;
Transitions := 0;
if steep then
inBlack := Fimage[fromY, fromX]
else
inBlack := Fimage[fromX, fromY];
X := fromX;
Y := fromY;
while ((X <> toX)) do
begin
if steep then
isBlack := Fimage[Y, X]
else
isBlack := Fimage[X, Y];
if (isBlack <> inBlack) then
begin
Inc(Transitions);
inBlack := isBlack;
end;
Inc(error, dy);
if (error > 0) then
begin
if (Y = toY) then
break;
Inc(Y, ystep);
Dec(error, dx);
end;
Inc(X, xstep)
end;
Result := TResultPointsAndTransitions.Create(Afrom, Ato, Transitions);
end;
{ TResultPointsAndTransitions }
constructor TDataMatrixDetector.TResultPointsAndTransitions.Create
(From: IResultPoint; To_: IResultPoint; Transitions: Integer);
begin
Self.From := From;
Self.To_ := To_;
Self.Transitions := Transitions;
end;
destructor TDataMatrixDetector.TResultPointsAndTransitions.Destroy;
begin
// if (Assigned(Self.From)) then
// Self.From := nil;
//
// if (Assigned(Self.To_)) then
// Self.To_:=nil;
inherited;
end;
function TDataMatrixDetector.TResultPointsAndTransitions.ToString: string;
begin
Result := From.ToString + '/' + To_.ToString + '/' + IntToStr(Transitions);
end;
function TDataMatrixDetector.TResultPointsAndTransitionsComparator.Compare
(const o1, o2: TResultPointsAndTransitions): Integer;
begin
Result := (o1.Transitions - o2.Transitions);
end;
end.
@@ -0,0 +1,69 @@
{
* 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.QrCode.Internal.AlignmentPattern;
interface
uses ZXing.ResultPoint;
type
/// <summary>
/// As we did for ResultPoint, we use an interfaced object to implement automatic deallocation
/// of TAligmnentPattern instances
/// the actual implementation of this interface is in unit ZXing.QrCode.Internal.AlignmentPatternImplementation
/// </summary>
IAlignmentPattern = interface(IResultPoint)
['{8C0A5D01-9620-42B6-BE3E-9C40717B5B38}']
/// <summary> <p>Determines if this alignment pattern "about equals" an alignment pattern at the stated
/// position and size -- meaning, it is at nearly the same center with nearly the same size.</p>
/// </summary>
function aboutEquals(const moduleSize, i, j: Single): Boolean;
/// <summary>
/// Combines this object's current estimate of a finder pattern position and module size
/// with a new estimate. It returns a new {@code FinderPattern} containing an average of the two.
/// </summary>
/// <param name="i">The i.</param>
/// <param name="j">The j.</param>
/// <param name="newModuleSize">New size of the module.</param>
/// <returns></returns>
function combineEstimate(const i, j, newModuleSize: Single): IAlignmentPattern;
end;
/// <summary>
/// contains all static methods for using IAlignmentPatterns instances
/// </summary>
TAlignmentPatternHelpers = class
/// <summary>
/// IAlignmentPattern instances must be obtained by calling this function
/// </summary>
class function CreateAlignmentPattern(const posX, posY, estimatedModuleSize: Single):IAlignmentPattern;
end;
implementation
uses ZXing.QrCode.Internal.AlignmentPatternImplementation;
{ TAlignmentPatternHelpers }
class function TAlignmentPatternHelpers.CreateAlignmentPattern(const posX, posY, estimatedModuleSize: Single):IAlignmentPattern;
begin
result := ZXing.QrCode.Internal.AlignmentPatternImplementation.NewAlignmentPattern(posX,posY,estimatedModuleSize);
end;
end.
@@ -0,0 +1,407 @@
{
* 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.QrCode.Internal.AlignmentPatternFinder;
interface
uses
System.SysUtils,
System.Math,
System.Generics.Collections,
ZXing.Common.BitMatrix,
ZXing.QrCode.Internal.AlignmentPattern, // nullableType,
ZXing.ResultPoint,
ZXing.Common.Detector.MathUtils;
type
/// <summary> <p>This class attempts to find alignment patterns in a QR Code. Alignment patterns look like finder
/// patterns but are smaller and appear at regular intervals throughout the image.</p>
///
/// <p>At the moment this only looks for the bottom-right alignment pattern.</p>
///
/// <p>This is mostly a simplified copy of {@link FinderPatternFinder}. It is copied,
/// pasted and stripped down here for maximum performance but does unfortunately duplicate
/// some code.</p>
///
/// <p>This class is thread-safe but not reentrant. Each thread must allocate its own object.</p>
///
/// </summary>
TAlignmentPatternFinder = class sealed
private
image: TBitMatrix;
possibleCenters: TList<IAlignmentPattern>;
startX, startY: Integer;
width, height: Integer;
moduleSize: Single;
crossCheckStateCount: TArray<Integer>;
resultPointCallback: TResultPointCallback;
/// <summary> Given a count of black/white/black pixels just seen and an end position,
/// figures the location of the center of this black/white/black run.
/// </summary>
class function centerFromEnd(const stateCount: TArray<Integer>;
const pEnd: Integer): Single; static;
/// <param name="stateCount">count of black/white/black pixels just read
/// </param>
/// <returns> true iff the proportions of the counts is close enough to the 1/1/1 ratios
/// used by alignment patterns to be considered a match
/// </returns>
function foundPatternCross(const stateCount: TArray<Integer>): Boolean;
/// <summary>
/// <p>After a horizontal scan finds a potential alignment pattern, this method
/// "cross-checks" by scanning down vertically through the center of the possible
/// alignment pattern to see if the same proportion is detected.</p>
/// </summary>
/// <param name="startI">row where an alignment pattern was detected</param>
/// <param name="centerJ">center of the section that appears to cross an alignment pattern</param>
/// <param name="maxCount">maximum reasonable number of modules that should be
/// observed in any reading state, based on the results of the horizontal scan</param>
/// <param name="originalStateCountTotal">The original state count total.</param>
/// <returns>
/// vertical center of alignment pattern, or null if not found
/// </returns>
function crossCheckVertical(const startI, centerJ, maxCount,
originalStateCountTotal: Integer): Single;
/// <summary> <p>This is called when a horizontal scan finds a possible alignment pattern. It will
/// cross check with a vertical scan, and if successful, will see if this pattern had been
/// found on a previous horizontal scan. If so, we consider it confirmed and conclude we have
/// found the alignment pattern.</p>
///
/// </summary>
/// <param name="stateCount">reading state module counts from horizontal scan
/// </param>
/// <param name="i">row where alignment pattern may be found
/// </param>
/// <param name="j">end of possible alignment pattern in row
/// </param>
/// <returns> {@link TAlignmentPattern} if we have found the same pattern twice, or null if not
/// </returns>
function handlePossibleCenter(const stateCount: TArray<Integer>;
const i, j: Integer): IAlignmentPattern;
public
/// <summary> <p>Creates a finder that will look in a portion of the whole image.</p>
///
/// </summary>
/// <param name="image">image to search
/// </param>
/// <param name="startX">left column from which to start searching
/// </param>
/// <param name="startY">top row from which to start searching
/// </param>
/// <param name="width">width of region to search
/// </param>
/// <param name="height">height of region to search
/// </param>
/// <param name="moduleSize">estimated module size so far
/// </param>
constructor Create(const image: TBitMatrix; const startX, startY,
width, height: Integer; const moduleSize: Single;
resultPointCallback: TResultPointCallback);
destructor Destroy; override;
/// <summary> <p>This method attempts to find the bottom-right alignment pattern in the image. It is a bit messy since
/// it's pretty performance-critical and so is written to be fast foremost.</p>
///
/// </summary>
/// <returns> {@link TAlignmentPattern} if found
/// </returns>
function find: IAlignmentPattern;
end;
implementation
{ TAlignmentPatternFinder }
constructor TAlignmentPatternFinder.Create(const image: TBitMatrix;
const startX, startY, width, height: Integer; const moduleSize: Single;
resultPointCallback: TResultPointCallback);
begin
Self.image := image;
Self.possibleCenters := TList<IAlignmentPattern>.Create;
Self.possibleCenters.Capacity := 5;
Self.startX := startX;
Self.startY := startY;
Self.width := width;
Self.height := height;
Self.moduleSize := moduleSize;
Self.crossCheckStateCount := TArray<Integer>.Create(0, 0, 0);
Self.resultPointCallback := resultPointCallback;
end;
destructor TAlignmentPatternFinder.Destroy;
begin
if possibleCenters<>nil then
possibleCenters.Clear;
FreeAndNil(self.possibleCenters);
self.crossCheckStateCount := nil;
self.resultPointCallback :=nil;
inherited;
end;
function TAlignmentPatternFinder.find: IAlignmentPattern;
var
confirmed: IAlignmentPattern;
maxJ, middleI, iGen, i, j, currentState: Integer;
stateCount: TArray<Integer>;
begin
startX := Self.startX;
height := Self.height;
maxJ := startX + self.width;
middleI := Self.startY + (TMathUtils.Asr(height, 1));
// We are looking for black/white/black modules in 1:1:1 ratio;
// this tracks the number of black/white/black modules seen so far
stateCount := TArray<Integer>.Create(0, 0, 0);
for iGen := 0 to Pred(height) do
begin
// Search from middle outwards
if ((iGen and 1) = 0)
then
i := middleI + (TMathUtils.Asr(iGen + 1, 1))
else
i := middleI + (-1 * TMathUtils.Asr(iGen + 1, 1));
stateCount[0] := 0;
stateCount[1] := 0;
stateCount[2] := 0;
j := startX;
// Burn off leading white pixels before anything else; if we start in the middle of
// a white run, it doesn't make sense to count its length, since we don't know if the
// white run continued to the left of the start point
while ((j < maxJ) and (not Self.image[j, i])) do
Inc(j);
currentState := 0;
while ((j < maxJ)) do
begin
if (Self.image[j, i]) then
begin
// Black pixel
if (currentState = 1) then
begin
// Counting black pixels
Inc(stateCount[currentState]);
end else
begin
// Counting white pixels
if (currentState = 2) then
begin
// A winner?
if (Self.foundPatternCross(stateCount)) then
begin
// Yes
confirmed := self.handlePossibleCenter(stateCount, i, j);
if (confirmed <> nil) then
begin
result := confirmed;
exit
end;
end;
stateCount[0] := stateCount[2];
stateCount[1] := 1;
stateCount[2] := 0;
currentState := 1;
end else
begin
Inc(currentState);
Inc(stateCount[currentState]);
end;
end;
end else
begin
// White pixel
if (currentState = 1)
then
// Counting black pixels
Inc(currentState);
Inc(stateCount[currentState])
end;
Inc(j)
end;
if (Self.foundPatternCross(stateCount)) then
begin
confirmed := self.handlePossibleCenter(stateCount, i, maxJ);
if (confirmed <> nil) then
begin
result := confirmed;
exit;
end;
end;
end;
// Hmm, nothing we saw was observed and confirmed twice. If we had
// any guess at all, return it.
if (Self.possibleCenters.Count <> 0)
then
Result := Self.possibleCenters[0]
else
Result := nil;
end;
class function TAlignmentPatternFinder.centerFromEnd(
const stateCount: TArray<Integer>; const pEnd: Integer): Single;
begin
Result := (pEnd - stateCount[2]) - (stateCount[1] / 2.0);
if (Single.IsNaN(Result))
then
Result := -1;
end;
function TAlignmentPatternFinder.foundPatternCross(
const stateCount: TArray<Integer>): Boolean;
var
maxVariance: Single;
i: Integer;
begin
maxVariance := moduleSize / 2;
for i := 0 to Pred(3) do
begin
if (Abs(self.moduleSize - stateCount[i]) >= maxVariance) then
begin
Result := false;
exit;
end;
end;
Result := true;
end;
function TAlignmentPatternFinder.crossCheckVertical(const startI, centerJ,
maxCount, originalStateCountTotal: Integer): Single;
var
maxI,
i, stateCountTotal: Integer;
stateCount: TArray<Integer>;
begin
maxI := Self.image.height;
stateCount := Self.crossCheckStateCount;
stateCount[0] := 0;
stateCount[1] := 0;
stateCount[2] := 0;
// Start counting up from center
i := startI;
while (((i >= 0) and self.image[centerJ, i]) and
(stateCount[1] <= maxCount)) do
begin
Inc(stateCount[1]);
Dec(i);
end;
// If already too many modules in this state or ran off the edge:
if ((i < 0) or (stateCount[1] > maxCount)) then
begin
Result := -1;
exit;
end;
while (((i >= 0) and (not Self.image[centerJ, i])) and
(stateCount[0] <= maxCount)) do
begin
Inc(stateCount[0]);
Dec(i);
end;
if (stateCount[0] > maxCount) then
begin
Result := -1;
exit;
end;
// Now also count down from center
i := (startI + 1);
while (((i < maxI) and Self.image[centerJ, i]) and
(stateCount[1] <= maxCount)) do
begin
Inc(stateCount[1]);
Inc(i);
end;
if ((i = maxI) or (stateCount[1] > maxCount)) then
begin
Result := -1;
exit;
end;
while (((i < maxI) and not self.image[centerJ, i]) and
(stateCount[2] <= maxCount)) do
begin
Inc(stateCount[2]);
Inc(i);
end;
if (stateCount[2] > maxCount) then
begin
Result := -1;
exit;
end;
stateCountTotal := (stateCount[0] + stateCount[1] + stateCount[2]);
if ((5 * Abs(stateCountTotal - originalStateCountTotal)) >=
(2 * originalStateCountTotal)) then
begin
Result := -1;
exit;
end;
if Self.foundPatternCross(stateCount)
then
Result := TAlignmentPatternFinder.centerFromEnd(stateCount, i)
else
Result := -1;
end;
function TAlignmentPatternFinder.handlePossibleCenter(
const stateCount: TArray<Integer>; const i, j: Integer): IAlignmentPattern;
var
center, point: IAlignmentPattern;
stateCountTotal: Integer;
estimatedModuleSize: Single;
centerJ, centerI: Single;
begin
stateCountTotal := (stateCount[0] + stateCount[1] + stateCount[2]);
centerJ := TAlignmentPatternFinder.centerFromEnd(stateCount, j);
if (centerJ = -1) then
begin
Result := nil;
exit;
end;
centerI := crossCheckVertical(i, Floor(centerJ), (2 * stateCount[1]),
stateCountTotal);
if (centerI <> -1) then
begin
estimatedModuleSize := (stateCount[0] + stateCount[1] + stateCount[2]) / 3.0;
for center in Self.possibleCenters do
begin
// Look for about the same center and module size:
if (center.aboutEquals(estimatedModuleSize, centerI, centerJ)) then
begin
Result := center.combineEstimate(centerI, centerJ, estimatedModuleSize);
exit;
end;
end;
// Hadn't found this before; save it
point := TAlignmentPatternHelpers.CreateAlignmentPattern(centerJ, centerI, estimatedModuleSize);
Self.possibleCenters.Add(point);
if Assigned(resultPointCallback)
then
Self.resultPointCallback(point);
end;
Result := nil;
end;
end.
@@ -0,0 +1,112 @@
{
* 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.QrCode.Internal.AlignmentPatternImplementation;
interface
uses
ZXing.QrCode.Internal.AlignmentPattern,
ZXing.ResultPoint,
ZXing.ResultPointImplementation;
// this is the function that actually creates IAlignmentPattern instances.
// the actual implementation of the interface is totally hidden to all other units,
// since even its declaration is in the implementation section of this unit
function NewAlignmentPattern(const posX, posY, estimatedModuleSize: Single):IAlignmentPattern;
implementation
{ TAlignmentPattern }
type
/// <summary> <p>Encapsulates an alignment pattern, which are the smaller square patterns found in
/// all but the simplest QR Codes.</p>
///
/// </summary>
TAlignmentPattern = class sealed(TResultPoint,IResultPoint,IAlignmentPattern)
private
estimatedModuleSize: Single;
constructor Create(const posX, posY, estimatedModuleSize: Single);
/// <summary> <p>Determines if this alignment pattern "about equals" an alignment pattern at the stated
/// position and size -- meaning, it is at nearly the same center with nearly the same size.</p>
/// </summary>
function aboutEquals(const moduleSize, i, j: Single): Boolean;
/// <summary>
/// Combines this object's current estimate of a finder pattern position and module size
/// with a new estimate. It returns a new {@code FinderPattern} containing an average of the two.
/// </summary>
/// <param name="i">The i.</param>
/// <param name="j">The j.</param>
/// <param name="newModuleSize">New size of the module.</param>
/// <returns></returns>
function combineEstimate(const i, j,
newModuleSize: Single): IAlignmentPattern;
end;
constructor TAlignmentPattern.Create(const posX, posY,
estimatedModuleSize: Single);
begin
inherited Create(posX, posY);
Self.estimatedModuleSize := estimatedModuleSize;
end;
function TAlignmentPattern.aboutEquals(const moduleSize, i, j: Single): Boolean;
var
moduleSizeDiff: Single;
begin
if ((Abs(i - Self.y) <= moduleSize) and
(Abs(j - Self.x) <= moduleSize)) then
begin
moduleSizeDiff := Abs(moduleSize - self.estimatedModuleSize);
Result := ((moduleSizeDiff <= 1) or
(moduleSizeDiff <= self.estimatedModuleSize));
end else Result := false;
end;
function TAlignmentPattern.combineEstimate(const i, j,
newModuleSize: Single): IAlignmentPattern;
var
combinedX,
combinedY,
combinedModuleSize : Single;
begin
combinedX := (self.x + j) / 2.0;
combinedY := (self.y + i) / 2.0;
combinedModuleSize := (estimatedModuleSize + newModuleSize) / 2.0;
Result := TAlignmentPattern.Create(combinedX, combinedY, combinedModuleSize);
end;
function NewAlignmentPattern(const posX, posY, estimatedModuleSize: Single):IAlignmentPattern;
begin
result := TAlignmentPattern.Create(posX,posY,estimatedModuleSize);
end;
end.
@@ -0,0 +1,492 @@
{
* 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
}
unit ZXing.QrCode.Internal.Detector;
interface
uses
System.SysUtils,
System.Math,
Generics.Collections,
ZXing.Common.BitMatrix,
ZXing.ResultPoint,
ZXing.Common.DetectorResult,
ZXing.DecodeHintType,
ZXing.Common.PerspectiveTransform,
ZXing.QrCode.Internal.FinderPatternInfo,
ZXing.QrCode.Internal.FinderPatternFinder,
ZXing.QrCode.Internal.FinderPattern,
ZXing.QrCode.Internal.AlignmentPattern,
ZXing.QrCode.Internal.AlignmentPatternFinder,
ZXing.QrCode.Internal.Version,
ZXing.DefaultGridSampler,
ZXing.Common.Detector.MathUtils;
type
/// <summary>
/// <p>Encapsulates logic that can detect a QR Code in an image, even if the QR Code
/// is rotated or skewed, or partially obscured.</p>
/// </summary>
TDetector = class
private
FImage: TBitMatrix;
FResultPointCallback: TResultPointCallback;
function calculateModuleSizeOneWay(pattern: IResultpoint;
otherPattern: IResultpoint): Single;
class function computeDimension(topLeft: IResultpoint;
topRight: IResultpoint; bottomLeft: IResultpoint; moduleSize: Single;
var dimension: Integer): boolean; static;
class function createTransform(const topLeft, topRight, bottomLeft,
AlignmentPattern: IResultpoint; const dimension: Integer)
: TPerspectiveTransform; static;
class function sampleGrid(image: TBitMatrix;
transform: TPerspectiveTransform; dimension: Integer): TBitMatrix; static;
function sizeOfBlackWhiteBlackRun(fromX: Integer; fromY: Integer;
toX: Integer; toY: Integer): Single;
function sizeOfBlackWhiteBlackRunBothWays(fromX: Integer; fromY: Integer;
toX: Integer; toY: Integer): Single;
protected
function calculateModuleSize(const topLeft, topRight,
bottomLeft: IResultPoint): Single; virtual;
function findAlignmentInRegion(const overallEstModuleSize: Single;
const estAlignmentX, estAlignmentY: Integer;
const allowanceFactor: Single): IAlignmentPattern;
/// <summary>
/// Processes the finder pattern info.
/// </summary>
/// <param name="info">The info.</param>
/// <returns></returns>
function processFinderPatternInfo(const info: TFinderPatternInfo)
: TDetectorResult; virtual;
public
/// <summary>
/// Initializes a new instance of the <see cref="Detector"/> class.
/// </summary>
/// <param name="image">The image.</param>
constructor Create(const image: TBitMatrix);
destructor Destroy; override;
/// <summary>
/// <p>Detects a QR Code in an image.</p>
/// </summary>
/// <returns>
/// <see cref="TDetectorResult"/> encapsulating results of detecting a QR Code
/// </returns>
function detect(): TDetectorResult; overload;
/// <summary>
/// <p>Detects a QR Code in an image.</p>
/// </summary>
/// <param name="hints">optional hints to detector</param>
/// <returns>
/// <see cref="TDetectorResult"/> encapsulating results of detecting a QR Code
/// </returns>
function detect(const hints: TDictionary<TDecodeHintType, TObject>)
: TDetectorResult; overload;
property image: TBitMatrix read FImage;
property ResultPointCallback: TResultPointCallback
read FResultPointCallback;
end;
implementation
{ TDetector }
constructor TDetector.Create(const image: TBitMatrix);
begin
FImage := image;
end;
destructor TDetector.Destroy;
begin
FResultPointCallback := nil;
inherited;
end;
function TDetector.calculateModuleSize(const topLeft, topRight,
bottomLeft: IResultPoint): Single;
begin
Result := ((self.calculateModuleSizeOneWay(topLeft, topRight) +
self.calculateModuleSizeOneWay(topLeft, bottomLeft)) / 2)
end;
function TDetector.calculateModuleSizeOneWay(pattern: IResultPoint;
otherPattern: IResultPoint): Single;
var
moduleSizeEst1, moduleSizeEst2: Single;
begin
moduleSizeEst1 := self.sizeOfBlackWhiteBlackRunBothWays(Floor(pattern.X),
Floor(pattern.Y), Floor(otherPattern.X), Floor(otherPattern.Y));
moduleSizeEst2 := self.sizeOfBlackWhiteBlackRunBothWays(Floor(otherPattern.X),
Floor(otherPattern.Y), Floor(pattern.X), Floor(pattern.Y));
if (moduleSizeEst1 = -1) then
begin
Result := (moduleSizeEst2 / 7);
exit
end;
if (moduleSizeEst2 = -1) then
begin
Result := (moduleSizeEst1 / 7);
exit
end;
Result := ((moduleSizeEst1 + moduleSizeEst2) / 14);
end;
class function TDetector.computeDimension(topLeft: IResultPoint;
topRight: IResultPoint; bottomLeft: IResultPoint; moduleSize: Single;
var dimension: Integer): boolean;
var
tltrCentersDimension, tlblCentersDimension: Integer;
begin
tltrCentersDimension :=
round((TResultPointHelpers.distance(topLeft, topRight) / moduleSize));
tlblCentersDimension :=
round((TResultPointHelpers.distance(topLeft, bottomLeft) / moduleSize));
dimension := TMathUtils.Asr
((tltrCentersDimension + tlblCentersDimension), 1) + 7;
case (dimension and 3) of
0: inc(dimension); // below a valid dimension
1: ; // exactly on a valid dimension e.g. 21, 25, 29, ..., 177
2: dec(dimension); // above a valid dimension
3: Exit(False); // exactly between two valid dimensions
end;
Result := True;
end;
class function TDetector.createTransform(const topLeft, topRight, bottomLeft,
AlignmentPattern: IResultPoint; const dimension: Integer)
: TPerspectiveTransform;
var
bottomRightX, bottomRightY, sourceBottomRightX, sourceBottomRightY,
dimMinusThree: Single;
begin
dimMinusThree := (dimension - 3.5);
if (AlignmentPattern <> nil) then
begin
bottomRightX := AlignmentPattern.X;
bottomRightY := AlignmentPattern.Y;
sourceBottomRightX := (dimMinusThree - 3);
sourceBottomRightY := sourceBottomRightX;
end
else
begin
bottomRightX := ((topRight.X - topLeft.X) + bottomLeft.X);
bottomRightY := ((topRight.Y - topLeft.Y) + bottomLeft.Y);
sourceBottomRightX := dimMinusThree;
sourceBottomRightY := sourceBottomRightX;
end;
Result := TPerspectiveTransform.quadrilateralToQuadrilateral(3.5, 3.5,
dimMinusThree, 3.5, sourceBottomRightX, sourceBottomRightY, 3.5,
dimMinusThree, topLeft.X, topLeft.Y, topRight.X, topRight.Y, bottomRightX,
bottomRightY, bottomLeft.X, bottomLeft.Y);
end;
function TDetector.detect: TDetectorResult;
begin
Result := self.detect(nil)
end;
function TDetector.detect(const hints: TDictionary<TDecodeHintType, TObject>)
: TDetectorResult;
var
obj: TObject;
info: TFinderPatternInfo;
finder: TFinderPatternFinder;
begin
Result := nil;
if ((hints = nil) or
(not hints.ContainsKey(TDecodeHintType.NEED_RESULT_POINT_CALLBACK))) then
FResultPointCallback := nil
else
begin
obj := hints[TDecodeHintType.NEED_RESULT_POINT_CALLBACK];
if (obj is TResultPointEventObject) then
FResultPointCallback := TResultPointEventObject(obj).Event;
end;
finder := TFinderPatternFinder.Create(FImage, ResultPointCallback);
try
info := finder.find(hints);
if Assigned(info) then
begin
Result := processFinderPatternInfo(info);
info.Free;
end;
finally
finder.Free;
end;
end;
function TDetector.processFinderPatternInfo(const info: TFinderPatternInfo)
: TDetectorResult;
var
topLeft, topRight, bottomLeft: IFinderPattern;
moduleSize, bottomRightX, bottomRightY, correctionToTopLeft: Single;
dimension, i, modulesBetweenFPCenters, estAlignmentX, estAlignmentY: Integer;
points: TArray<IResultPoint>;
provisionalVersion: TVersion;
transform: TPerspectiveTransform;
bits: TBitMatrix;
AlignmentPattern: IAlignmentPattern;
begin
Result := nil;
topLeft := info.topLeft;
topRight := info.topRight;
bottomLeft := info.bottomLeft;
moduleSize := calculateModuleSize(topLeft, topRight, bottomLeft);
if (moduleSize < 1.0) then
exit;
if (not TDetector.computeDimension(topLeft, topRight, bottomLeft, moduleSize,
dimension)) then
exit;
provisionalVersion := TVersion.getProvisionalVersionForDimension(dimension);
if (provisionalVersion = nil) then
exit;
modulesBetweenFPCenters := (provisionalVersion.DimensionForVersion - 7);
AlignmentPattern := nil;
// Anything above version 1 has an alignment pattern
if (Length(provisionalVersion.AlignmentPatternCenters) > 0) then
begin
// Guess where a "bottom right" finder pattern would have been
bottomRightX := (topRight.X - topLeft.X) + bottomLeft.X;
bottomRightY := (topRight.Y - topLeft.Y) + bottomLeft.Y;
// Estimate that alignment pattern is closer by 3 modules
// from "bottom right" to known top left location
correctionToTopLeft := (1.0 - (3.0 / modulesBetweenFPCenters));
estAlignmentX :=
Floor(topLeft.X + (correctionToTopLeft * (bottomRightX - topLeft.X)));
estAlignmentY :=
Floor(topLeft.Y + (correctionToTopLeft * (bottomRightY - topLeft.Y)));
i := 4;
while ((i <= 16)) do
begin
AlignmentPattern := findAlignmentInRegion(moduleSize, estAlignmentX,
estAlignmentY, i);
if (AlignmentPattern <> nil) then
break;
i := (i shl 1);
end;
// If we didn't find alignment pattern... well try anyway without it
end;
transform := TDetector.createTransform(topLeft, topRight, bottomLeft,
AlignmentPattern, dimension);
try
bits := TDetector.sampleGrid(FImage, transform, dimension);
finally
transform.Free;
end;
if (bits = nil) then
exit;
if (AlignmentPattern = nil) then
points := TArray<IResultPoint>.Create(bottomLeft, topLeft, topRight)
else
points := TArray<IResultPoint>.Create(bottomLeft, topLeft, topRight,
AlignmentPattern);
Result := TDetectorResult.Create(bits, points);
end;
function TDetector.findAlignmentInRegion(const overallEstModuleSize: Single;
const estAlignmentX, estAlignmentY: Integer; const allowanceFactor: Single)
: IAlignmentPattern;
var
allowance, alignmentAreaRightX, alignmentAreaLeftX, alignmentAreaTopY,
alignmentAreaBottomY: Integer;
alignmentFinder: TAlignmentPatternFinder;
candidateResult: IAlignmentPattern;
begin
Result := nil;
allowance := Floor(allowanceFactor * overallEstModuleSize);
alignmentAreaLeftX := System.Math.Max(0, (estAlignmentX - allowance));
alignmentAreaRightX := System.Math.Min((FImage.Width - 1),
(estAlignmentX + allowance));
if ((alignmentAreaRightX - alignmentAreaLeftX) < (overallEstModuleSize * 3))
then
exit;
alignmentAreaTopY := System.Math.Max(0, (estAlignmentY - allowance));
alignmentAreaBottomY := System.Math.Min((FImage.Height - 1),
(estAlignmentY + allowance));
alignmentFinder := TAlignmentPatternFinder.Create(FImage, alignmentAreaLeftX,
alignmentAreaTopY, (alignmentAreaRightX - alignmentAreaLeftX),
(alignmentAreaBottomY - alignmentAreaTopY), overallEstModuleSize,
self.ResultPointCallback);
candidateResult := alignmentFinder.find;
if candidateResult = nil then
Result := nil
else
Result := candidateResult;
FreeAndNil(alignmentFinder);
end;
class function TDetector.sampleGrid(image: TBitMatrix;
transform: TPerspectiveTransform; dimension: Integer): TBitMatrix;
begin
Result := TDefaultGridSampler.sampleGrid(image, dimension, dimension,
transform)
end;
function TDetector.sizeOfBlackWhiteBlackRun(fromX: Integer; fromY: Integer;
toX: Integer; toY: Integer): Single;
var
steep: boolean;
temp, dx, dy, xstep, ystep, X, Y, state, xlimit, realx, realy, error: Integer;
begin
steep := Abs(toY - fromY) > Abs(toX - fromX);
if (steep) then
begin
temp := fromX;
fromX := fromY;
fromY := temp;
temp := toX;
toX := toY;
toY := temp
end;
dx := Abs(toX - fromX);
dy := Abs(toY - fromY);
error := TMathUtils.Asr(-dx, 1);
if (fromX < toX) then
xstep := 1
else
xstep := -1;
if (fromY < toY) then
ystep := 1
else
ystep := -1;
state := 0;
xlimit := (toX + xstep);
X := fromX;
Y := fromY;
while ((X <> xlimit)) do
begin
if steep then
realx := Y
else
realx := X;
if steep then
realy := X
else
realy := Y;
if ((state = 1) = FImage[realx, realy]) then
begin
if (state = 2) then
begin
Result := TMathUtils.distance(X, Y, fromX, fromY);
exit
end;
inc(state)
end;
inc(error, dy);
if (error > 0) then
begin
if (Y = toY) then
break;;
inc(Y, ystep);
dec(error, dx)
end;
inc(X, xstep)
end;
if (state = 2) then
begin
Result := TMathUtils.distance((toX + xstep), toY, fromX, fromY);
exit
end;
Result := Single.NaN;
end;
function TDetector.sizeOfBlackWhiteBlackRunBothWays(fromX: Integer;
fromY: Integer; toX: Integer; toY: Integer): Single;
var
scale: Double;
otherToX, otherToY: Integer;
begin
Result := sizeOfBlackWhiteBlackRun(fromX, fromY, toX, toY);
scale := 1;
otherToX := (fromX - (toX - fromX));
if (otherToX < 0) then
begin
scale := (fromX / (fromX - otherToX));
otherToX := 0
end
else if (otherToX >= FImage.Width) then
begin
scale := (((FImage.Width - 1) - fromX) / (otherToX - fromX));
otherToX := (FImage.Width - 1)
end;
otherToY := Round(fromY - ((toY - fromY) * scale));
scale := 1;
if (otherToY < 0) then
begin
scale := fromY / (fromY - otherToY);
otherToY := 0
end
else if (otherToY >= FImage.Height) then
begin
scale := (((FImage.Height - 1) - fromY) / (otherToY - fromY));
otherToY := (FImage.Height - 1)
end;
otherToX := Round(fromX + (otherToX - fromX) * scale);
Result := Result + self.sizeOfBlackWhiteBlackRun(fromX, fromY, otherToX,
otherToY);
Result := (Result - 1);
end;
end.
@@ -0,0 +1,147 @@
{
* 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
}
unit ZXing.QrCode.Internal.FinderPattern;
interface
uses
ZXing.ResultPoint;
type
/// <summary>
/// As we did for ResultPoint, we use an interfaced object to implement automatic deallocation
/// of TAligmnentPattern instances
/// the actual implementation of this interface is in unit ZXing.QrCode.Internal.FinderPatternImplementation
/// </summary>
IFinderPattern = interface(IResultPoint)
['{EF95BB2F-8863-4A83-840E-699779592EC0}']
function GetCount:integer;
procedure SetCount(value:integer);
/// <summary> <p>Determines if this finder pattern "about equals" a finder pattern at the stated
/// position and size -- meaning, it is at nearly the same center with nearly the same size.</p>
/// </summary>
function aboutEquals(const moduleSize, i, j: Single): Boolean;
/// <summary>
/// Combines this object's current estimate of a finder pattern position and module size
/// with a new estimate. It returns a new {@code FinderPattern} containing a weighted average
/// based on count.
/// </summary>
/// <param name="i">The i.</param>
/// <param name="j">The j.</param>
/// <param name="newModuleSize">New size of the module.</param>
/// <returns></returns>
function combineEstimate(const i, j, newModuleSize: Single): IFinderPattern;
/// <summary>
/// Gets the size of the estimated module.
/// </summary>
/// <value>
/// The size of the estimated module.
/// </value>
function estimatedModuleSize : Single;
property count : Integer read GetCount write SetCount;
end;
/// <summary>
/// contains all static methods for using IFinderPattern instances
/// </summary>
TFinderPatternHelpers= class(TResultPointHelpers)
class function CreateFinderPattern(const posX, posY, estimatedModuleSize: Single;
const count: Integer):IFinderPattern; overload;
class function CreateFinderPattern(const posX, posY, estimatedModuleSize: Single):IFinderPattern; overload;
class procedure orderBestPatterns(const patterns: TArray<IFinderPattern>); static;
end;
implementation
uses ZXing.QrCode.Internal.FinderPatternImplementation;
class function TFinderPatternHelpers.CreateFinderPattern(const posX, posY, estimatedModuleSize: Single; const count: Integer):IFinderPattern;
begin
result := ZXing.QrCode.Internal.FinderPatternImplementation.NewFinderPattern(posX, posY, estimatedModuleSize ,count);
end;
class function TFinderPatternHelpers.CreateFinderPattern(const posX, posY, estimatedModuleSize: Single):IFinderPattern;
begin
result := ZXing.QrCode.Internal.FinderPatternImplementation.NewFinderPattern(posX, posY, estimatedModuleSize);
end;
class procedure TFinderPatternHelpers.orderBestPatterns( const patterns: TArray<IFinderPattern>);
var
zeroOneDistance,
oneTwoDistance,
zeroTwoDistance: Single;
pointA,
pointB,
pointC,
temp: IFinderPattern;
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 (TResultPointHelpers.crossProductZ(pointA, pointB, pointC) < 0) then
begin
temp := pointA;
pointA := pointC;
pointC := temp;
end;
patterns[0] := pointA;
patterns[1] := pointB;
patterns[2] := pointC;
end;
end.
@@ -0,0 +1,977 @@
{
* 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
}
unit ZXing.QrCode.Internal.FinderPatternFinder;
interface
uses
System.SysUtils,
System.Math,
System.Generics.Defaults,
System.Generics.Collections,
ZXing.Common.BitMatrix,
ZXing.ResultPoint,
ZXing.DecodeHinttype,
ZXing.QrCode.Internal.FinderPatternInfo,
ZXing.QrCode.Internal.FinderPattern;
type
/// <summary>
/// <p>This class attempts to find finder patterns in a QR Code. Finder patterns are the square
/// markers at three corners of a QR Code.</p>
///
/// <p>This class is thread-safe but not reentrant. Each thread must allocate its own object.
/// </summary>
TFinderPatternFinder = class
private
const
CENTER_QUORUM: Integer = 2;
INTEGER_MATH_SHIFT: Integer = 8;
var
FImage: TBitMatrix;
FPossibleCenters: TList<IFinderPattern>;
FhasSkipped: Boolean;
FCrossCheckStateCount: TArray<Integer>;
FresultPointCallback: TResultPointCallback;
class function centerFromEnd(stateCount: TArray<Integer>; pEnd: Integer): Single; static;
function crossCheckDiagonal(startI: Integer; centerJ: Integer; maxCount: Integer; originalStateCountTotal: Integer): boolean;
function crossCheckHorizontal(startJ: Integer; centerI: Integer; maxCount: Integer; originalStateCountTotal: Integer): Single;
function crossCheckVertical(startI: Integer; centerJ: Integer; maxCount: Integer; originalStateCountTotal: Integer): Single;
function findRowSkip: Integer;
function haveMultiplyConfirmedCenters: boolean;
function selectBestPatterns: TArray<IFinderPattern>;
function CrossCheckStateCount: TArray<Integer>;
protected
const
/// <summary>
/// 1 pixel/module times 3 modules/center
/// </summary>
MIN_SKIP: Integer = 3;
/// <summary>
/// support up to version 10 for mobile clients
/// </summary>
MAX_MODULES: Integer = 97;
class function foundPatternCross(const stateCount: TArray<Integer>): Boolean; static;
function handlePossibleCenter(stateCount: TArray<Integer>; i: Integer;
j: Integer): boolean;
property image: TBitMatrix read FImage;
public
/// <summary>
/// <p>Creates a finder that will search the image for three finder patterns.</p>
/// </summary>
/// <param name="image">image to search</param>
constructor Create(const image: TBitMatrix); overload;
/// <summary>
/// Initializes a new instance of the <see cref="FinderPatternFinder"/> class.
/// </summary>
/// <param name="image">The image.</param>
/// <param name="resultPointCallback">The result point callback.</param>
constructor Create(const image: TBitMatrix;
resultPointCallback: TResultPointCallback); overload;
destructor Destroy; override;
function find(const hints: TDictionary<TDecodeHintType, TObject>): TFinderPatternInfo; virtual;
end;
TFurthestFromAverageComparator = class sealed(TInterfacedObject,
IComparer<IFinderPattern>)
private
average: Single;
public
constructor Create(f: Single);
function Compare(const Left, Right: IFinderPattern): Integer;
end;
TCenterComparator = class sealed(TInterfacedObject, IComparer<IFinderPattern>)
private
average: Single;
public
constructor Create(f: Single);
function Compare(const Left, Right: IFinderPattern): Integer;
end;
implementation
{ TFinderPatternFinder }
constructor TFinderPatternFinder.Create(const image: TBitMatrix);
begin
Self.Create(image, TResultPointCallback(nil));
end;
constructor TFinderPatternFinder.Create(const image: TBitMatrix;
resultPointCallback: TResultPointCallback);
begin
FImage := image;
FPossibleCenters := TList<IFinderPattern>.Create;
FCrossCheckStateCount := TArray<Integer>.Create(0, 0, 0, 0, 0);
FresultPointCallback := resultPointCallback;
end;
destructor TFinderPatternFinder.Destroy;
begin
FImage := nil;
{for i := Pred(PossibleCenters.Count) downto 0 do
begin
PossibleCenters[i].Free;
PossibleCenters.Delete(i);
end;}
FPossibleCenters.Free;
FCrossCheckStateCount := nil;
inherited;
end;
class function TFinderPatternFinder.centerFromEnd(stateCount: TArray<Integer>;
pEnd: Integer): Single;
var
aResult: Single;
begin
aResult := (pEnd - stateCount[4] - stateCount[3]) - (stateCount[2] / 2);
if (Single.IsNaN(aResult)) then
begin
result := -1;
exit
end;
result := aResult;
end;
function TFinderPatternFinder.crossCheckDiagonal(startI, centerJ, maxCount,
originalStateCountTotal: Integer): boolean;
var
stateCount: TArray<Integer>;
i, maxI, maxJ, stateCountTotal: Integer;
begin
stateCount := CrossCheckStateCount;
try
i := 0;
while ((((startI >= i) and (centerJ >= i)) and self.image[(centerJ - i),
(startI - i)])) do
begin
inc(stateCount[2]);
inc(i)
end;
if ((startI < i) or (centerJ < i)) then
begin
result := false;
exit
end;
while (((((startI >= i) and (centerJ >= i)) and
not self.image[(centerJ - i), (startI - i)]) and
(stateCount[1] <= maxCount))) do
begin
inc(stateCount[1]);
inc(i)
end;
if (((startI < i) or (centerJ < i)) or (stateCount[1] > maxCount)) then
begin
result := false;
exit
end;
while (((((startI >= i) and (centerJ >= i)) and self.image[(centerJ - i),
(startI - i)]) and (stateCount[0] <= maxCount))) do
begin
inc(stateCount[0]);
inc(i)
end;
if (stateCount[0] > maxCount) then
begin
result := false;
exit
end;
maxI := self.image.Height;
maxJ := self.image.Width;
i := 1;
while (((((startI + i) < maxI) and ((centerJ + i) < maxJ)) and
self.image[(centerJ + i), (startI + i)])) do
begin
inc(stateCount[2]);
inc(i)
end;
if (((startI + i) >= maxI) or ((centerJ + i) >= maxJ)) then
begin
result := false;
exit
end;
while ((((((startI + i) < maxI) and ((centerJ + i) < maxJ)) and
not self.image[(centerJ + i), (startI + i)]) and
(stateCount[3] < maxCount))) do
begin
inc(stateCount[3]);
inc(i)
end;
if ((((startI + i) >= maxI) or ((centerJ + i) >= maxJ)) or
(stateCount[3] >= maxCount)) then
begin
result := false;
exit
end;
while ((((((startI + i) < maxI) and ((centerJ + i) < maxJ)) and
self.image[(centerJ + i), (startI + i)]) and
(stateCount[4] < maxCount))) do
begin
inc(stateCount[4]);
inc(i)
end;
if (stateCount[4] >= maxCount) then
begin
result := false;
exit
end;
stateCountTotal :=
((((stateCount[0] + stateCount[1]) + stateCount[2]) + stateCount[3]) +
stateCount[4]);
Result := (Abs(stateCountTotal - originalStateCountTotal) <
(2 * originalStateCountTotal)) and TFinderPatternFinder.foundPatternCross
(stateCount);
finally
stateCount := nil;
end;
end;
function TFinderPatternFinder.crossCheckHorizontal(startJ: Integer;
centerI: Integer; maxCount: Integer;
originalStateCountTotal: Integer): Single;
var
stateCount: TArray<Integer>;
maxJ, j, stateCountTotal: Integer;
begin
maxJ := FImage.Width;
stateCount := CrossCheckStateCount;
try
j := startJ;
while (((j >= 0) and FImage[j, centerI])) do
begin
inc(stateCount[2]);
dec(j)
end;
if (j < 0) then
begin
result := -1;
exit
end;
while ((((j >= 0) and not FImage[j, centerI]) and
(stateCount[1] <= maxCount))) do
begin
inc(stateCount[1]);
dec(j)
end;
if ((j < 0) or (stateCount[1] > maxCount)) then
begin
result := -1;
exit
end;
while ((((j >= 0) and FImage[j, centerI]) and
(stateCount[0] <= maxCount))) do
begin
inc(stateCount[0]);
dec(j)
end;
if (stateCount[0] > maxCount) then
begin
result := -1;
exit
end;
j := (startJ + 1);
while (((j < maxJ) and FImage[j, centerI])) do
begin
inc(stateCount[2]);
inc(j)
end;
if (j = maxJ) then
begin
result := -1;
exit
end;
while ((((j < maxJ) and not FImage[j, centerI]) and
(stateCount[3] < maxCount))) do
begin
inc(stateCount[3]);
inc(j)
end;
if ((j = maxJ) or (stateCount[3] >= maxCount)) then
begin
result := -1;
exit
end;
while (((j < maxJ) and FImage[j, centerI]) and
(stateCount[4] < maxCount)) do
begin
inc(stateCount[4]);
inc(j)
end;
if (stateCount[4] >= maxCount) then
begin
result := -1;
exit
end;
stateCountTotal :=
((((stateCount[0] + stateCount[1]) + stateCount[2]) + stateCount[3]) +
stateCount[4]);
if (5 * Abs(stateCountTotal - originalStateCountTotal) >=
originalStateCountTotal) then
begin
result := -1;
exit
end;
if TFinderPatternFinder.foundPatternCross(stateCount) then
begin
result := TFinderPatternFinder.centerFromEnd(stateCount, j);
exit;
end;
finally
stateCount := nil;
end;
result := -1;
end;
function TFinderPatternFinder.CrossCheckStateCount: TArray<Integer>;
begin
FCrossCheckStateCount[0] := 0;
FCrossCheckStateCount[1] := 0;
FCrossCheckStateCount[2] := 0;
FCrossCheckStateCount[3] := 0;
FCrossCheckStateCount[4] := 0;
result := FCrossCheckStateCount;
end;
function TFinderPatternFinder.crossCheckVertical(startI: Integer;
centerJ: Integer; maxCount: Integer;
originalStateCountTotal: Integer): Single;
var
stateCount: TArray<Integer>;
maxI, i, stateCountTotal: Integer;
begin
maxI := FImage.Height;
stateCount := CrossCheckStateCount;
i := startI;
try
while (((i >= 0) and FImage[centerJ, i])) do
begin
inc(stateCount[2]);
dec(i)
end;
if (i < 0) then
begin
result := -1;
exit
end;
while ((((i >= 0) and not FImage[centerJ, i]) and
(stateCount[1] <= maxCount))) do
begin
inc(stateCount[1]);
dec(i)
end;
if ((i < 0) or (stateCount[1] > maxCount)) then
begin
result := -1;
exit
end;
while ((((i >= 0) and FImage[centerJ, i]) and
(stateCount[0] <= maxCount))) do
begin
inc(stateCount[0]);
dec(i)
end;
if (stateCount[0] > maxCount) then
begin
result := -1;
exit
end;
i := (startI + 1);
while (((i < maxI) and FImage[centerJ, i])) do
begin
inc(stateCount[2]);
inc(i)
end;
if (i = maxI) then
begin
result := -1;
exit
end;
while ((((i < maxI) and not FImage[centerJ, i]) and
(stateCount[3] < maxCount))) do
begin
inc(stateCount[3]);
inc(i)
end;
if ((i = maxI) or (stateCount[3] >= maxCount)) then
begin
result := -1;
exit
end;
while ((((i < maxI) and FImage[centerJ, i]) and
(stateCount[4] < maxCount))) do
begin
inc(stateCount[4]);
inc(i)
end;
if (stateCount[4] >= maxCount) then
begin
result := -1;
exit
end;
stateCountTotal :=
((((stateCount[0] + stateCount[1]) + stateCount[2]) + stateCount[3]) +
stateCount[4]);
if ((5 * Abs(stateCountTotal - originalStateCountTotal)) >=
(2 * originalStateCountTotal)) then
begin
result := -1;
exit
end;
if TFinderPatternFinder.foundPatternCross(stateCount) then
begin
result := TFinderPatternFinder.centerFromEnd(stateCount, i);
exit;
end;
finally
stateCount := nil;
end;
result := -1;
end;
function TFinderPatternFinder.find(
const hints: TDictionary<TDecodeHintType, TObject>): TFinderPatternInfo;
var
tryHarder,
done, confirmed: Boolean;
maxI, maxJ, iSkip,
i, currentState, j, rowSkip: Integer;
stateCount: TArray<Integer>;
patternInfo: TArray<IFinderPattern>;
resultInfo: TArray<IResultPoint>;
begin
Result := nil;
tryHarder := (hints <> nil) and (hints.ContainsKey(ZXing.DecodeHinttype.TRY_HARDER));
maxI := Self.image.Height;
maxJ := Self.image.Width;
// We are looking for black/white/black/white/black modules in
// 1:1:3:1:1 ratio; this tracks the number of such modules seen so far
// Let's assume that the maximum version QR Code we support takes up 1/4 the height of the
// image, and then account for the center being 3 modules in size. This gives the smallest
// number of pixels the center could be, so skip this often. When trying harder, look for all
// QR versions regardless of how dense they are.
iSkip := (3 * maxI) div (4 * MAX_MODULES);
if (iSkip < MIN_SKIP) or (tryHarder)
then
iSkip := MIN_SKIP;
done := false;
stateCount := TArray<Integer>.Create(0, 0, 0, 0, 0);
try
i := (iSkip - 1);
while ((i < maxI) and (not done)) do
begin
// Get a row of black/white values
stateCount[0] := 0;
stateCount[1] := 0;
stateCount[2] := 0;
stateCount[3] := 0;
stateCount[4] := 0;
currentState := 0;
j := 0;
while (j < maxJ) do
begin
if (FImage[j, i]) then
begin
// Black pixel
if ((currentState and 1) = 1)
then
Inc(currentState);
Inc(stateCount[currentState]);
end else
begin
// White pixel
if ((currentState and 1) = 0) then
begin
// Counting black pixels
if (currentState = 4) then
begin
// A winner?
if TFinderPatternFinder.foundPatternCross(stateCount) then
begin
// Yes
confirmed := handlePossibleCenter(stateCount, i, j);
if (confirmed) then
begin
// Start examining every other line. Checking each line turned out to be too
// expensive and didn't improve performance.
iSkip := 2;
if (FhasSkipped)
then
done := haveMultiplyConfirmedCenters()
else
begin
rowSkip := findRowSkip();
if (rowSkip > stateCount[2]) then
begin
// Skip rows between row of lower confirmed center
// and top of presumed third confirmed center
// but back up a bit to get a full chance of detecting
// it, entire width of center of finder pattern
// Skip by rowSkip, but back off by stateCount[2] (size of last center
// of pattern we saw) to be conservative, and also back off by iSkip which
// is about to be re-added
Inc(i, ((rowSkip - stateCount[2]) - iSkip));
j := (maxJ - 1);
end;
end;
end else
begin
stateCount[0] := stateCount[2];
stateCount[1] := stateCount[3];
stateCount[2] := stateCount[4];
stateCount[3] := 1;
stateCount[4] := 0;
currentState := 3;
continue;
end;
// Clear state to start looking again
currentState := 0;
stateCount[0] := 0;
stateCount[1] := 0;
stateCount[2] := 0;
stateCount[3] := 0;
stateCount[4] := 0
end else
begin
// No, shift counts back by two
stateCount[0] := stateCount[2];
stateCount[1] := stateCount[3];
stateCount[2] := stateCount[4];
stateCount[3] := 1;
stateCount[4] := 0;
currentState := 3;
end;
end else
begin
Inc(currentState);
Inc(stateCount[currentState]);
end;
end else
// Counting white pixels
Inc(stateCount[currentState]);
end;
Inc(j);
end;
if foundPatternCross(stateCount) then
begin
confirmed := Self.handlePossibleCenter(stateCount, i, maxJ);
if (confirmed) then
begin
iSkip := stateCount[0];
if (FhasSkipped)
then
// Found a third one
done := self.haveMultiplyConfirmedCenters
end;
end;
Inc(i, iSkip);
end;
patternInfo := selectBestPatterns();
if (patternInfo = nil)
then
exit;
TFinderPatternHelpers.orderBestPatterns(patternInfo);
Result := TFinderPatternInfo.Create(patternInfo);
finally
resultInfo := nil;
stateCount := nil;
patternInfo := nil;
end;
end;
function TFinderPatternFinder.findRowSkip: Integer;
var
center: IFinderPattern;
firstConfirmedCenter: IResultPoint;
begin
Result := 0;
if (FPossibleCenters.Count > 1) then
begin
firstConfirmedCenter := nil;
for center in FPossibleCenters do
begin
if (center.Count >= 2) then
begin
if (firstConfirmedCenter <> nil) then
begin
FhasSkipped := true;
Result := Floor(Abs(firstConfirmedCenter.X - center.X) -
Abs(firstConfirmedCenter.Y - center.Y)) div 2;
exit;
end;
firstConfirmedCenter := center;
end
end
end;
end;
/// <param name="stateCount">count of black/white/black/white/black pixels just read
/// </param>
/// <returns> true iff the proportions of the counts is close enough to the 1/1/3/1/1 ratios
/// used by finder patterns to be considered a match
/// </returns>
class function TFinderPatternFinder.foundPatternCross(
const stateCount: TArray<Integer>): Boolean;
var
i, totalModuleSize,
count, moduleSize,
maxVariance: Integer;
begin
Result := false;
totalModuleSize := 0;
for i := 0 to Pred(5) do
begin
count := stateCount[i];
if (count = 0)
then
exit;
Inc(totalModuleSize, count);
end;
if (totalModuleSize < 7)
then
exit;
moduleSize := ((totalModuleSize shl 8) div 7);
maxVariance := (moduleSize div 2);
// Allow less than 50% variance from 1-1-3-1-1 proportions
Result := (Abs(moduleSize - (stateCount[0] shl INTEGER_MATH_SHIFT)) < maxVariance) and
(Abs(moduleSize - (stateCount[1] shl INTEGER_MATH_SHIFT)) < maxVariance) and
(Abs(3 * moduleSize - (stateCount[2] shl INTEGER_MATH_SHIFT)) < (3 * maxVariance)) and
(Abs(moduleSize - (stateCount[3] shl INTEGER_MATH_SHIFT)) < maxVariance) and
(Abs(moduleSize - (stateCount[4] shl INTEGER_MATH_SHIFT)) < maxVariance);
end;
function TFinderPatternFinder.handlePossibleCenter(stateCount: TArray<Integer>;
i, j: Integer): boolean;
var
stateCountTotal, index: Integer;
centerJ, centerI: Single;
center, point: IFinderPattern;
found: boolean;
estimatedModuleSize: Single;
begin
Result := false;
center := nil;
stateCountTotal := ((((stateCount[0] + stateCount[1]) + stateCount[2]) +
stateCount[3]) + stateCount[4]);
centerJ := TFinderPatternFinder.centerFromEnd(stateCount, j);
if (centerJ = -1)
then
exit;
centerI := self.crossCheckVertical(i, Floor(centerJ), stateCount[2],
stateCountTotal);
if (centerI = -1)
then
exit;
centerJ := crossCheckHorizontal(Floor(centerJ), Floor(centerI), stateCount[2],
stateCountTotal);
if ((centerJ <> -1) and (self.crossCheckDiagonal(Floor(centerI), Floor(centerJ), stateCount[2],
stateCountTotal))) then
begin
estimatedModuleSize := stateCountTotal / 7;
found := false;
index := 0;
while ((index < FPossibleCenters.Count)) do
begin
center := FPossibleCenters[index];
if (center.aboutEquals(estimatedModuleSize, centerI, centerJ)) then
begin
FPossibleCenters[index] := nil;
FPossibleCenters.Delete(index);
FPossibleCenters.Insert(index, center.combineEstimate(centerI, centerJ,
estimatedModuleSize));
found := true;
break;
end;
inc(index)
end;
if (not found) then
begin
point := TFinderPatternHelpers.CreateFinderPattern(centerJ, centerI, estimatedModuleSize);
FPossibleCenters.Add(point);
if Assigned(FresultPointCallback)
then
FresultPointCallBack(point);
end;
Result := true;
end;
end;
function TFinderPatternFinder.haveMultiplyConfirmedCenters: boolean;
var
confirmedCount, max, i: Integer;
totalModuleSize, average, totalDeviation: Single;
pattern: IFinderPattern;
begin
confirmedCount := 0;
totalModuleSize := 0;
max := FPossibleCenters.Count;
for pattern in FPossibleCenters do
begin
if (pattern.Count >= CENTER_QUORUM) then
begin
inc(confirmedCount);
totalModuleSize := totalModuleSize + pattern.estimatedModuleSize;
end;
end;
if (confirmedCount < 3) then
begin
result := false;
exit
end;
average := totalModuleSize / max;
totalDeviation := 0;
i := 0;
while ((i < max)) do
begin
pattern := FPossibleCenters[i];
totalDeviation := totalDeviation +
Abs(pattern.estimatedModuleSize - average);
inc(i)
end;
result := (totalDeviation <= (0.05 * totalModuleSize));
end;
function TFinderPatternFinder.selectBestPatterns: TArray<IFinderPattern>;
var
average, square, totalModuleSize: Double;
size, stdDev, limit, avrsng: Single;
center, possibleCenter, pattern: IFinderPattern;
startSize, i: Integer;
comparator: IComparer<IFinderPattern>;
begin
startSize := FPossibleCenters.Count;
if (startSize < 3) then
begin
result := nil;
exit
end;
if (startSize > 3) then
begin
totalModuleSize := 0;
square := 0;
for center in FPossibleCenters do
begin
size := center.estimatedModuleSize;
totalModuleSize := totalModuleSize + size;
square := square + (size * size);
end;
average := totalModuleSize / startSize;
stdDev := Sqrt((square / startSize) - (average * average));
// this intermediate assignment is a workaround for old-gen compilers
// that are not deallocating TFurthestFromAverageComparator instance
// (bug verified on XE8: just declare a destructor Destroy override
// in TFurthestFromAverageComparator put a breakpoint in it and see
// that the destructor never gets called if you don't use this intermediate
// assignment)
avrsng := average;
comparator := TFurthestFromAverageComparator.Create(avrsng);
FPossibleCenters.Sort(comparator);
limit := System.Math.Max((0.2 * avrsng), stdDev);
i := 0;
while (((i < FPossibleCenters.Count) and
(FPossibleCenters.Count > 3))) do
begin
pattern := FPossibleCenters[i];
if (Abs(pattern.estimatedModuleSize - average) > limit) then
begin
FPossibleCenters.Delete(i);
dec(i)
end;
inc(i)
end
end;
if (FPossibleCenters.Count > 3) then
begin
totalModuleSize := 0;
for possibleCenter in FPossibleCenters do
begin
totalModuleSize := totalModuleSize + possibleCenter.estimatedModuleSize;
end;
average := totalModuleSize / FPossibleCenters.Count;
// this intermediate assignment is a workaround for old-gen compilers
// that are not deallocating TCenterComparator instance
// (bug verified on XE8: just declare a destructor Destroy override in
// TCenterComparator,put a breakpoint in it and see that the destructor
// never gets called if you don't use this intermediate assignment)
comparator := TCenterComparator.Create(average);
FPossibleCenters.Sort( comparator );
// if (PossibleCenters.Count > 4) then
// begin
// self.PossibleCenters.DeleteRange(4, self.PossibleCenters.Count - 1);
// end;
end;
result := TArray<IFinderPattern>.Create(FPossibleCenters[0],
FPossibleCenters[1], FPossibleCenters[2]);
end;
{ TFurthestFromAverageComparator }
function TFurthestFromAverageComparator.Compare(const Left,
Right: IFinderPattern): Integer;
var
dA, dB: Single;
begin
dA := Abs(Right.estimatedModuleSize - self.average);
dB := Abs(Left.estimatedModuleSize - self.average);
if (dA < dB) then
begin
result := -1;
end
else if (dA = dB) then
begin
result := 0;
end
else
result := 1;
end;
constructor TFurthestFromAverageComparator.Create(f: Single);
begin
average := f;
end;
{ TCenterComparator }
function TCenterComparator.Compare(const Left, Right: IFinderPattern): Integer;
var
dA, dB: Single;
begin
if (Right.Count = Left.Count) then
begin
dA := Abs(Right.estimatedModuleSize - self.average);
dB := Abs(Left.estimatedModuleSize - self.average);
if (dA < dB) then
begin
result := 1;
end
else if (dA = dB) then
begin
result := 0;
end
else
result := -1;
exit;
end;
result := (Right.Count - Left.Count);
end;
constructor TCenterComparator.Create(f: Single);
begin
average := f;
end;
end.
@@ -0,0 +1,152 @@
{
* 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
}
unit ZXing.QrCode.Internal.FinderPatternImplementation;
interface
uses
ZXing.QrCode.Internal.FinderPattern;
function NewFinderPattern(const posX, posY, estimatedModuleSize: Single; const count: Integer):IFinderPattern; overload;
function NewFinderPattern(const posX, posY, estimatedModuleSize: Single):IFinderPattern; overload;
implementation
uses ZXing.ResultPoint,ZXing.ResultPointImplementation;
{ TFinderPattern }
type
/// <summary>
/// <p>Encapsulates a finder pattern, which are the three square patterns found in
/// the corners of QR Codes. It also encapsulates a count of similar finder patterns,
/// as a convenience to the finder's bookkeeping.</p>
/// </summary>
TFinderPattern = class(TResultPoint,IResultPoint,IFinderPattern)
private
Fcount: Integer;
FestimatedModuleSize: Single;
function GetCount:integer;
procedure SetCount(value:integer);
constructor Create(const posX, posY, estimatedModuleSize: Single;
const count: Integer); overload;
constructor Create(const posX, posY, estimatedModuleSize: Single); overload;
/// <summary> <p>Determines if this finder pattern "about equals" a finder pattern at the stated
/// position and size -- meaning, it is at nearly the same center with nearly the same size.</p>
/// </summary>
function aboutEquals(const moduleSize, i, j: Single): Boolean;
/// <summary>
/// Combines this object's current estimate of a finder pattern position and module size
/// with a new estimate. It returns a new {@code FinderPattern} containing a weighted average
/// based on count.
/// </summary>
/// <param name="i">The i.</param>
/// <param name="j">The j.</param>
/// <param name="newModuleSize">New size of the module.</param>
/// <returns></returns>
function combineEstimate(const i, j, newModuleSize: Single): IFinderPattern;
/// <summary>
/// Gets the size of the estimated module.
/// </summary>
/// <value>
/// The size of the estimated module.
/// </value>
function estimatedModuleSize : Single;
property count : Integer read GetCount write SetCount;
end;
constructor TFinderPattern.Create(const posX, posY,
estimatedModuleSize: Single; const count: Integer);
begin
inherited Create(posX, posY);
FestimatedModuleSize := estimatedModuleSize;
Fcount := count;
end;
constructor TFinderPattern.Create(const posX, posY,
estimatedModuleSize: Single);
begin
Self.Create(posX, posY, estimatedModuleSize, 1);
end;
function TFinderPattern.estimatedModuleSize: Single;
begin
result := FestimatedModuleSize;
end;
function TFinderPattern.GetCount: integer;
begin
result := FCount;
end;
function TFinderPattern.aboutEquals(const moduleSize, i, j: Single): Boolean;
var
moduleSizeDiff : Single;
begin
Result := false;
if ((Abs(i - y) <= moduleSize) and (Abs(j - x) <= moduleSize)) then
begin
moduleSizeDiff := Abs(moduleSize - self.estimatedModuleSize);
Result := ((moduleSizeDiff <= 1) or
(moduleSizeDiff <= self.estimatedModuleSize));
end;
end;
procedure TFinderPattern.SetCount(value: integer);
begin
FCount := value;
end;
function TFinderPattern.combineEstimate(const i, j,
newModuleSize: Single): IFinderPattern;
var
combinedCount: Integer;
combinedX, combinedY: Single;
begin
combinedCount := (Self.count + 1);
combinedX := ((Self.count * x) + j) / combinedCount;
combinedY := ((Self.count * y) + i) / combinedCount;
Result := TFinderPattern.Create(combinedX, combinedY,
(((Self.count * Self.estimatedModuleSize) + newModuleSize) / combinedCount),
combinedCount)
end;
function NewFinderPattern(const posX, posY, estimatedModuleSize: Single; const count: Integer):IFinderPattern;
begin
result := TFinderPattern.Create( posX, posY, estimatedModuleSize,count);
end;
function NewFinderPattern(const posX, posY, estimatedModuleSize: Single):IFinderPattern;
begin
result := TFinderPattern.Create( posX, posY, estimatedModuleSize);
end;
end.
@@ -0,0 +1,69 @@
{
* 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
}
unit ZXing.QrCode.Internal.FinderPatternInfo;
interface
uses
ZXing.QrCode.Internal.FinderPattern;
type
/// <summary>
/// <p>Encapsulates information about finder patterns in an image, including the location of
/// the three finder patterns, and their estimated module size.</p>
/// </summary>
TFinderPatternInfo = class sealed
private
FbottomLeft: IFinderPattern;
FtopLeft: IFinderPattern;
FtopRight: IFinderPattern;
public
/// <summary>
/// Initializes a new instance of the <see cref="FinderPatternInfo"/> class.
/// </summary>
/// <param name="patternCenters">The pattern centers.</param>
constructor Create(const patternCenters: TArray<IFinderPattern>);
/// <summary>
/// Gets the bottom left.
/// </summary>
property bottomLeft : IFinderPattern read FbottomLeft;
/// <summary>
/// Gets the top left.
/// </summary>
property topLeft : IFinderPattern read FtopLeft;
/// <summary>
/// Gets the top right.
/// </summary>
property topRight : IFinderPattern read FtopRight;
end;
implementation
constructor TFinderPatternInfo.Create(const patternCenters: TArray<IFinderPattern>);
begin
FbottomLeft := patternCenters[0];
FtopLeft := patternCenters[1];
FtopRight := patternCenters[2]
end;
end.
@@ -0,0 +1,258 @@
{
* 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: bbrown@google.com (Brian Brown)
* Delphi Implementation by K. Gossens
}
unit ZXing.Datamatrix.DataMatrixReader;
interface
uses
System.SysUtils,
System.Generics.Collections,
ZXing.Common.Detector.MathUtils,
Math,
ZXing.Common.BitArray,
ZXing.BarcodeFormat,
ZXing.ReadResult,
ZXing.Reader,
ZXing.DecodeHintType,
ZXing.DecoderResult,
ZXing.Common.DetectorResult,
ZXing.ResultMetadataType,
ZXing.ResultPoint,
ZXing.Common.BitMatrix,
ZXing.BinaryBitmap,
ZXing.Datamatrix.Internal.Decoder,
ZXing.Datamatrix.Internal.Detector;
type
/// <summary>
/// This implementation can detect and decode Data Matrix codes in an image.
/// </summary>
TDataMatrixReader = class(TInterfacedObject, IReader)
private
FDecoder: TDataMatrixDecoder;
NO_POINTS: TArray<IResultPoint>;
/// <summary>
/// This method detects a code in a "pure" image -- that is, pure monochrome image
/// which contains only an unrotated, unskewed, image of a code, with some white border
/// around it. This is a specialized method that works exceptionally fast in this special
/// case.
///
/// <seealso cref="ZXing.QrCode.QRCodeReader.extractPureBits(TBitMatrix)" />
/// </summary>
class function extractPureBits(const image: TBitMatrix): TBitMatrix; static;
class function moduleSize(const leftTopBlack: TArray<Integer>;
const image: TBitMatrix; var moduleSize: Integer): Boolean; static;
public
constructor Create;
destructor Destroy; override;
/// <summary>
/// This implementation can detect and decode Data Matrix codes in an image.
/// </summary>
function decode(const image: TBinaryBitmap): TReadResult; overload;
function decode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult; overload;
procedure reset;
end;
implementation
uses ZXing.ByteSegments;
{ TDataMatrixReader }
constructor TDataMatrixReader.Create;
begin
inherited;
FDecoder := TDataMatrixDecoder.Create;
NO_POINTS := TArray<IResultPoint>.Create();
end;
destructor TDataMatrixReader.Destroy;
begin
NO_POINTS := nil;
FDecoder.Free;
inherited;
end;
function TDataMatrixReader.decode(const image: TBinaryBitmap): TReadResult;
begin
Result := decode(image, nil);
end;
function TDataMatrixReader.decode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
matrixDetector: TDataMatrixDetector;
DecoderResult: TDecoderResult;
points: TArray<IResultPoint>;
bits: TBitMatrix;
DetectorResult: TDetectorResult;
ByteSegments: IByteSegments;
begin
Result := nil;
DetectorResult := nil;
DecoderResult := nil;
try
if ((hints <> nil) and hints.ContainsKey(TDecodeHintType.PURE_BARCODE)) then
begin
bits := TDataMatrixReader.extractPureBits(image.BlackMatrix);
if Assigned(bits) then
begin
DecoderResult := FDecoder.decode(bits);
points := NO_POINTS;
FreeAndNil(bits);
end
else
exit;
end
else
begin
matrixDetector := TDataMatrixDetector.Create(image.BlackMatrix);
try
DetectorResult := matrixDetector.detect();
finally
matrixDetector.Free;
end;
if (DetectorResult = nil) then
exit;
DecoderResult := FDecoder.decode(DetectorResult.bits);
points := DetectorResult.points;
end;
if (DecoderResult = nil) then
exit;
Result := TReadResult.Create(DecoderResult.Text, DecoderResult.RawBytes,
points, TBarcodeFormat.DATA_MATRIX);
ByteSegments := DecoderResult.ByteSegments;
if (ByteSegments <> nil) then
Result.putMetadata(TResultMetadataType.BYTE_SEGMENTS, TResultMetaData.CreateByteSegmentsMetadata( byteSegments));
if (Length(DecoderResult.ECLevel) <> 0) then
Result.putMetadata(TResultMetadataType.ERROR_CORRECTION_LEVEL, TResultMetaData.CreateStringMetadata(DecoderResult.ECLevel));
finally
byteSegments:=nil;
if Assigned(DetectorResult) then
FreeAndNil(DetectorResult);
if Assigned(DecoderResult) then
FreeAndNil(DecoderResult);
end;
end;
class function TDataMatrixReader.extractPureBits(const image: TBitMatrix)
: TBitMatrix;
var
moduleSize: Integer;
leftTopBlack, rightBottomBlack: TArray<Integer>;
top, bottom, left, right: Integer;
matrixWidth, matrixHeight: Integer;
nudge: Integer;
bits: TBitMatrix;
x, y, iOffset: Integer;
begin
Result := nil;
leftTopBlack := image.getTopLeftOnBit;
rightBottomBlack := image.getBottomRightOnBit;
if ((leftTopBlack = nil) or (rightBottomBlack = nil)) then
exit;
if (not TDataMatrixReader.moduleSize(leftTopBlack, image, moduleSize)) then
exit;
top := leftTopBlack[1];
bottom := rightBottomBlack[1];
left := leftTopBlack[0];
right := rightBottomBlack[0];
matrixWidth := ((right - left + 1) div moduleSize);
matrixHeight := ((bottom - top + 1) div moduleSize);
if ((matrixWidth <= 0) or (matrixHeight <= 0)) then
exit;
// Push in the "border" by half the module width so that we start
// sampling in the middle of the module. Just in case the image is a
// little off, this will help recover.
nudge := TMathUtils.Asr(moduleSize,1);
Inc(top, nudge);
Inc(left, nudge);
// Now just read off the bits
bits := TBitMatrix.Create(matrixWidth, matrixHeight);
for y := 0 to Pred(matrixHeight) do
begin
iOffset := (top + (y * moduleSize));
for x := 0 to Pred(matrixWidth) do
begin
if (image[(left + (x * moduleSize)), iOffset]) then
bits[x, y] := true;
end;
end;
Result := bits;
end;
class function TDataMatrixReader.moduleSize(const leftTopBlack: TArray<Integer>;
const image: TBitMatrix; var moduleSize: Integer): Boolean;
var
width, x, y: Integer;
begin
Result := false;
width := image.width;
x := leftTopBlack[0];
y := leftTopBlack[1];
while ((x < width) and image[x, y]) do
Inc(x);
if (x = width) then
begin
moduleSize := 0;
exit;
end;
moduleSize := (x - leftTopBlack[0]);
if (moduleSize = 0) then
exit;
Result := true;
end;
procedure TDataMatrixReader.reset;
begin
// do nothing
end;
end.
@@ -0,0 +1,340 @@
{
* 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
}
unit ZXing.QrCode.QRCodeReader;
interface
uses
System.SysUtils,
System.Math,
System.Generics.Collections,
ZXing.Common.BitArray,
ZXing.ReadResult,
ZXing.Reader,
ZXing.DecodeHintType,
ZXing.BarcodeFormat,
ZXing.ResultPoint,
ZXing.BinaryBitmap,
ZXing.QrCode.Internal.Decoder,
ZXing.Common.BitMatrix,
ZXing.DecoderResult,
ZXing.ResultMetadataType,
ZXing.Common.DetectorResult,
ZXing.QrCode.Internal.QRCodeDecoderMetaData,
ZXing.QrCode.Internal.Detector,
ZXing.QrCode.Internal.DecodedBitStreamParser;
type
/// <summary>
/// This implementation can detect and decode QR Codes in an image.
/// </summary>
TQRCodeReader = class(TInterfacedObject, IReader)
private
FDecoder: TQRDecoder;
NO_POINTS: TArray<IResultPoint>;
/// <summary>
/// This method detects a code in a "pure" image -- that is, pure monochrome image
/// which contains only an unrotated, unskewed, image of a code, with some white border
/// around it. This is a specialized method that works exceptionally fast in this special
/// case.
///
/// <seealso cref="ZXing.Datamatrix.DataMatrixReader.extractPureBits(TBitMatrix)" />
/// </summary>
class function extractPureBits(const image: TBitMatrix): TBitMatrix; static;
class function moduleSize(const leftTopBlack: TArray<Integer>;
const image: TBitMatrix; var msize: Single): Boolean; static;
protected
/// <summary>
/// Gets the decoder.
/// </summary>
/// <returns></returns>
property Decoder: TQRDecoder read FDecoder;
public
constructor Create;
destructor Destroy; override;
/// <summary>
/// Locates and decodes a QR code in an image.
///
/// <returns>a String representing the content encoded by the QR code</returns>
/// </summary>
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="TDictionary{TKey, TValue}"/> from <see cref="TDecodeHintType"/>
/// 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
uses ZXing.ByteSegments;
{ TQRCodeReader }
constructor TQRCodeReader.Create;
begin
inherited;
FDecoder := TQRDecoder.Create;
NO_POINTS := TArray<IResultPoint>.Create();
end;
destructor TQRCodeReader.Destroy;
begin
NO_POINTS := nil;
FDecoder.Free;
inherited;
end;
function TQRCodeReader.decode(const image: TBinaryBitmap): TReadResult;
begin
Result := Self.decode(image, nil);
end;
function TQRCodeReader.decode(const image: TBinaryBitmap;
hints: TDictionary<TDecodeHintType, TObject>): TReadResult;
var
DecoderResult: TDecoderResult;
Detector: TDetector;
points: TArray<IResultPoint>;
bits: TBitMatrix;
DetectorResult: TDetectorResult;
data: TQRCodeDecoderMetaData;
byteSegments: IByteSegments;
begin
Result := nil;
DecoderResult := nil;
if ((image = nil) or (image.BlackMatrix = nil)) then
// something is wrong with the image
exit;
try
if ((hints <> nil) and hints.ContainsKey(TDecodeHintType.PURE_BARCODE)) then
begin
bits := TQRCodeReader.extractPureBits(image.BlackMatrix);
if Assigned(bits) then
begin
DecoderResult := Decoder.decode(bits, hints);
points := NO_POINTS;
bits.Free;
end
else
exit;
end
else
begin
Detector := TDetector.Create(image.BlackMatrix);
try
DetectorResult := Detector.detect(hints);
if Assigned(DetectorResult) then
begin
DecoderResult := Decoder.decode(DetectorResult.bits, hints);
points := DetectorResult.points;
DetectorResult.Free;
end
else
exit;
finally
Detector.Free;
end;
end;
if (DecoderResult = nil) then
exit;
// If the code was mirrored: swap the bottom-left and the top-right points.
data := TQRCodeDecoderMetaData(DecoderResult.Other);
if (data <> nil) then
data.applyMirroredCorrection(points);
Result := TReadResult.Create(DecoderResult.Text, DecoderResult.RawBytes,
points, TBarcodeFormat.QR_CODE);
byteSegments := DecoderResult.byteSegments;
if (byteSegments <> nil) then
Result.putMetadata(TResultMetadataType.BYTE_SEGMENTS, TResultMetaData.CreateByteSegmentsMetadata(byteSegments));
if (Length(DecoderResult.ecLevel) <> 0) then
Result.putMetadata(TResultMetadataType.ERROR_CORRECTION_LEVEL, TResultMetaData.CreateStringMetadata(DecoderResult.ecLevel));
if (DecoderResult.StructuredAppend) then
begin
Result.putMetadata(TResultMetadataType.STRUCTURED_APPEND_SEQUENCE,
TResultMetaData.CreateIntegerMetadata(DecoderResult.StructuredAppendSequenceNumber));
Result.putMetadata(TResultMetadataType.STRUCTURED_APPEND_PARITY,
TResultMetaData.CreateIntegerMetadata(DecoderResult.StructuredAppendParity))
end;
finally
if Assigned(DecoderResult) then
FreeAndNil(DecoderResult);
end;
end;
procedure TQRCodeReader.reset;
begin
// do nothing
end;
class function TQRCodeReader.extractPureBits(const image: TBitMatrix)
: TBitMatrix;
var
moduleSize: Single;
leftTopBlack, rightBottomBlack: TArray<Integer>;
top, bottom, left, right, matrixWidth, matrixHeight, nudge, x, y, iOffset,
nudgedTooFarRight, nudgedTooFarDown: Integer;
bits: TBitMatrix;
begin
Result := nil;
leftTopBlack := image.getTopLeftOnBit;
rightBottomBlack := image.getBottomRightOnBit;
if ((leftTopBlack = nil) or (rightBottomBlack = nil)) then
exit;
if (not TQRCodeReader.moduleSize(leftTopBlack, image, moduleSize)) then
exit;
top := leftTopBlack[1];
bottom := rightBottomBlack[1];
left := leftTopBlack[0];
right := rightBottomBlack[0];
// Sanity check!
if ((left >= right) or (top >= bottom)) then
exit;
if ((bottom - top) <> (right - left)) then
// Special case, where bottom-right module wasn't black so we found something else in the last row
// Assume it's a square, so use height as the width
right := (left + (bottom - top));
matrixWidth := Round(((right - left) + 1) / moduleSize);
matrixHeight := Round(((bottom - top) + 1) / moduleSize);
if ((matrixWidth <= 0) or (matrixHeight <= 0)) then
exit;
if (matrixHeight <> matrixWidth) then
// Only possibly decode square regions
exit;
// Push in the "border" by half the module width so that we start
// sampling in the middle of the module. Just in case the image is a
// little off, this will help recover.
nudge := Trunc(moduleSize / 2.0);
Inc(top, nudge);
Inc(left, nudge);
// But careful that this does not sample off the edge
// "right" is the farthest-right valid pixel location -- right+1 is not necessarily
// This is positive by how much the inner x loop below would be too large
nudgedTooFarRight := left + Trunc((matrixWidth - 1) * moduleSize) - right;
if (nudgedTooFarRight > 0) then
begin
if (nudgedTooFarRight > nudge) then
// Neither way fits; abort
exit;
Dec(left, nudgedTooFarRight);
end;
// See logic above
nudgedTooFarDown := top + Trunc((matrixHeight - 1) * moduleSize) - bottom;
if (nudgedTooFarDown > 0) then
begin
if (nudgedTooFarDown > nudge) then
// Neither way fits; abort
exit;
Dec(top, nudgedTooFarDown);
end;
// Now just read off the bits
bits := TBitMatrix.Create(matrixWidth, matrixHeight);
for y := 0 to Pred(matrixHeight) do
begin
iOffset := top + Trunc(y * moduleSize);
for x := 0 to Pred(matrixWidth) do
begin
if (image[left + Trunc((x * moduleSize)), iOffset]) then
bits[x, y] := true;
end;
end;
Result := bits;
end;
class function TQRCodeReader.moduleSize(const leftTopBlack: TArray<Integer>;
const image: TBitMatrix; var msize: Single): Boolean;
var
height, width, x, y: Integer;
inBlack: Boolean;
transitions: Integer;
begin
Result := false;
height := image.height;
width := image.width;
x := leftTopBlack[0];
y := leftTopBlack[1];
inBlack := true;
transitions := 0;
while (((x < width) and (y < height))) do
begin
if (inBlack <> image[x, y]) then
begin
Inc(transitions);
if (transitions = 5) then
break;
inBlack := not inBlack;
end;
Inc(x);
Inc(y);
end;
if ((x = width) or (y = height)) then
begin
msize := 0.0;
exit;
end;
msize := ((x - leftTopBlack[0]) / 7.0);
Result := true;
end;
end.
@@ -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.
@@ -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.
@@ -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.
@@ -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.
@@ -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.
@@ -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.
+71
View File
@@ -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.
@@ -0,0 +1,254 @@
{
* 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: dswitkin@google.com (Daniel Switkin)
* Delphi Implementation by K. Gossens
}
unit ZXing.BaseLuminanceSource;
interface
uses
System.SysUtils,
System.UITypes,
{$IFDEF FRAMEWORK_FMX}
FMX.Graphics,
{$ENDIF}
{$IFDEF FRAMEWORK_VCL}
VCL.Graphics,
{$ENDIF}
ZXing.LuminanceSource,
ZXing.InvertedLuminanceSource;
type
/// <summary>
/// The base class for luminance sources which supports
/// cropping and rotating based upon the luminance values.
/// </summary>
TBaseLuminanceSource = class abstract (TLuminanceSource)
protected
luminances: TArray<Byte>;
const
RChannelWeight : Integer = 19562;
GChannelWeight : Integer = 38550;
BChannelWeight : Integer = 7424;
ChannelWeight : Integer = 16;
function CreateLuminanceSource(const newLuminances: TArray<Byte>;
const width, height: Integer): TLuminanceSource; virtual; abstract;
public
// added the "reintroduce" keyword to shut off the "method hides another method with the same name in the base class"
constructor Create(const width, height: Integer); reintroduce; overload;
constructor Create(const luminanceArray: TArray<Byte>; const width, height: Integer); reintroduce; overload;
function getRow(const y: Integer; row: TArray<Byte>): TArray<Byte>; override;
function rotateCounterClockwise(): TLuminanceSource; override;
function rotateCounterClockwise45(): TLuminanceSource; override;
function crop(const left, top,
width, height: Integer): TLuminanceSource; override;
function Matrix: TArray<Byte>; override;
function RotateSupported: Boolean; override;
function InversionSupported: Boolean; override;
function CropSupported: Boolean; override;
function invert(): TLuminanceSource; override;
end;
implementation
{ TBaseLuminanceSource }
constructor TBaseLuminanceSource.Create(const width, height: Integer);
begin
inherited Create(width, height);
luminances := TArray<Byte>.Create();
SetLength(luminances, (width * height));
end;
/// <summary>
/// Initializes a new instance of the <see cref="BaseLuminanceSource"/> class.
/// </summary>
/// <param name="luminanceArray">The luminance array.</param>
/// <param name="width">The width.</param>
/// <param name="height">The height.</param>
constructor TBaseLuminanceSource.Create(const luminanceArray: TArray<Byte>;
const width, height: Integer);
begin
Self.Create(width, height);
Copy(luminanceArray, 0, Length(luminances));
end;
/// <summary>
/// Fetches one row of luminance data from the underlying platform's bitmap. Values range from
/// 0 (black) to 255 (white). It is preferable for implementations of this method
/// to only fetch this row rather than the whole image, since no 2D Readers may be installed and
/// getMatrix() may never be called.
/// </summary>
/// <param name="y">The row to fetch, 0 &lt;= y &lt; Height.</param>
/// <param name="row">An optional preallocated array. If null or too small, it will be ignored.
/// Always use the returned object, and ignore the .length of the array.</param>
/// <returns>
/// An array containing the luminance data.
/// </returns>
function TBaseLuminanceSource.getRow(const y: Integer;
row: TArray<Byte>): TArray<Byte>;
var
i, width: Integer;
begin
width := Self.Width;
if ((row = nil) or (Length(row) < width)) then
begin
row := nil;
row := TArray<Byte>.Create();
SetLength(row, width);
end;
for i := 0 to Pred(width) do
row[i] := luminances[y * width + i];
Result := row;
end;
function TBaseLuminanceSource.Matrix: TArray<Byte>;
begin
Result := luminances;
end;
/// <summary>
/// Returns a new object with rotated image data by 90 degrees counterclockwise.
/// Only callable if {@link #isRotateSupported()} is true.
/// </summary>
/// <returns>
/// A rotated version of this object.
/// </returns>
function TBaseLuminanceSource.rotateCounterClockwise(): TLuminanceSource;
var
rotatedLuminances : TArray<Byte>;
newWidth,
newHeight : Integer;
localLuminances : TArray<Byte>;
yold, ynew,
xold, xnew : Integer;
begin
rotatedLuminances := TArray<Byte>.Create();
SetLength(rotatedLuminances, (Width * Height));
newWidth := Height;
newHeight := Width;
localLuminances := Matrix;
for yold := 0 to Pred(Height) do
begin
for xold := 0 to Pred(Width) do
begin
ynew := newHeight - xold - 1;
xnew := yold;
rotatedLuminances[ynew * newWidth + xnew] := localLuminances[yold * Width + xold];
end;
end;
Result := CreateLuminanceSource(rotatedLuminances, newWidth, newHeight);
end;
/// <summary>
/// TODO: not implemented yet
/// </summary>
/// <returns>
/// A rotated version of this object.
/// </returns>
function TBaseLuminanceSource.rotateCounterClockwise45(): TLuminanceSource;
begin
// TODO: implement a good 45 degrees rotation without lost of information
Result := inherited rotateCounterClockwise45();
end;
/// <summary>
/// </summary>
/// <returns> Whether this subclass supports counter-clockwise rotation.</returns>
function TBaseLuminanceSource.RotateSupported: Boolean;
begin
Result := true;
end;
/// <summary>
/// Returns a new object with cropped image data. Implementations may keep a reference to the
/// original data rather than a copy. Only callable if CropSupported is true.
/// </summary>
/// <param name="left">The left coordinate, 0 &lt;= left &lt; Width.</param>
/// <param name="top">The top coordinate, 0 &lt;= top &lt;= Height.</param>
/// <param name="width">The width of the rectangle to crop.</param>
/// <param name="height">The height of the rectangle to crop.</param>
/// <returns>
/// A cropped version of this object.
/// </returns>
function TBaseLuminanceSource.Crop(const left, top,
width, height: Integer): TLuminanceSource;
var
croppedLuminances,
oldLuminances : TArray<Byte>;
oldWidth,
oldRightBound,
oldBottomBound : Integer;
yold, ynew,
xold, xnew : Integer;
begin
if ((left + width > Self.Width) or (top + height > Self.Height))
then
raise EArgumentException.Create('Crop rectangle does not fit within image data.');
croppedLuminances := TArray<Byte>.Create();
SetLength(croppedLuminances, (width * height));
oldLuminances := Self.Matrix;
oldWidth := Self.Width;
oldRightBound := left + width;
oldBottomBound := top + height;
ynew := 0;
for yold := top to Pred(oldBottomBound) do
begin
xnew := 0;
for xold := left to Pred(oldRightBound) do
croppedLuminances[ynew * width + xnew] := oldLuminances[yold * oldWidth + xold];
Inc(ynew);
end;
Result := CreateLuminanceSource(croppedLuminances, width, height);
end;
/// <summary>
/// </summary>
/// <returns> Whether this subclass supports cropping.</returns>
function TBaseLuminanceSource.CropSupported: Boolean;
begin
Result := true;
end;
/// <summary>
/// </summary>
/// <returns>Whether this subclass supports invertion.</returns>
function TBaseLuminanceSource.InversionSupported: Boolean;
begin
Result := true;
end;
/// <summary>
/// Inverts the luminance values (newValue = 255 - oldValue)
/// </summary>
function TBaseLuminanceSource.invert(): TLuminanceSource;
begin
Result := TInvertedLuminanceSource.Create(Self);
end;
end.
@@ -0,0 +1,121 @@
unit ZXing.Binarizer;
{
* Copyright 2009 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.
* 2015-3 Adapted for Delphi/Object Pascal FireMonkey XE7 mobile by E.Spelt
}
interface
uses
System.SysUtils,
ZXing.LuminanceSource,
ZXing.Common.BitArray,
ZXing.Common.BitMatrix;
type
/// <summary> This class hierarchy provides a set of methods to convert luminance data to 1 bit data.
/// It allows the algorithm to vary polymorphically, for example allowing a very expensive
/// thresholding technique for servers and a fast one for mobile. It also permits the implementation
/// to vary, e.g. a JNI version for Android and a Java fallback version for other platforms.
///
/// <author>dswitkin@google.com (Daniel Switkin)</author>
/// </summary>
TBinarizer = class
private
FSource: TLuminanceSource;
function GetWidth: Integer;
function GetHeight: Integer;
protected
/// <summary>
/// Initializes a new instance of the <see cref="Binarizer"/> class.
/// </summary>
/// <param name="source">The source.</param>
constructor Create(source: TLuminanceSource);
/// <summary> Converts one row of luminance data to 1 bit data. May actually do the conversion, or return
/// cached data. Callers should assume this method is expensive and call it as seldom as possible.
/// This method is intended for decoding 1D barcodes and may choose to apply sharpening.
/// For callers which only examine one row of pixels at a time, the same BitArray should be reused
/// and passed in with each call for performance. However it is legal to keep more than one row
/// at a time if needed.
/// </summary>
/// <param name="y">The row to fetch, which must be in [0, bitmap height)</param>
/// <param name="row">An optional preallocated array. If null or too small, it will be ignored.
/// If used, the Binarizer will call BitArray.clear(). Always use the returned object.
/// </param>
/// <returns> The array of bits for this row (true means black).</returns>
public
function LuminanceSource(): TLuminanceSource;
function GetBlackRow(y: Integer; row: IBitArray): IBitArray;
virtual; abstract;
function BlackMatrix: TBitMatrix; virtual; abstract;
destructor Destroy();override;
/// <summary> Creates a new object with the same type as this Binarizer implementation, but with pristine
/// state. This is needed because Binarizer implementations may be stateful, e.g. keeping a cache
/// of 1 bit data. See Effective Java for why we can't use Java's clone() method.
/// </summary>
/// <param name="source">The LuminanceSource this Binarizer will operate on.</param>
/// <returns> A new concrete Binarizer implementation object.</returns>
function createBinarizer(source: TLuminanceSource): TBinarizer;
virtual; abstract;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
end;
implementation
{ TBinarizer }
constructor TBinarizer.Create(source: TLuminanceSource);
begin
if (source = nil) then
begin
raise EArgumentException.Create('Source must be non-null.');
end;
Self.FSource := source;
end;
destructor TBinarizer.Destroy;
begin
inherited;
end;
function TBinarizer.GetHeight: Integer;
begin
Result:= FSource.Height;
end;
function TBinarizer.GetWidth: Integer;
begin
result := FSource.Width;
end;
function TBinarizer.LuminanceSource: TLuminanceSource;
begin
result := Self.FSource;
end;
end.
@@ -0,0 +1,124 @@
{
* 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.BinaryBitmap;
interface
uses
System.SysUtils,
ZXing.Binarizer,
ZXing.LuminanceSource,
ZXing.Common.BitArray,
ZXing.Common.BitMatrix;
type
TBinaryBitmap = class
private
Binarizer: TBinarizer;
Matrix: TBitMatrix;
function GetWidth: Integer;
function GetHeight: Integer;
function GetBlackMatrix: TBitMatrix;
public
constructor Create(Binarizer: TBinarizer);
destructor Destroy(); override;
/// <summary>
/// Converts one row of luminance data to 1 bit data. May actually do the conversion, or return
/// cached data. Callers should assume this method is expensive and call it as seldom as possible.
/// This method is intended for decoding 1D barcodes and may choose to apply sharpening.
/// </summary>
/// <param name="y">The row to fetch, which must be in [0, bitmap height).</param>
/// <param name="row">An optional preallocated array. If null or too small, it will be ignored.
/// If used, the Binarizer will call BitArray.clear(). Always use the returned object.
/// </param>
/// <returns> The array of bits for this row (true means black).</returns>
function getBlackRow(y: Integer; row: IBitArray): IBitArray;
function RotateSupported: Boolean;
function rotateCounterClockwise(): TBinaryBitmap;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
property BlackMatrix: TBitMatrix read GetBlackMatrix;
end;
implementation
{ TBinaryBitmap }
constructor TBinaryBitmap.Create(Binarizer: TBinarizer);
begin
if (Binarizer = nil) then
begin
raise EArgumentException.Create('Binarizer must be non-null.');
end;
Self.Binarizer := Binarizer;
end;
destructor TBinaryBitmap.Destroy;
begin
if Assigned(Matrix) then
FreeAndNil(Matrix);
//FreeAndNil(Binarizer);
inherited;
end;
function TBinaryBitmap.GetBlackMatrix: TBitMatrix;
begin
if (Matrix = nil) then
begin
Matrix := Binarizer.BlackMatrix();
end;
result := Matrix;
end;
function TBinaryBitmap.getBlackRow(y: Integer; row: IBitArray): IBitArray;
begin
result := Binarizer.getBlackRow(y, row);
end;
function TBinaryBitmap.GetHeight: Integer;
begin
result := Binarizer.Height;
end;
function TBinaryBitmap.GetWidth: Integer;
begin
result := Binarizer.Width;
end;
function TBinaryBitmap.rotateCounterClockwise: TBinaryBitmap;
var
newSource: TLuminanceSource;
begin
newSource := Binarizer.LuminanceSource.rotateCounterClockwise();
result := TBinaryBitmap.Create(Binarizer.createBinarizer(newSource));
end;
function TBinaryBitmap.RotateSupported: Boolean;
begin
result := Binarizer.LuminanceSource.RotateSupported();
end;
end.
@@ -0,0 +1,249 @@
unit ZXing.GlobalHistogramBinarizer;
{
* Copyright 2009 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.
* 2015-3 Adapted for Delphi/Object Pascal FireMonkey XE7 mobile by E.Spelt
}
interface
uses
SysUtils,
ZXing.Binarizer,
ZXing.LuminanceSource,
ZXing.Common.BitArray,
ZXing.Common.Detector.MathUtils;
type
TGlobalHistogramBinarizer = class(TBinarizer)
private
class var LUMINANCE_BITS, LUMINANCE_SHIFT, LUMINANCE_BUCKETS: Integer;
EMPTY: TArray<Byte>;
luminances: TArray<Byte>;
buckets: TArray<Integer>;
procedure InitArrays(luminanceSize: Integer);
function estimateBlackPoint(buckets: TArray<Integer>;
var blackPoint: Integer): Boolean;
class procedure ClassInit; static;
public
constructor Create(source: TLuminanceSource);
// constructor GlobalHistogramBinarizer(source: TLuminanceSource);
function GetBlackRow(y: Integer; row: IBitArray): IBitArray; override;
end;
implementation
{ TGlobalHistogramBinarizer }
class procedure TGlobalHistogramBinarizer.ClassInit();
begin
LUMINANCE_BITS := 5;
LUMINANCE_SHIFT := 8 - LUMINANCE_BITS;
LUMINANCE_BUCKETS := 1 shl LUMINANCE_BITS;
EMPTY := TArray<Byte>.Create();
SetLength(EMPTY, 0);
end;
constructor TGlobalHistogramBinarizer.Create(source: TLuminanceSource);
begin
inherited Create(source);
luminances := EMPTY;
buckets := TArray<Integer>.Create();
SetLength(self.buckets, LUMINANCE_BUCKETS);
end;
{
constructor TGlobalHistogramBinarizer.GlobalHistogramBinarizer
(source: TLuminanceSource);
begin
Inherited Create(source);
SetLength(luminances, 0);
SetLength(buckets, LUMINANCE_BUCKETS);
end;
}
function TGlobalHistogramBinarizer.GetBlackRow(y: Integer; row: IBitArray)
: IBitArray;
var
localLuminances: TArray<Byte>;
localBuckets: TArray<Integer>;
i, w, blackPoint, x, pixel, left, right, center, luminance: Integer;
begin
w := width;
if ((row = nil) or (row.Size < w)) then
begin
row := TBitArrayHelpers.CreateBitArray(w);
end
else
begin
row.Clear();
end;
InitArrays(w);
localLuminances := LuminanceSource.getRow(y, luminances);
localBuckets := buckets;
for x := 0 to w - 1 do
begin
pixel := localLuminances[x] and $FF;
i := TMathUtils.Asr(pixel, LUMINANCE_SHIFT);
localBuckets[i] := localBuckets[i] + 1;
end;
if (not estimateBlackPoint(localBuckets, blackPoint)) then
begin
result := nil;
exit;
end;
left := localLuminances[0] and $FF;
center := localLuminances[1] and $FF;
for x := 1 to w - 2 do
begin
right := localLuminances[x + 1] and $FF;
// A simple -1 4 -1 box filter with a weight of 2.
luminance := (center shl 2) - left - right;
luminance := TMathUtils.Asr(luminance, 1);
row[x] := (luminance < blackPoint);
left := center;
center := right;
end;
result := row;
end;
procedure TGlobalHistogramBinarizer.InitArrays(luminanceSize: Integer);
var
x: Integer;
begin
if (Length(luminances) < luminanceSize) then
begin
SetLength(luminances, luminanceSize);
end;
for x := 0 to LUMINANCE_BUCKETS - 1 do
begin
buckets[x] := 0;
end;
end;
function TGlobalHistogramBinarizer.estimateBlackPoint(buckets: TArray<Integer>;
var blackPoint: Integer): Boolean;
var
x, numBuckets, maxBucketCount, firstPeak, firstPeakSize, secondPeak,
secondPeakScore, distanceToBiggest, score, temp, bestValley,
bestValleyScore, fromFirst: Integer;
begin
blackPoint := 0;
// Find the tallest peak in the histogram.
numBuckets := Length(buckets);
maxBucketCount := 0;
firstPeak := 0;
firstPeakSize := 0;
for x := 0 to numBuckets - 1 do
begin
if (buckets[x] > firstPeakSize) then
begin
firstPeak := x;
firstPeakSize := buckets[x];
end;
if (buckets[x] > maxBucketCount) then
begin
maxBucketCount := buckets[x];
end;
end;
// Find the second-tallest peak which is somewhat far from the tallest peak.
secondPeak := 0;
secondPeakScore := 0;
for x := 0 to numBuckets - 1 do
begin
distanceToBiggest := x - firstPeak;
// Encourage more distant second peaks by multiplying by square of distance.
score := buckets[x] * distanceToBiggest * distanceToBiggest;
if (score > secondPeakScore) then
begin
secondPeak := x;
secondPeakScore := score;
end;
end;
// Make sure firstPeak corresponds to the black peak.
if (firstPeak > secondPeak) then
begin
temp := firstPeak;
firstPeak := secondPeak;
secondPeak := temp;
end;
// If there is too little contrast in the image to pick a meaningful black point, throw rather
// than waste time trying to decode the image, and risk false positives.
// TODO: It might be worth comparing the brightest and darkest pixels seen, rather than the
// two peaks, to determine the contrast.
if ((secondPeak - firstPeak) <= (TMathUtils.Asr(numBuckets, 4))) then
begin
result := false;
exit;
end;
// Find a valley between them that is low and closer to the white peak.
bestValley := secondPeak - 1;
bestValleyScore := -1;
x := secondPeak - 1;
while (x > firstPeak) do
begin
fromFirst := x - firstPeak;
score := fromFirst * fromFirst * (secondPeak - x) *
(maxBucketCount - buckets[x]);
if (score > bestValleyScore) then
begin
bestValley := x;
bestValleyScore := score;
end;
Dec(x);
end;
blackPoint := bestValley shl LUMINANCE_SHIFT;
result := true;
end;
Initialization
TGlobalHistogramBinarizer.ClassInit();
end.
@@ -0,0 +1,330 @@
unit ZXing.HybridBinarizer;
{
* Copyright 2009 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.
* 2015-3 Adapted for Delphi/Object Pascal FireMonkey XE7 mobile by E.Spelt
}
interface
uses
SysUtils,
ZXing.GlobalHistogramBinarizer,
ZXing.LuminanceSource,
ZXing.Common.BitMatrix,
ZXing.binarizer,
ZXing.Common.Detector.MathUtils;
/// <summary> This class implements a local thresholding algorithm, which while slower than the
/// GlobalHistogramBinarizer, is fairly efficient for what it does. It is designed for
/// high frequency images of barcodes with black data on white backgrounds. For this application,
/// it does a much better job than a global blackpoint with severe shadows and gradients.
/// However it tends to produce artifacts on lower frequency images and is therefore not
/// a good general purpose binarizer for uses outside ZXing.
///
/// This class extends GlobalHistogramBinarizer, using the older histogram approach for 1D readers,
/// and the newer local approach for 2D readers. 1D decoding using a per-row histogram is already
/// inherently local, and only fails for horizontal gradients. We can revisit that problem later,
/// but for now it was not a win to use local blocks for 1D.
///
/// This Binarizer is the default for the unit tests and the recommended class for library users.
///
/// </summary>
/// <author> dswitkin@google.com (Daniel Switkin)
/// </author>
/// <author>www.Redivivus.in (suraj.supekar@redivivus.in) - Ported from ZXING Java Source
/// </author>
/// <author>Adapted for Delphi/Object Pascal FireMonkey XE7 mobile by E.Spelt
/// </author>
type
TArrayIntOfInt = TArray<TArray<Integer>>;
THybridBinarizer = class(TGlobalHistogramBinarizer)
private
matrix: TBitMatrix;
procedure BinarizeEntireImage;
procedure calculateThresholdForBlock(luminances: TArray<Byte>;
subWidth: Integer; subHeight: Integer; width: Integer; height: Integer;
blackPoints: TArrayIntOfInt; matrix: TBitMatrix);
function calculateBlackPoints(luminances: TArray<Byte>; subWidth: Integer;
subHeight: Integer; width: Integer; height: Integer): TArrayIntOfInt;
procedure thresholdBlock(luminances: TArray<Byte>; xoffset: Integer;
yoffset: Integer; threshold: Integer; stride: Integer;
matrix: TBitMatrix);
function cap(value: Integer; min: Integer; max: Integer): Integer;
protected
//
public
function createBinarizer(source: TLuminanceSource): TBinarizer; override;
constructor Create(source: TLuminanceSource);
function BlackMatrix: TBitMatrix; override;
end;
implementation
{ THybridBinarizer }
function THybridBinarizer.BlackMatrix: TBitMatrix;
begin
BinarizeEntireImage();
result := matrix;
end;
function THybridBinarizer.createBinarizer(source: TLuminanceSource): TBinarizer;
begin
result := THybridBinarizer.Create(source)
end;
procedure THybridBinarizer.BinarizeEntireImage;
var
source: TLuminanceSource;
luminances: TArray<Byte>;
subWidth, subHeight, width, height: Integer;
blackPoints: TArrayIntOfInt;
newMatrix: TBitMatrix;
begin
if (self.matrix <> nil) then
begin
inherited BlackMatrix;
Exit;
end;
try
source := self.LuminanceSource;
width := source.width;
height := source.height;
if ((width >= 40) and (height >= 40)) then
begin
luminances := source.matrix;
subWidth := TMathUtils.Asr(width, 3);
if ((width and 7) <> 0) then
inc(subWidth);
subHeight := TMathUtils.Asr(height, 3);
if ((height and 7) <> 0) then
inc(subHeight);
blackPoints := calculateBlackPoints(luminances, subWidth, subHeight,
width, height);
newMatrix := TBitMatrix.Create(width, height);
calculateThresholdForBlock(luminances, subWidth, subHeight, width, height,
blackPoints, newMatrix);
self.matrix := newMatrix;
end;
finally
SetLength(blackPoints,0);
blackPoints := nil;
luminances := nil;
end;
end;
function THybridBinarizer.calculateBlackPoints(luminances: TArray<Byte>;
subWidth: Integer; subHeight: Integer; width: Integer; height: Integer)
: TArrayIntOfInt;
var
blackPoints: TArrayIntOfInt;
i, x, y, yoffset, maxYOffset, xoffset, maxXOffset, sum, min, max, yy, offset,
xx, pixel, average, averageNeighborBlackPoint: Integer;
begin
blackPoints := TArrayIntOfInt.Create();
SetLength(blackPoints, subHeight);
i := 0;
while ((i < subHeight)) do
begin
blackPoints[i] := TArray<Integer>.Create();
SetLength(blackPoints[i], subWidth);
inc(i)
end;
y := 0;
while ((y < subHeight)) do
begin
yoffset := (y shl 3);
maxYOffset := (height - 8);
if (yoffset > maxYOffset) then
yoffset := maxYOffset;
x := 0;
while ((x < subWidth)) do
begin
xoffset := (x shl 3);
maxXOffset := (width - 8);
if (xoffset > maxXOffset) then
xoffset := maxXOffset;
sum := 0;
min := $FF;
max := 0;
yy := 0;
offset := ((yoffset * width) + xoffset);
while ((yy < 8)) do
begin
xx := 0;
while ((xx < 8)) do
begin
pixel := (luminances[(offset + xx)] and $FF);
inc(sum, pixel);
if (pixel < min) then
min := pixel;
if (pixel > max) then
max := pixel;
inc(xx)
end;
if ((max - min) > $18) then
begin
inc(yy);
inc(offset, width);
while ((yy < 8)) do
begin
xx := 0;
while ((xx < 8)) do
begin
inc(sum, (luminances[(offset + xx)] and $FF));
inc(xx)
end;
inc(yy);
inc(offset, width)
end
end;
inc(yy);
inc(offset, width)
end;
average := TMathUtils.Asr(sum, 6);
if ((max - min) <= $18) then
begin
average := TMathUtils.Asr(min, 1);
if ((y > 0) and (x > 0)) then
begin
averageNeighborBlackPoint :=
TMathUtils.Asr
(((blackPoints[(y - 1)][x] + (2 * blackPoints[y][(x - 1)])) +
blackPoints[(y - 1)][(x - 1)]), 2);
if (min < averageNeighborBlackPoint) then
average := averageNeighborBlackPoint
end
end;
blackPoints[y][x] := average;
inc(x)
end;
inc(y)
end;
result := blackPoints;
end;
procedure THybridBinarizer.calculateThresholdForBlock(luminances: TArray<Byte>;
subWidth: Integer; subHeight: Integer; width: Integer; height: Integer;
blackPoints: TArrayIntOfInt; matrix: TBitMatrix);
var
y, yoffset, maxYOffset, x, xoffset, maxXOffset, left, top, sum, z,
average: Integer;
blackRow: TArray<Integer>;
begin
y := 0;
while ((y < subHeight)) do
begin
yoffset := (y shl 3);
maxYOffset := (height - 8);
if (yoffset > maxYOffset) then
yoffset := maxYOffset;
x := 0;
while ((x < subWidth)) do
begin
xoffset := (x shl 3);
maxXOffset := (width - 8);
if (xoffset > maxXOffset) then
xoffset := maxXOffset;
left := cap(x, 2, (subWidth - 3));
top := cap(y, 2, (subHeight - 3));
sum := 0;
z := -2;
while ((z <= 2)) do
begin
blackRow := blackPoints[(top + z)];
inc(sum, blackRow[(left - 2)]);
inc(sum, blackRow[(left - 1)]);
inc(sum, blackRow[left]);
inc(sum, blackRow[(left + 1)]);
inc(sum, blackRow[(left + 2)]);
inc(z)
end;
average := (sum div $19);
thresholdBlock(luminances, xoffset, yoffset, average, width, matrix);
inc(x)
end;
inc(y)
end
end;
constructor THybridBinarizer.Create(source: TLuminanceSource);
begin
inherited Create(source);
end;
procedure THybridBinarizer.thresholdBlock(luminances: TArray<Byte>;
xoffset: Integer; yoffset: Integer; threshold: Integer; stride: Integer;
matrix: TBitMatrix);
var
offset, x, y, pixel: Integer;
begin
offset := ((yoffset * stride) + xoffset);
y := 0;
while ((y < 8)) do
begin
x := 0;
while ((x < 8)) do
begin
pixel := (luminances[(offset + x)] and $FF);
matrix[(xoffset + x), (yoffset + y)] := (pixel <= threshold);
inc(x)
end;
inc(y);
inc(offset, stride)
end
end;
function THybridBinarizer.cap(value: Integer; min: Integer;
max: Integer): Integer;
begin
if (value < min) then
begin
result := min
end
else if (value > max) then
begin
result := max
end
else
result := value
end;
end.
@@ -0,0 +1,159 @@
{
* Copyright 2013 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: dswitkin@google.com (Daniel Switkin)
* Delphi Implementation by K. Gossens
}
unit ZXing.InvertedLuminanceSource;
interface
uses
System.SysUtils,
ZXing.LuminanceSource;
type
TInvertedLuminanceSource = class sealed(TLuminanceSource)
private
delegate: TLuminanceSource;
invertedMatrix: TArray<Byte>;
public
constructor Create(delegate: TLuminanceSource); reintroduce;
function crop(const left, top, width, height: Integer): TLuminanceSource; override;
function getRow(const y: Integer; row: TArray<Byte>): TArray<Byte>; override;
function rotateCounterClockwise(): TLuminanceSource; override;
function rotateCounterClockwise45(): TLuminanceSource; override;
function invert: TLuminanceSource; override;
function Matrix: TArray<Byte>; override;
function CropSupported: Boolean; override;
function RotateSupported: Boolean; override;
end;
implementation
{ TInvertedLuminanceSource }
/// <summary>
/// Initializes a new instance of the <see cref="InvertedLuminanceSource"/> class.
/// </summary>
/// <param name="delegate">The @delegate.</param>
constructor TInvertedLuminanceSource.Create(delegate: TLuminanceSource);
begin
inherited Create(delegate.Width, delegate.Height);
Self.delegate := delegate;
end;
/// <summary>
/// Fetches one row of luminance data from the underlying platform's bitmap. Values range from
/// 0 (black) to 255 (white). Because Java does not have an unsigned byte type, callers will have
/// to bitwise and with 0xff for each value. It is preferable for implementations of this method
/// to only fetch this row rather than the whole image, since no 2D Readers may be installed and
/// getMatrix() may never be called.
/// </summary>
/// <param name="y">The row to fetch, 0 &lt;= y &lt; Height.</param>
/// <param name="row">An optional preallocated array. If null or too small, it will be ignored.
/// Always use the returned object, and ignore the .length of the array.</param>
/// <returns>
/// An array containing the luminance data.
/// </returns>
function TInvertedLuminanceSource.getRow(const y: Integer; row: TArray<Byte>): TArray<Byte>;
var
rowArray : TArray<Byte>;
i, width : Integer;
begin
rowArray := delegate.getRow(y, row);
width := Self.Width;
for i := 0 to Pred(width) do
rowArray[i] := (255 - (row[i] and $FF));
Result := rowArray;
end;
/// <summary>
/// Fetches luminance data for the underlying bitmap. Values should be fetched using:
/// int luminance = array[y * width + x] &amp; 0xff;
/// </summary>
/// <returns> A row-major 2D array of luminance values. Do not use result.length as it may be
/// larger than width * height bytes on some platforms. Do not modify the contents
/// of the result.
/// </returns>
function TInvertedLuminanceSource.Matrix: TArray<Byte>;
var
matrixArray: TArray<Byte>;
i, len: Integer;
begin
if (invertedMatrix = nil) then
begin
matrixArray := delegate.Matrix;
len := Self.Width * Self.Height;
invertedMatrix := TArray<Byte>.Create();
SetLength(invertedMatrix, len);
for i := 0 to Pred(len) do
invertedMatrix[i] := (255 - (matrixArray[i] and $FF));
Result := invertedMatrix;
end;
end;
/// <summary>
/// </summary>
/// <returns> Whether this subclass supports cropping.</returns>
function TInvertedLuminanceSource.CropSupported: Boolean;
begin
Result := delegate.CropSupported;
end;
/// <summary>
/// Returns a new object with cropped image data. Implementations may keep a reference to the
/// original data rather than a copy. Only callable if CropSupported is true.
/// </summary>
/// <param name="left">The left coordinate, 0 &lt;= left &lt; Width.</param>
/// <param name="top">The top coordinate, 0 &lt;= top &lt;= Height.</param>
/// <param name="width">The width of the rectangle to crop.</param>
/// <param name="height">The height of the rectangle to crop.</param>
/// <returns>
/// A cropped version of this object.
/// </returns>
function TInvertedLuminanceSource.crop(const left, top,
width, height: Integer): TLuminanceSource;
begin
Result := TInvertedLuminanceSource.Create(Self.delegate.crop(left, top,
width, height));
end;
function TInvertedLuminanceSource.invert: TLuminanceSource;
begin
Result := self.delegate;
end;
function TInvertedLuminanceSource.rotateCounterClockwise(): TLuminanceSource;
begin
Result := TInvertedLuminanceSource.Create(Self.delegate.rotateCounterClockwise);
end;
function TInvertedLuminanceSource.rotateCounterClockwise45(): TLuminanceSource;
begin
Result := TInvertedLuminanceSource.Create(Self.delegate.rotateCounterClockwise45);
end;
function TInvertedLuminanceSource.RotateSupported: Boolean;
begin
Result := delegate.RotateSupported;;
end;
end.
@@ -0,0 +1,221 @@
{
* Copyright 2009 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: dswitkin@google.com (Daniel Switkin)
* Delphi Implementation by E.Spelt and K. Gossens
}
unit ZXing.LuminanceSource;
interface
uses
System.SysUtils;
type
/// <summary>
/// The purpose of this class hierarchy is to abstract different bitmap implementations across
/// platforms into a standard interface for requesting greyscale luminance values. The interface
/// only provides immutable methods; therefore crop and rotation create copies. This is to ensure
/// that one Reader does not modify the original luminance source and leave it in an unknown state
/// for other Readers in the chain.
/// </summary>
TLuminanceSource = class
protected
FWidth: Integer;
FHeight: Integer;
public
constructor Create(const width, height: Integer); virtual;
/// <summary>
/// Fetches luminance data for the underlying bitmap. Values should be fetched using:
/// <code>int luminance = array[y * width + x] and 0xff</code>
/// </summary>
/// <returns>
/// A row-major 2D array of luminance values. Do not use result.length as it may be
/// larger than width * height bytes on some platforms. Do not modify the contents
/// of the result.
/// </returns>
function Matrix: TArray<byte>; virtual; abstract;
/// <summary>
/// Fetches one row of luminance data from the underlying platform's bitmap. Values range from
/// 0 (black) to 255 (white). Because Java does not have an unsigned byte type, callers will have
/// to bitwise and with 0xff for each value. It is preferable for implementations of this method
/// to only fetch this row rather than the whole image, since no 2D Readers may be installed and
/// getMatrix() may never be called.
/// </summary>
/// <param name="y">The row to fetch, which must be in [0, bitmap height)</param>
/// <param name="row">An optional preallocated array. If null or too small, it will be ignored.
/// Always use the returned object, and ignore the .length of the array.
/// </param>
/// <returns> An array containing the luminance data.</returns>
function getRow(const y: Integer; row: TArray<byte>): TArray<byte>;
virtual; abstract;
/// <summary>
/// Returns a new object with cropped image data. Implementations may keep a reference to the
/// original data rather than a copy. Only callable if CropSupported is true.
/// </summary>
/// <param name="left">The left coordinate, which must be in [0, Width)</param>
/// <param name="top">The top coordinate, which must be in [0, Height)</param>
/// <param name="width">The width of the rectangle to crop.</param>
/// <param name="height">The height of the rectangle to crop.</param>
/// <returns> A cropped version of this object.</returns>
function crop(const left, top, width,
height: Integer): TLuminanceSource; virtual;
function invert(): TLuminanceSource; virtual;
function ToString(): String; override;
/// <returns> Whether this subclass supports counter-clockwise rotation.</returns>
function RotateSupported: Boolean; virtual;
/// <returns> Whether this subclass supports cropping.</returns>
function CropSupported(): Boolean; virtual;
/// <returns>Whether this subclass supports invertion.</returns>
function InversionSupported: Boolean; virtual;
/// <summary>
/// Returns a new object with rotated image data by 90 degrees counterclockwise.
/// Only callable if <see cref="RotateSupported"/> is true.
/// </summary>
/// <returns>A rotated version of this object.</returns>
function rotateCounterClockwise(): TLuminanceSource; virtual;
/// <summary>
/// Returns a new object with rotated image data by 45 degrees counterclockwise.
/// Only callable if <see cref="RotateSupported"/> is true.
/// </summary>
/// <returns>A rotated version of this object.</returns>
function rotateCounterClockwise45(): TLuminanceSource; virtual;
/// <returns> The height of the bitmap.</returns>
property Height: Integer read FHeight;
/// <returns> The width of the bitmap.</returns>
property Width: Integer read FWidth;
end;
implementation
constructor TLuminanceSource.Create(const width, height: Integer);
begin
FWidth := width;
FHeight := height;
end;
function TLuminanceSource.CropSupported: Boolean;
begin
Result := False;
end;
// <returns> Whether this subclass supports counter-clockwise rotation.</returns>
function TLuminanceSource.RotateSupported: Boolean;
begin
Result := False;
end;
/// <returns>Whether this subclass supports invertion.</returns>
function TLuminanceSource.InversionSupported: Boolean;
begin
Result := False;
end;
/// <summary>
/// Returns a new object with cropped image data. Implementations may keep a reference to the
/// original data rather than a copy. Only callable if CropSupported is true.
/// </summary>
/// <param name="left">The left coordinate, which must be in [0, Width)</param>
/// <param name="top">The top coordinate, which must be in [0, Height)</param>
/// <param name="width">The width of the rectangle to crop.</param>
/// <param name="height">The height of the rectangle to crop.</param>
/// <returns> A cropped version of this object.</returns>
function TLuminanceSource.Crop(const left, top,
width, height: Integer): TLuminanceSource;
begin
raise ENotImplemented.Create
('This luminance source does not support cropping.');
end;
/// <summary>
/// Returns a new object with rotated image data by 90 degrees counterclockwise.
/// Only callable if <see cref="RotateSupported"/> is true.
/// </summary>
/// <returns>A rotated version of this object.</returns>
function TLuminanceSource.rotateCounterClockwise(): TLuminanceSource;
begin
raise ENotImplemented.Create
('This luminance source does not support rotation.');
end;
/// <summary>
/// Returns a new object with rotated image data by 45 degrees counterclockwise.
/// Only callable if <see cref="RotateSupported"/> is true.
/// </summary>
/// <returns>A rotated version of this object.</returns>
function TLuminanceSource.rotateCounterClockwise45(): TLuminanceSource;
begin
raise ENotImplemented.Create
('This luminance source does not support rotation by 45 degrees.');
end;
function TLuminanceSource.invert(): TLuminanceSource;
begin
raise ENotImplemented.Create
('This luminance source does not support inversion.');
end;
function TLuminanceSource.ToString(): String;
var
row: TArray<byte>;
res: TStringBuilder;
x, y,
luminance: Integer;
c: char;
begin
row := TArray<Byte>.Create();
SetLength(row, FWidth);
res := TStringBuilder.Create(height * (width + 1));
try
for y := 0 to FHeight - 1 do
begin
row := GetRow(y, row);
for x := 0 to Pred(FWidth) do
begin
luminance := row[x] and $FF;
if (luminance < $40)
then
c := '#'
else
if (luminance < $80)
then
c := '+'
else
if (luminance < $C0)
then
c := '.'
else
c := ' ';
res.Append(c);
end;
res.Append(#10);
end;
finally
row := nil; // ES: can become a be a big memory hog, so release it as quickly as possible.
Result := res.ToString;
res.Free;
end;
end;
end.
@@ -0,0 +1,327 @@
{
* Copyright 2009 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: dswitkin@google.com (Daniel Switkin)
* Delphi Implementation K. Gossens
}
unit ZXing.PlanarYUVLuminanceSource;
interface
uses
System.SysUtils,
System.UITypes,
System.TypInfo,
ZXing.LuminanceSource,
ZXing.BaseLuminanceSource;
type
/// <summary>
/// Luminance source class which support different formats of images.
/// </summary>
TPlanarYUVLuminanceSource = class(TBaseLuminanceSource)
private
yuvData : TArray<Byte>;
dataWidth,
dataHeight,
left, top : Integer;
const
THUMBNAIL_SCALE_FACTOR : Integer = 2;
procedure reverseHorizontal(const width, height: Integer);
protected
function CreateLuminanceSource(const newLuminances: TArray<Byte>;
const width, height: Integer): TLuminanceSource; override;
public
constructor Create(const yuvData: TArray<Byte>;
const dataWidth, dataHeight, left, top, width, height: Integer;
const reverseHoriz: Boolean); overload;
constructor Create(const luminances: TArray<Byte>;
const width, height: Integer); overload;
function getRow(const y: Integer; row: TArray<Byte>): TArray<Byte>; override;
function crop(const left, top,
width, height: Integer): TLuminanceSource; override;
function Matrix: TArray<Byte>; override;
function CropSupported: Boolean; override;
function renderThumbnail(): TArray<Integer>;
function ThumbnailWidth(): Integer;
function ThumbnailHeight(): Integer;
end;
implementation
/// <summary>
/// Initializes a new instance of the <see cref="PlanarYUVLuminanceSource"/> class.
/// </summary>
/// <param name="yuvData">The yuv data.</param>
/// <param name="dataWidth">Width of the data.</param>
/// <param name="dataHeight">Height of the data.</param>
/// <param name="left">The left.</param>
/// <param name="top">The top.</param>
/// <param name="width">The width.</param>
/// <param name="height">The height.</param>
/// <param name="reverseHoriz">if set to <c>true</c> [reverse horiz].</param>
constructor TPlanarYUVLuminanceSource.Create(const yuvData: TArray<Byte>;
const dataWidth, dataHeight, left, top, width, height: Integer;
const reverseHoriz: Boolean);
begin
inherited Create(width, height);
if ((left + width > dataWidth) or (top + height > dataHeight))
then
raise EArgumentException.Create('Crop rectangle does not fit within image data.');
Self.yuvData := yuvData;
Self.dataWidth := dataWidth;
Self.dataHeight := dataHeight;
Self.left := left;
Self.top := top;
if (reverseHoriz)
then
reverseHorizontal(width, height);
end;
/// <summary>
/// Initializes a new instance of the <see cref="PlanarYUVLuminanceSource"/> class.
/// </summary>
/// <param name="luminances">The luminances.</param>
/// <param name="width">The width.</param>
/// <param name="height">The height.</param>
constructor TPlanarYUVLuminanceSource.Create(const luminances: TArray<Byte>;
const width, height: Integer);
begin
inherited Create(width, height);
Self.yuvData := luminances;
Self.luminances := luminances;
Self.dataWidth := width;
Self.dataHeight := height;
Self.left := 0;
Self.top := 0;
end;
/// <summary>
/// Fetches one row of luminance data from the underlying platform's bitmap. Values range from
/// 0 (black) to 255 (white). Because Java does not have an unsigned byte type, callers will have
/// to bitwise and with 0xff for each value. It is preferable for implementations of this method
/// to only fetch this row rather than the whole image, since no 2D Readers may be installed and
/// getMatrix() may never be called.
/// </summary>
/// <param name="y">The row to fetch, 0 &lt;= y &lt; Height.</param>
/// <param name="row">An optional preallocated array. If null or too small, it will be ignored.
/// Always use the returned object, and ignore the .length of the array.</param>
/// <returns>
/// An array containing the luminance data.
/// </returns>
function TPlanarYUVLuminanceSource.getRow(const y: Integer;
row: TArray<Byte>): TArray<Byte>;
var
width,
offset: Integer;
begin
if ((y < 0) or (y >= Height))
then
raise EArgumentException.Create('Requested row is outside the image: ' + IntToStr(y));
width := Self.Width;
if ((row = nil) or (Length(row) < width)) then
begin
row := nil;
row := TArray<Byte>.Create();
SetLength(row, width);
end;
offset := (y + top) * dataWidth + left;
row := Copy(yuvData, offset, width);
Result := row;
end;
/// <summary>
///
/// </summary>
function TPlanarYUVLuminanceSource.Matrix: TArray<Byte>;
var
width,
height,
area, y : Integer;
inputOffset,
outputOffset : Integer;
matrix,
yuv: TArray<Byte>;
begin
width := Self.Width;
height := Self.Height;
// If the caller asks for the entire underlying image, save the copy and give them the
// original data. The docs specifically warn that result.length must be ignored.
if ((width = dataWidth) and (height = dataHeight)) then
begin
Result := Self.yuvData;
exit;
end;
area := width * height;
matrix := TArray<Byte>.Create();
SetLength(matrix, area);
inputOffset := (top * dataWidth) + left;
// If the width matches the full width of the underlying data, perform a single copy.
if (width = dataWidth) then
begin
matrix := Copy(yuvData, inputOffset, area);
Result := matrix;
exit;
end;
// Otherwise copy one cropped row at a time.
yuv := yuvData;
for y := 0 to Pred(height) do
begin
outputOffset := y * width;
Move(yuv[inputOffSet], matrix[outputOffset], width);
Inc(inputOffset, dataWidth);
end;
Result := matrix;
end;
/// <summary>
/// </summary>
/// <returns> Whether this subclass supports cropping.</returns>
function TPlanarYUVLuminanceSource.CropSupported: Boolean;
begin
Result := true;
end;
/// <summary>
/// Returns a new object with cropped image data. Implementations may keep a reference to the
/// original data rather than a copy. Only callable if CropSupported is true.
/// </summary>
/// <param name="left">The left coordinate, 0 &lt;= left &lt; Width.</param>
/// <param name="top">The top coordinate, 0 &lt;= top &lt;= Height.</param>
/// <param name="width">The width of the rectangle to crop.</param>
/// <param name="height">The height of the rectangle to crop.</param>
/// <returns>
/// A cropped version of this object.
/// </returns>
function TPlanarYUVLuminanceSource.crop(const left, top,
width, height: Integer): TLuminanceSource;
begin
Result := TPlanarYUVLuminanceSource.Create(yuvData,
dataWidth,
dataHeight,
Self.left + left,
Self.top + top,
width,
height,
false);
end;
/// <summary>
/// Renders the cropped greyscale bitmap.
/// </summary>
/// <returns></returns>
function TPlanarYUVLuminanceSource.renderThumbnail(): TArray<Integer>;
var
width,
height : Integer;
pixels : TArray<Integer>;
yuv : TArray<Byte>;
x, y,
inputOffset,
outputOffset : Integer;
grey : Byte;
begin
width := Self.Width div THUMBNAIL_SCALE_FACTOR;
height := Self.Height div THUMBNAIL_SCALE_FACTOR;
pixels := TArray<Integer>.Create();
SetLength(pixels, (width * height));
yuv := yuvData;
inputOffset := (top * dataWidth) + left;
for y := 0 to Pred(height) do
begin
outputOffset := y * width;
for x := 0 to Pred(width) do
begin
grey := yuv[inputOffset + x * THUMBNAIL_SCALE_FACTOR] and $ff;
pixels[outputOffset + x] := (($00FF0000 shl 8) or (grey * $00010101));
end;
Inc(inputOffset, (dataWidth * THUMBNAIL_SCALE_FACTOR));
end;
Result := pixels;
end;
/// <summary>
/// width of image from {@link #renderThumbnail()}
/// </summary>
function TPlanarYUVLuminanceSource.ThumbnailWidth(): Integer;
begin
Result := (Self.Width div THUMBNAIL_SCALE_FACTOR);
end;
/// <summary>
/// height of image from {@link #renderThumbnail()}
/// </summary>
function TPlanarYUVLuminanceSource.ThumbnailHeight(): Integer;
begin
Result := (Self.Height div THUMBNAIL_SCALE_FACTOR);
end;
procedure TPlanarYUVLuminanceSource.reverseHorizontal(const width, height: Integer);
var
yuvData : TArray<Byte>;
y,
x1, x2,
middle,
rowStart : Integer;
temp : Byte;
begin
yuvData := Self.yuvData;
y := 0;
rowStart := ((self.top * self.dataWidth) + self.left);
while ((y < height)) do
begin
middle := (rowStart + (width div 2));
x1 := rowStart;
x2 := ((rowStart + width) - 1);
while ((x1 < middle)) do
begin
temp := yuvData[x1];
yuvData[x1] := yuvData[x2];
yuvData[x2] := temp;
Inc(x1);
Dec(x2)
end;
Inc(y);
Inc(rowStart, self.dataWidth)
end;
end;
function TPlanarYUVLuminanceSource.CreateLuminanceSource(
const newLuminances: TArray<Byte>;
const width, height: Integer): TLuminanceSource;
begin
Result := TPlanarYUVLuminanceSource.Create(newLuminances, width, height);
end;
end.
@@ -0,0 +1,565 @@
{
* Copyright 2012 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: dswitkin@google.com (Daniel Switkin)
* Delphi Implementation by E.Spelt and K. Gossens
}
unit ZXing.RGBLuminanceSource;
interface
uses
System.SysUtils,
System.UITypes,
System.TypInfo,
{$IFDEF FRAMEWORK_FMX}
FMX.Graphics,
{$ENDIF}
{$IFDEF FRAMEWORK_VCL}
Winapi.Windows,
VCL.Graphics,
{$ENDIF}
ZXing.LuminanceSource,
ZXing.BaseLuminanceSource,
ZXing.Common.Detector.MathUtils;
type
/// <summary>
/// enumeration of supported bitmap format which the RGBLuminanceSource can process
/// </summary>
TBitmapFormat = (
/// <summary>
/// format of the byte[] isn't known. RGBLuminanceSource tries to determine the best possible value
/// </summary>
Unknown,
/// <summary>
/// grayscale array, the byte array is a luminance array with 1 byte per pixel
/// </summary>
Gray8,
/// <summary>
/// 3 bytes per pixel with the channels red, green and blue
/// </summary>
RGB24,
/// <summary>
/// 4 bytes per pixel with the channels red, green and blue
/// </summary>
RGB32,
/// <summary>
/// 4 bytes per pixel with the channels alpha, red, green and blue
/// </summary>
ARGB32,
/// <summary>
/// 3 bytes per pixel with the channels blue, green and red
/// </summary>
BGR24,
/// <summary>
/// 4 bytes per pixel with the channels blue, green and red
/// </summary>
BGR32,
/// <summary>
/// 4 bytes per pixel with the channels blue, green, red and alpha
/// </summary>
BGRA32,
/// <summary>
/// 2 bytes per pixel, 5 bit red, 6 bits green and 5 bits blue
/// </summary>
RGB565,
/// <summary>
/// 4 bytes per pixel with the channels red, green, blue and alpha
/// </summary>
RGBA32);
/// <summary>
/// Luminance source class which support different formats of images.
/// </summary>
TRGBLuminanceSource = class(TBaseLuminanceSource)
private
function DetermineBitmapFormat(const rgbRawBytes: TArray<Byte>;
const width, height: Integer): TBitmapFormat;
procedure CalculateLuminanceRGB24(const rgbRawBytes: TArray<Byte>);
procedure CalculateLuminanceRGB32(const rgbRawBytes: TArray<Byte>);
procedure CalculateLuminanceRGBA32(const rgbRawBytes: TArray<Byte>);
procedure CalculateLuminanceRGB565(const rgb565RawData: TArray<Byte>);
procedure CalculateLuminanceBGR24(const rgbRawBytes: TArray<Byte>);
procedure CalculateLuminanceBGR32(const rgbRawBytes: TArray<Byte>);
procedure CalculateLuminanceBGRA32(const rgbRawBytes: TArray<Byte>);
procedure CalculateLuminanceARGB32(const rgbRawBytes: TArray<Byte>);
function GetBitmapFormat: TBitmapFormat;
protected
function CreateLuminanceSource(const newLuminances: TArray<Byte>;
const width, height: Integer): TLuminanceSource; override;
procedure CalculateLuminance(const rgbRawBytes: TArray<Byte>;
bitmapFormat: TBitmapFormat);
public
constructor Create(const width, height: Integer); overload;
constructor Create(const rgbRawBytes: TArray<Byte>;
const width, height: Integer); overload;
constructor Create(const rgbRawBytes: TArray<Byte>;
const width, height: Integer; const bitmapFormat: TBitmapFormat); overload;
constructor CreateFromBitmap(const sourceBitmap: TBitmap;
const width, height: Integer);
property BitmapFormat : TBitmapFormat read GetBitmapFormat;
end;
implementation
uses ZXing.Helpers;
/// <summary>
/// Initializes a new instance of the <see cref="RGBLuminanceSource"/> class.
/// </summary>
/// <param name="width">The width.</param>
/// <param name="height">The height.</param>
constructor TRGBLuminanceSource.Create(const width, height: Integer);
begin
inherited Create(width, height);
end;
/// <summary>
/// Initializes a new instance of the <see cref="RGBLuminanceSource"/> class.
/// It supports a byte array with 3 bytes per pixel (RGB24).
/// </summary>
/// <param name="rgbRawBytes">The RGB raw bytes.</param>
/// <param name="width">The width.</param>
/// <param name="height">The height.</param>
constructor TRGBLuminanceSource.Create(const rgbRawBytes: TArray<Byte>;
const width, height: Integer);
begin
Create(rgbRawBytes, width, height, TBitmapFormat.RGB24);
end;
/// <summary>
/// Initializes a new instance of the <see cref="RGBLuminanceSource"/> class.
/// It supports a byte array with 3 bytes per pixel (RGB24).
/// </summary>
/// <param name="rgbRawBytes">The RGB raw bytes.</param>
/// <param name="width">The width.</param>
/// <param name="height">The height.</param>
/// <param name="bitmapFormat">The bitmap format.</param>
constructor TRGBLuminanceSource.Create(const rgbRawBytes: TArray<Byte>;
const width, height: Integer; const bitmapFormat: TBitmapFormat);
begin
inherited Create(width, height);
CalculateLuminance(rgbRawBytes, bitmapFormat);
end;
{$IFDEF FRAMEWORK_FMX}
// FMX TBitmap implementation
constructor TRGBLuminanceSource.CreateFromBitmap(const sourceBitmap: TBitmap;
const width, height: Integer);
var
x, y,
offset : Integer;
color : TAlphaColor;
r, g, b : Byte;
currentData: TBitmapData;
begin
Self.Create(width, height);
// In order to measure pure decoding speed, we convert the entire image to a greyscale array
// up front, which is the same as the Y channel of the YUVLuminanceSource in the real app.
if (sourceBitmap.Map(TMapAccess.Read, currentData)) then
begin
try
for y := 0 to FHeight - 1 do
begin
offset := y * FWidth;
for x := 0 to FWidth - 1 do
begin
color := currentData.GetPixel(x, y);
r := TAlphaColorRec(color).R;
g := TAlphaColorRec(color).G;
b := TAlphaColorRec(color).B;
luminances[offset + x] := TMathUtils.Asr(3482*r + 11721*g + 1181*b, 14);
end;
end;
finally
sourceBitmap.Unmap(currentData);
//sourceBitmap.DisposeOf();
end;
end;
end;
{$ENDIF}
{$IFDEF FRAMEWORK_VCL}
// VCL TBitmap implementation
constructor TRGBLuminanceSource.CreateFromBitmap(const sourceBitmap: TBitmap; const width, height: Integer);
type
TRGBTripleArray = ARRAY[Word] of TRGBTriple;
pRGBTripleArray = ^TRGBTripleArray; // Use a PByteArray for pf8bit color.
var
x, y,
offset : Integer;
r, g, b : Byte;
P: pRGBTripleArray;
begin
Self.Create(width, height);
sourceBitmap.PixelFormat := pf24bit;
for y := 0 to sourceBitmap.Height - 1 do
begin
offset := y * FWidth;
P := sourceBitmap.ScanLine[y];
for x := 0 to sourceBitmap.Width - 1 do
begin
r := P[x].rgbtRed;
g := P[x].rgbtGreen;
b := P[x].rgbtBlue;
luminances[offset + x] := TMathUtils.Asr(3482*r + 11721*g + 1181*b, 14);
end;
end;
end;
{$ENDIF}
/// <summary>
/// Should create a new luminance source with the right class type.
/// The method is used in methods crop and rotate.
/// </summary>
/// <param name="newLuminances">The new luminances.</param>
/// <param name="width">The width.</param>
/// <param name="height">The height.</param>
/// <returns></returns>
function TRGBLuminanceSource.CreateLuminanceSource(
const newLuminances: TArray<Byte>;
const width, height: Integer): TLuminanceSource;
begin
Result := TRGBLuminanceSource.Create(width, height);
luminances := newLuminances;
end;
function TRGBLuminanceSource.DetermineBitmapFormat(
const rgbRawBytes: TArray<Byte>;
const width, height: Integer): TBitmapFormat;
var
square,
byteperpixel : Integer;
begin
square := (width * height);
byteperpixel := (Length(rgbRawBytes) div square);
case byteperpixel of
1: Result := TBitmapFormat.Gray8;
2: Result := TBitmapFormat.RGB565;
3: Result := TBitmapFormat.RGB24;
4: Result := TBitmapFormat.RGB32;
else
raise EArgumentException.Create('The bitmap format could not be determined. Please specify the correct value.');
end;
end;
procedure TRGBLuminanceSource.CalculateLuminance(const rgbRawBytes: TArray<Byte>;
bitmapFormat: TBitmapFormat);
var
len: Integer;
begin
if (bitmapFormat = TBitmapFormat.Unknown)
then
bitmapFormat := DetermineBitmapFormat(rgbRawBytes, self.Width, self.Height);
case bitmapFormat of
TBitmapFormat.Gray8 :
begin
if (Length(rgbRawBytes) < Length(luminances))
then
len := Length(rgbRawBytes)
else
len := Length(luminances);
Copy(rgbRawBytes, 0, len);
end;
TBitmapFormat.RGB24 :
begin
CalculateLuminanceRGB24(rgbRawBytes);
end;
TBitmapFormat.RGB32 :
begin
CalculateLuminanceRGB32(rgbRawBytes);
end;
TBitmapFormat.ARGB32 :
begin
CalculateLuminanceARGB32(rgbRawBytes);
end;
TBitmapFormat.BGR24 :
begin
CalculateLuminanceBGR24(rgbRawBytes);
end;
TBitmapFormat.BGR32 :
begin
CalculateLuminanceBGR32(rgbRawBytes);
end;
TBitmapFormat.BGRA32 :
begin
CalculateLuminanceBGRA32(rgbRawBytes);
end;
TBitmapFormat.RGB565 :
begin
CalculateLuminanceRGB565(rgbRawBytes);
end;
TBitmapFormat.RGBA32 :
begin
CalculateLuminanceRGBA32(rgbRawBytes);
end;
else
raise EArgumentException.Create('The bitmap format isn''t supported.' +
GetEnumName(TypeInfo(TBitmapFormat), Ord(bitmapFormat)))
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceRGB565(
const rgb565RawData: TArray<Byte>);
var
luminanceIndex,
index : Integer;
byte1,
byte2,
b5, g5, r5,
r8, g8, b8 : Byte;
begin
luminanceIndex := 0;
index := 0;
while (((index < Length(rgb565RawData)) and
(luminanceIndex < Length(luminances)))) do
begin
byte1 := rgb565RawData[index];
byte2 := rgb565RawData[index + 1];
b5 := (byte1 and $1F);
g5 := (TMathUtils.Asr(byte1 and $E0 , 5) or ((byte2 and $03) shl 3)) and $1F;
r5 := TMathUtils.Asr(byte2, 2) and $1F;
r8 := TMathUtils.Asr(r5 * 527 + 23, 6);
g8 := TMathUtils.Asr(g5 * 527 + 23, 6);
b8 := TMathUtils.Asr(b5 * 527 + 23, 6);
// cheap, not fully accurate conversion
//pixel := (byte2 shl 8) or byte1;
//b8 := (((pixel) and $001F) shl 3);
//g8 := (((pixel) and $07E0) shr 2) and $FF;
//r8 := (((pixel) and $F800) shr 8);
luminances[luminanceIndex] := TMathUtils.Asr(RChannelWeight * r8 + GChannelWeight * g8 +
BChannelWeight * b8, ChannelWeight);
Inc(index, 2);
Inc(luminanceIndex);
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceRGB24(
const rgbRawBytes: TArray<Byte>);
var
rgbIndex,
luminanceIndex,
r, g, b : Integer;
begin
rgbIndex := 0;
luminanceIndex := 0;
while (((rgbIndex < Length(rgbRawBytes)) and
(luminanceIndex < Length(luminances)))) do
begin
// Calculate luminance cheaply, favoring green.
r := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
g := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
b := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
luminances[luminanceIndex] := TMathUtils.Asr(RChannelWeight * r + GChannelWeight * g +
BChannelWeight * b,ChannelWeight);
inc(luminanceIndex)
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceBGR24(
const rgbRawBytes: TArray<Byte>);
var
rgbIndex,
luminanceIndex,
b, g, r : Byte;
begin
rgbIndex := 0;
luminanceIndex := 0;
while (((rgbIndex < Length(rgbRawBytes)) and
(luminanceIndex < Length(luminances)))) do
begin
// Calculate luminance cheaply, favoring green.
b := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
g := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
r := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
luminances[luminanceIndex] := TMathUtils.Asr(RChannelWeight * r + GChannelWeight * g +
BChannelWeight * b,ChannelWeight);
Inc(luminanceIndex)
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceRGB32(
const rgbRawBytes: TArray<Byte>);
var
rgbIndex,
luminanceIndex,
r, g, b : Byte;
begin
rgbIndex := 0;
luminanceIndex := 0;
while (((rgbIndex < Length(rgbRawBytes)) and
(luminanceIndex < Length(luminances)))) do
begin
// Calculate luminance cheaply, favoring green.
r := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
g := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
b := rgbRawBytes[rgbIndex];
Inc(rgbIndex, 2);
luminances[luminanceIndex] := TMathUtils.Asr(RChannelWeight * r + GChannelWeight * g +
BChannelWeight * b, ChannelWeight);
Inc(luminanceIndex);
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceBGR32(
const rgbRawBytes: TArray<Byte>);
var
rgbIndex,
luminanceIndex,
b, g, r : Byte;
begin
rgbIndex := 0;
luminanceIndex := 0;
while (((rgbIndex < Length(rgbRawBytes)) and
(luminanceIndex < Length(luminances)))) do
begin
// Calculate luminance cheaply, favoring green.
b := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
g := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
r := rgbRawBytes[rgbIndex];
Inc(rgbIndex, 2);
luminances[luminanceIndex] := TMathUtils.Asr(RChannelWeight * r + GChannelWeight * g +
BChannelWeight * b, ChannelWeight);
Inc(luminanceIndex);
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceBGRA32(
const rgbRawBytes: TArray<Byte>);
var
rgbIndex,
luminanceIndex,
b, g, r,
alpha : Byte;
luminance : Byte;
begin
rgbIndex := 0;
luminanceIndex := 0;
while (((rgbIndex < Length(rgbRawBytes)) and
(luminanceIndex < Length(luminances)))) do
begin
// Calculate luminance cheaply, favoring green.
b := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
g := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
r := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
alpha := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
luminance := TMathUtils.Asr(RChannelWeight * r + GChannelWeight * g +
BChannelWeight * b, ChannelWeight);
luminances[luminanceIndex] := (TMathUtils.Asr(luminance * alpha, 8) + TMathUtils.Asr(255 * (255 - alpha), 8));
Inc(luminanceIndex);
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceRGBA32(
const rgbRawBytes: TArray<Byte>);
var
rgbIndex,
luminanceIndex,
r, g, b,
alpha : Byte;
luminance : Byte;
begin
rgbIndex := 0;
luminanceIndex := 0;
while (((rgbIndex < Length(rgbRawBytes)) and
(luminanceIndex < Length(luminances)))) do
begin
// Calculate luminance cheaply, favoring green.
r := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
g := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
b := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
alpha := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
luminance := TMathUtils.Asr(RChannelWeight * r + GChannelWeight * g +
BChannelWeight * b, ChannelWeight);
luminances[luminanceIndex] := TMathUtils.Asr(luminance * alpha, 8) + TMathUtils.Asr(255 * (255 - alpha), 8);
Inc(luminanceIndex);
end;
end;
procedure TRGBLuminanceSource.CalculateLuminanceARGB32(
const rgbRawBytes: TArray<Byte>);
var
rgbIndex,
luminanceIndex,
r, g, b,
alpha : Byte;
luminance : Byte;
begin
rgbIndex := 0;
luminanceIndex := 0;
while (((rgbIndex < Length(rgbRawBytes)) and
(luminanceIndex < Length(luminances)))) do
begin
// Calculate luminance cheaply, favoring green.
alpha := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
r := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
g := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
b := rgbRawBytes[rgbIndex];
Inc(rgbIndex);
luminance := TMathUtils.Asr(RChannelWeight * r + GChannelWeight * g +
BChannelWeight * b, ChannelWeight);
luminances[luminanceIndex] := TMathUtils.Asr(luminance * alpha,8) + TMathUtils.Asr(255 * (255 - alpha),8);
Inc(luminanceIndex);
end;
end;
function TRGBLuminanceSource.GetBitmapFormat: TBitmapFormat;
begin
try
Result := DetermineBitmapFormat(luminances, Width, Height);
except
Result := TBitmapFormat.Unknown;
end;
end;
end.
+202
View File
@@ -0,0 +1,202 @@
Apache License
Version 2.0, January 2004
http://www.apache.org/licenses/
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
1. Definitions.
"License" shall mean the terms and conditions for use, reproduction,
and distribution as defined by Sections 1 through 9 of this document.
"Licensor" shall mean the copyright owner or entity authorized by
the copyright owner that is granting the License.
"Legal Entity" shall mean the union of the acting entity and all
other entities that control, are controlled by, or are under common
control with that entity. For the purposes of this definition,
"control" means (i) the power, direct or indirect, to cause the
direction or management of such entity, whether by contract or
otherwise, or (ii) ownership of fifty percent (50%) or more of the
outstanding shares, or (iii) beneficial ownership of such entity.
"You" (or "Your") shall mean an individual or Legal Entity
exercising permissions granted by this License.
"Source" form shall mean the preferred form for making modifications,
including but not limited to software source code, documentation
source, and configuration files.
"Object" form shall mean any form resulting from mechanical
transformation or translation of a Source form, including but
not limited to compiled object code, generated documentation,
and conversions to other media types.
"Work" shall mean the work of authorship, whether in Source or
Object form, made available under the License, as indicated by a
copyright notice that is included in or attached to the work
(an example is provided in the Appendix below).
"Derivative Works" shall mean any work, whether in Source or Object
form, that is based on (or derived from) the Work and for which the
editorial revisions, annotations, elaborations, or other modifications
represent, as a whole, an original work of authorship. For the purposes
of this License, Derivative Works shall not include works that remain
separable from, or merely link (or bind by name) to the interfaces of,
the Work and Derivative Works thereof.
"Contribution" shall mean any work of authorship, including
the original version of the Work and any modifications or additions
to that Work or Derivative Works thereof, that is intentionally
submitted to Licensor for inclusion in the Work by the copyright owner
or by an individual or Legal Entity authorized to submit on behalf of
the copyright owner. For the purposes of this definition, "submitted"
means any form of electronic, verbal, or written communication sent
to the Licensor or its representatives, including but not limited to
communication on electronic mailing lists, source code control systems,
and issue tracking systems that are managed by, or on behalf of, the
Licensor for the purpose of discussing and improving the Work, but
excluding communication that is conspicuously marked or otherwise
designated in writing by the copyright owner as "Not a Contribution."
"Contributor" shall mean Licensor and any individual or Legal Entity
on behalf of whom a Contribution has been received by Licensor and
subsequently incorporated within the Work.
2. Grant of Copyright License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
copyright license to reproduce, prepare Derivative Works of,
publicly display, publicly perform, sublicense, and distribute the
Work and such Derivative Works in Source or Object form.
3. Grant of Patent License. Subject to the terms and conditions of
this License, each Contributor hereby grants to You a perpetual,
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
(except as stated in this section) patent license to make, have made,
use, offer to sell, sell, import, and otherwise transfer the Work,
where such license applies only to those patent claims licensable
by such Contributor that are necessarily infringed by their
Contribution(s) alone or by combination of their Contribution(s)
with the Work to which such Contribution(s) was submitted. If You
institute patent litigation against any entity (including a
cross-claim or counterclaim in a lawsuit) alleging that the Work
or a Contribution incorporated within the Work constitutes direct
or contributory patent infringement, then any patent licenses
granted to You under this License for that Work shall terminate
as of the date such litigation is filed.
4. Redistribution. You may reproduce and distribute copies of the
Work or Derivative Works thereof in any medium, with or without
modifications, and in Source or Object form, provided that You
meet the following conditions:
(a) You must give any other recipients of the Work or
Derivative Works a copy of this License; and
(b) You must cause any modified files to carry prominent notices
stating that You changed the files; and
(c) You must retain, in the Source form of any Derivative Works
that You distribute, all copyright, patent, trademark, and
attribution notices from the Source form of the Work,
excluding those notices that do not pertain to any part of
the Derivative Works; and
(d) If the Work includes a "NOTICE" text file as part of its
distribution, then any Derivative Works that You distribute must
include a readable copy of the attribution notices contained
within such NOTICE file, excluding those notices that do not
pertain to any part of the Derivative Works, in at least one
of the following places: within a NOTICE text file distributed
as part of the Derivative Works; within the Source form or
documentation, if provided along with the Derivative Works; or,
within a display generated by the Derivative Works, if and
wherever such third-party notices normally appear. The contents
of the NOTICE file are for informational purposes only and
do not modify the License. You may add Your own attribution
notices within Derivative Works that You distribute, alongside
or as an addendum to the NOTICE text from the Work, provided
that such additional attribution notices cannot be construed
as modifying the License.
You may add Your own copyright statement to Your modifications and
may provide additional or different license terms and conditions
for use, reproduction, or distribution of Your modifications, or
for any such Derivative Works as a whole, provided Your use,
reproduction, and distribution of the Work otherwise complies with
the conditions stated in this License.
5. Submission of Contributions. Unless You explicitly state otherwise,
any Contribution intentionally submitted for inclusion in the Work
by You to the Licensor shall be under the terms and conditions of
this License, without any additional terms or conditions.
Notwithstanding the above, nothing herein shall supersede or modify
the terms of any separate license agreement you may have executed
with Licensor regarding such Contributions.
6. Trademarks. This License does not grant permission to use the trade
names, trademarks, service marks, or product names of the Licensor,
except as required for reasonable and customary use in describing the
origin of the Work and reproducing the content of the NOTICE file.
7. Disclaimer of Warranty. Unless required by applicable law or
agreed to in writing, Licensor provides the Work (and each
Contributor provides its Contributions) on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
implied, including, without limitation, any warranties or conditions
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
PARTICULAR PURPOSE. You are solely responsible for determining the
appropriateness of using or redistributing the Work and assume any
risks associated with Your exercise of permissions under this License.
8. Limitation of Liability. In no event and under no legal theory,
whether in tort (including negligence), contract, or otherwise,
unless required by applicable law (such as deliberate and grossly
negligent acts) or agreed to in writing, shall any Contributor be
liable to You for damages, including any direct, indirect, special,
incidental, or consequential damages of any character arising as a
result of this License or out of the use or inability to use the
Work (including but not limited to damages for loss of goodwill,
work stoppage, computer failure or malfunction, or any and all
other commercial damages or losses), even if such Contributor
has been advised of the possibility of such damages.
9. Accepting Warranty or Additional Liability. While redistributing
the Work or Derivative Works thereof, You may choose to offer,
and charge a fee for, acceptance of support, warranty, indemnity,
or other liability obligations and/or rights consistent with this
License. However, in accepting such obligations, You may act only
on Your own behalf and on Your sole responsibility, not on behalf
of any other Contributor, and only if You agree to indemnify,
defend, and hold each Contributor harmless for any liability
incurred by, or claims asserted against, such Contributor by reason
of your accepting any such warranty or additional liability.
END OF TERMS AND CONDITIONS
APPENDIX: How to apply the Apache License to your work.
To apply the Apache License to your work, attach the following
boilerplate notice, with the fields enclosed by brackets "{}"
replaced with your own identifying information. (Don't include
the brackets!) The text should be enclosed in the appropriate
comment syntax for the file format. We also recommend that a
file or class name and description of purpose be included on the
same "printed page" as the copyright notice for easier
identification within third-party archives.
Copyright {yyyy} {name of copyright owner}
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.
+185
View File
@@ -0,0 +1,185 @@
unit ZXing.ScanManager;
interface
uses
System.SysUtils,
System.Generics.Collections,
{$IFDEF FRAMEWORK_FMX}
FMX.Graphics,
{$ENDIF}
{$IFDEF FRAMEWORK_VCL}
VCL.Graphics,
{$ENDIF}
ZXing.LuminanceSource,
ZXing.RGBLuminanceSource,
ZXing.InvertedLuminanceSource,
ZXing.HybridBinarizer,
ZXing.BinaryBitmap,
ZXing.MultiFormatReader,
ZXing.BarcodeFormat,
ZXing.ResultPoint,
ZXing.ReadResult,
ZXing.DecodeHintType;
type
TScanManager = class
private
FEnableInversion: Boolean;
FHints: TDictionary<TDecodeHintType, TObject>;
FResultPointEvent: TResultPointCallback;
FMultiFormatReader: TMultiFormatReader;
listFormats: TList<TBarcodeFormat>;
function GetMultiFormatReader(const format: TBarcodeFormat)
: TMultiFormatReader;
procedure SetResultPointEvent(const AValue: TResultPointCallback);
public
destructor Destroy; override;
function Scan(const pBitmapForScan: TBitmap): TReadResult;
constructor Create(const format: TBarcodeFormat;
Hints: TDictionary<TDecodeHintType, TObject>);
property OnResultPoint: TResultPointCallback read FResultPointEvent
write SetResultPointEvent;
end;
implementation
constructor TScanManager.Create(const format: TBarcodeFormat;
Hints: TDictionary<TDecodeHintType, TObject>);
begin
inherited Create;
FEnableInversion := False;
FHints := Hints;
FMultiFormatReader := GetMultiFormatReader(format);
end;
destructor TScanManager.Destroy;
var
hint: TPair<TDecodeHintType, TObject>;
o: TObject;
begin
if Assigned(FHints) then
begin
for hint in FHints do
begin
o := hint.Value;
if Assigned(o) then
o.Free;
end;
FHints.Clear();
FreeAndNil(FHints);
end;
FreeAndNil(FMultiFormatReader);
inherited;
end;
procedure TScanManager.SetResultPointEvent(const AValue: TResultPointCallback);
var
ahKey: TDecodeHintType;
ahValue: TObject;
begin
FResultPointEvent := AValue;
ahKey := TDecodeHintType.NEED_RESULT_POINT_CALLBACK;
if Assigned(FResultPointEvent) then
begin
ahValue := TResultPointEventObject.Create(FResultPointEvent);
FHints.AddOrSetValue(ahKey, ahValue);
end
else
begin
if Fhints.TryGetValue(ahKey, ahValue) then
begin
ahValue.Free;
ahValue := nil;
FHints.Remove(ahKey);
end;
end;
end;
function TScanManager.GetMultiFormatReader(const format: TBarcodeFormat)
: TMultiFormatReader;
var
o: TObject;
begin
Result := TMultiFormatReader.Create;
listFormats := nil;
if FHints = nil then
FHints := TDictionary<TDecodeHintType, TObject>.Create();
if FHints.ContainsKey(ZXing.DecodeHintType.ENABLE_INVERSION) then
FEnableInversion := true;
if format <> TBarcodeFormat.Auto then
begin
if (FHints.TryGetValue(ZXing.DecodeHintType.POSSIBLE_FORMATS, o)) then
listFormats := o as TList<TBarcodeFormat>
else
begin
listFormats := TList<TBarcodeFormat>.Create();
FHints.Add(ZXing.DecodeHintType.POSSIBLE_FORMATS, listFormats);
end;
if (listFormats.Count = 0) then
listFormats.Add(format)
else
listFormats.Insert(0, format); // favor the format parameter
end;
Result.Hints := FHints;
end;
function TScanManager.Scan(const pBitmapForScan: TBitmap): TReadResult;
var
LuminanceSource, InvLuminanceSource: TLuminanceSource;
HybridBinarizer: THybridBinarizer;
BinaryBitmap: TBinaryBitmap;
begin
InvLuminanceSource := nil;
LuminanceSource := nil;
HybridBinarizer := nil;
BinaryBitmap := nil;
try
LuminanceSource := TRGBLuminanceSource.CreateFromBitmap(pBitmapForScan,
pBitmapForScan.Width, pBitmapForScan.Height);
HybridBinarizer := THybridBinarizer.Create(LuminanceSource);
BinaryBitmap := TBinaryBitmap.Create(HybridBinarizer);
Result := FMultiFormatReader.Decode(BinaryBitmap, true);
if (Result = nil) then
begin
if (FEnableInversion) then
begin
if (BinaryBitmap <> nil) then
FreeAndNil(BinaryBitmap);
if (HybridBinarizer <> nil) then
FreeAndNil(HybridBinarizer);
InvLuminanceSource := LuminanceSource.invert();
HybridBinarizer := THybridBinarizer.Create(InvLuminanceSource);
BinaryBitmap := TBinaryBitmap.Create(HybridBinarizer);
Result := FMultiFormatReader.Decode(BinaryBitmap, true);
end;
end;
finally
BinaryBitmap.Free;
HybridBinarizer.Free;
InvLuminanceSource.Free;
LuminanceSource.Free;
end;
end;
end.
+3 -3
View File
@@ -588,7 +588,7 @@
type="password" autocomplete="off">
<div class="in-x" data-clear="sPwd">&#215;</div>
</div>
<button class="btn wide" id="sPaste">Paste settings (QR from the PC)</button>
<button class="btn wide" id="sScan">Scan the QR shown on the PC</button>
<button class="btn wide main" id="sSave">Save</button>
<div class="note">The sync password never leaves this device. It is what
encrypts the copy kept in the repository, so it must be the same on every
@@ -1666,8 +1666,8 @@ function normalizeRepoUrl(u) {
if (!m) return u;
return m[1] + '/api/v1/repos/' + m[2] + '/' + m[3] + '/contents/' + (m[4] || 'vault-sync.json');
}
document.getElementById('sPaste').addEventListener('click', function () {
send('pastecfg');
document.getElementById('sScan').addEventListener('click', function () {
send('scanqr');
});
document.getElementById('sSave').addEventListener('click', function () {
var sUrl = document.getElementById('sUrl');
+175 -16
View File
@@ -36,7 +36,7 @@ uses
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Platform,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types,
FMX.ScrollBox, FMX.Layouts, FMX.Edit, FMX.ListBox, FMX.Objects,
FMX.WebBrowser, System.Messaging,
FMX.WebBrowser, System.Messaging, FMX.Media,
PMA.Vault;
const
@@ -341,7 +341,18 @@ type
/// que le proprietaire ne connaitrait pas.
procedure SetUnlockCode(const ANew: string);
procedure PushUnlockMode;
procedure PasteSyncSettings;
// Scanner du QR affiche par le poste (ZXing.Delphi, Apache 2.0).
var
FScanning, FScanBusy: Boolean;
FScanFrame: Integer;
FScanLay: TLayout;
FScanImg: TImage;
FCam: TCameraComponent;
procedure StartScan;
procedure BeginScan;
procedure StopScan;
procedure DoCancelScan(Sender: TObject);
procedure OnCamFrame(Sender: TObject; const ATime: TMediaTime);
function ApplySyncLink(const ALink: string): Boolean;
{$IFDEF ANDROID}
procedure OnActivityMessage(const Sender: TObject; const M: TMessage);
@@ -385,10 +396,11 @@ implementation
uses
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp,
PMA.ScreenGuard, PMA.Clipboard, PMA.Theme, PMA.WebUI, PMA.VaultPatch,
PMA.SaveFile, PMA.Favicon, System.JSON
PMA.SaveFile, PMA.Favicon, System.JSON, System.Permissions,
ZXing.ScanManager, ZXing.BarcodeFormat, ZXing.ReadResult
{$IFDEF ANDROID}
, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes,
Androidapi.Helpers, FMX.Platform.Android
Androidapi.Helpers, FMX.Platform.Android, Androidapi.JNI.Os
{$ENDIF};
{$R *.fmx}
@@ -602,6 +614,12 @@ procedure TForm8.OnHardwareBack(Sender: TObject; var Key: Word;
var KeyChar: WideChar; Shift: TShiftState);
begin
if Key <> vkHardwareBack then Exit;
if FScanning then
begin
StopScan;
Key := 0;
Exit;
end;
if not FLayWeb.Visible then Exit;
// LE CLAVIER D'ABORD. Quand il est deplie, cette touche est le bouton qui le
// replie - c'est tout ce qu'elle veut dire. La vue web n'etant pas un champ
@@ -1834,12 +1852,10 @@ begin
SetUnlockCode(TNetEncoding.URL.Decode(Param('c')));
end
// REGLAGES COLLES DEPUIS LE QR DU POSTE. L'appareil photo a lu le QR et
// copie son texte : {"pmsync":1,"u":URL,"t":JETON}. On remplit les champs
// des reglages SANS enregistrer - Save reste le geste qui valide - et on
// vide le presse-papiers, qui porte le jeton.
else if LAction = 'pastecfg' then
PasteSyncSettings
// SCANNER LE QR DU POSTE depuis l'app : le scanner du systeme envoyait
// le lien a une recherche web ou demandait avec quoi l'ouvrir.
else if LAction = 'scanqr' then
StartScan
else if LAction = 'pinclear' then
ClearUnlockCode(TNetEncoding.URL.Decode(Param('c')))
@@ -2890,8 +2906,9 @@ begin
// recentes : masquer ici, c'est ne pas y laisser la liste des comptes.
// Le masquage est IMMEDIAT et sans condition - c'est lui qui protege.
TApplicationEvent.WillBecomeInactive:
if FWebView <> 'unlock' then
if FScanning or (FWebView <> 'unlock') then
begin
StopScan; // la camera ne reste pas ouverte en arriere-plan
FWeb.Visible := False;
FLayWeb.Visible := False;
end;
@@ -3225,12 +3242,154 @@ begin
if HasLocalContainer then Result := 'vault password' else Result := 'sync password';
end;
procedure TForm8.PasteSyncSettings;
procedure TForm8.StartScan;
begin
if ApplySyncLink(CurrentClipboard.Trim) then
ClearClipboard
else
WebCall('PM.toast("No settings in the clipboard - copy the link of the QR shown on the PC first")');
if FScanning or FBusy then Exit;
{$IFDEF ANDROID}
PermissionsService.RequestPermissions(
[JStringToString(TJManifest_permission.JavaClass.CAMERA)],
procedure(const APermissions: TClassicStringDynArray;
const AGrantResults: TClassicPermissionStatusDynArray)
begin
if (Length(AGrantResults) = 1) and
(AGrantResults[0] = TPermissionStatus.Granted) then
BeginScan
else
WebCall('PM.toast("Camera not allowed - type the settings instead")');
end);
{$ELSE}
BeginScan;
{$ENDIF}
end;
/// L'apercu est FMX, pas web : la vue web est une vue native posee PAR-DESSUS
/// les controles FMX, il faut donc la masquer pendant le scan.
procedure TForm8.BeginScan;
var
LBg: TRectangle;
LBtn: TButton;
LLbl: TLabel;
begin
if FScanLay = nil then
begin
FScanLay := TLayout.Create(Self);
FScanLay.Parent := Self;
FScanLay.Align := TAlignLayout.Contents;
LBg := TRectangle.Create(FScanLay);
LBg.Parent := FScanLay;
LBg.Align := TAlignLayout.Contents;
LBg.Fill.Color := TAlphaColors.Black;
LBg.Stroke.Kind := TBrushKind.None;
LBg.HitTest := False;
LLbl := TLabel.Create(FScanLay);
LLbl.Parent := FScanLay;
LLbl.Align := TAlignLayout.Top;
LLbl.Height := 72;
LLbl.Margins.Top := 24;
LLbl.StyledSettings := [];
LLbl.TextSettings.FontColor := TAlphaColors.White;
LLbl.TextSettings.Font.Size := 16;
LLbl.TextSettings.HorzAlign := TTextAlign.Center;
LLbl.Text := 'Point the camera at the QR shown on the PC';
LBtn := TButton.Create(FScanLay);
LBtn.Parent := FScanLay;
LBtn.Align := TAlignLayout.Bottom;
LBtn.Height := 56;
LBtn.Margins.Rect := TRectF.Create(24, 8, 24, 32);
LBtn.Text := 'Cancel';
LBtn.OnClick := DoCancelScan;
FScanImg := TImage.Create(FScanLay);
FScanImg.Parent := FScanLay;
FScanImg.Align := TAlignLayout.Client;
FScanImg.WrapMode := TImageWrapMode.Fit;
FScanImg.HitTest := False;
FCam := TCameraComponent.Create(Self);
FCam.OnSampleBufferReady := OnCamFrame;
end;
HideSoftKeyboard;
FScanning := True;
FScanBusy := False;
FScanFrame := 0;
FLayWeb.Visible := False;
FScanLay.Visible := True;
FScanLay.BringToFront;
FCam.Active := False;
FCam.Kind := TCameraKind.BackCamera;
FCam.Quality := TVideoCaptureQuality.MediumQuality;
try
FCam.FocusMode := TFocusMode.ContinuousAutoFocus;
except
// Pas d'autofocus continu : l'image restera nette a bonne distance.
end;
FCam.Active := True;
Log('QR scan started');
end;
procedure TForm8.StopScan;
begin
if not FScanning then Exit;
FScanning := False;
if FCam <> nil then FCam.Active := False;
if FScanLay <> nil then FScanLay.Visible := False;
FLayWeb.Visible := True;
end;
procedure TForm8.DoCancelScan(Sender: TObject);
begin
StopScan;
end;
/// Une image sur quatre part au decodage, jamais deux a la fois : ZXing prend
/// quelques dizaines de ms, et empiler les images figerait l'apercu.
procedure TForm8.OnCamFrame(Sender: TObject; const ATime: TMediaTime);
begin
TThread.Synchronize(nil,
procedure
var
LBmp: TBitmap;
begin
if not FScanning then Exit;
FCam.SampleBufferToBitmap(FScanImg.Bitmap, True);
Inc(FScanFrame);
if FScanBusy or (FScanFrame mod 4 <> 0) then Exit;
FScanBusy := True;
LBmp := TBitmap.Create;
LBmp.Assign(FScanImg.Bitmap);
TThread.CreateAnonymousThread(
procedure
var
LMgr: TScanManager;
LRes: TReadResult;
LText: string;
begin
LText := '';
LRes := nil;
LMgr := TScanManager.Create(TBarcodeFormat.QR_CODE, nil);
try
try
LRes := LMgr.Scan(LBmp);
if LRes <> nil then LText := LRes.Text;
except
LText := '';
end;
finally
LRes.Free;
LMgr.Free;
LBmp.Free;
end;
TThread.Queue(nil,
procedure
begin
FScanBusy := False;
if (not FScanning) or (LText = '') then Exit;
if StartsText('pmserver://sync?', LText) then
begin
StopScan;
ApplySyncLink(LText);
end;
end);
end).Start;
end);
end;
/// pmserver://sync?u=URL&t=JETON -> champs des reglages remplis, RIEN
+1
View File
@@ -90,6 +90,7 @@
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_UnitSearchPath>android-client\ThirdParty\ZXing;android-client\ThirdParty\ZXing\1D Barcodes;android-client\ThirdParty\ZXing\2D Barcodes;android-client\ThirdParty\ZXing\2D Barcodes\Decoder;android-client\ThirdParty\ZXing\2D Barcodes\Detector;android-client\ThirdParty\ZXing\Common;android-client\ThirdParty\ZXing\Common\Detector;android-client\ThirdParty\ZXing\Common\ReedSolomon;android-client\ThirdParty\ZXing\Filtering;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>