395 lines
10 KiB
ObjectPascal
395 lines
10 KiB
ObjectPascal
unit frxBarcodOneCode;
|
|
|
|
interface
|
|
|
|
type
|
|
TLongIntArray = array of LongInt;
|
|
|
|
TOneCode = class
|
|
private
|
|
function PadLeft(str: AnsiString; TotalWidth: Integer;
|
|
PaddingChar: AnsiChar): AnsiString;
|
|
function TrimStart(str: AnsiString; TrimChar: AnsiChar): AnsiString;
|
|
function TrimOff(source, bad: AnsiString): AnsiString;
|
|
function Substring(str: AnsiString; startIndex: Integer;
|
|
len: Integer = -1): AnsiString;
|
|
function AnsiToInt(str: AnsiString): Integer;
|
|
protected
|
|
entries2Of13: Int64;
|
|
entries5Of13: Int64;
|
|
table2Of13: TLongIntArray;
|
|
table5Of13: TLongIntArray;
|
|
codewordArray: array[0..9, 0..1] of Int64;
|
|
|
|
function OneCodeInfo(topic: LongInt): TLongIntArray;
|
|
function OneCodeInitializeNof13Table(ai: TLongIntArray; i, j: LongInt): Boolean;
|
|
function OneCodeMathReverse(i: LongInt): LongInt;
|
|
function OneCodeMathAdd(bytearray: TLongIntArray; i, j: LongInt): Boolean;
|
|
function OneCodeMathDivide(v: AnsiString): Boolean;
|
|
function OneCodeMathFcs(bytearray: TLongIntArray): LongInt;
|
|
function OneCodeMathMultiply(bytearray: TLongIntArray; i, j: LongInt): Boolean;
|
|
public
|
|
constructor Create;
|
|
function Bars(source: AnsiString): AnsiString;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils;
|
|
|
|
const
|
|
table2Of13Size = 78;
|
|
table5Of13Size = 1287;
|
|
barTopCharIndexArray: array[0..64] of LongInt =
|
|
(4, 0, 2, 6, 3, 5, 1, 9, 8, 7, 1, 2, 0, 6, 4, 8, 2, 9, 5, 3, 0, 1, 3, 7, 4,
|
|
6, 8, 9, 2, 0, 5, 1, 9, 4, 3, 8, 6, 7, 1, 2, 4, 3, 9, 5, 7, 8, 3, 0, 2, 1,
|
|
4, 0, 9, 1, 7, 0, 2, 4, 6, 3, 7, 1, 9, 5, 8);
|
|
barBottomCharIndexArray: array[0..64] of LongInt =
|
|
(7, 1, 9, 5, 8, 0, 2, 4, 6, 3, 5, 8, 9, 7, 3, 0, 6, 1, 7, 4, 6, 8, 9, 2, 5,
|
|
1, 7, 5, 4, 3, 8, 7, 6, 0, 2, 5, 4, 9, 3, 0, 1, 6, 8, 2, 0, 4, 5, 9, 6, 7,
|
|
5, 2, 6, 3, 8, 5, 1, 9, 8, 7, 4, 0, 2, 6, 3);
|
|
barTopCharShiftArray: array[0..64] of LongInt =
|
|
(3, 0, 8, 11, 1, 12, 8, 11, 10, 6, 4, 12, 2, 7, 9, 6, 7, 9, 2, 8, 4, 0, 12,
|
|
7, 10, 9, 0, 7, 10, 5, 7, 9, 6, 8, 2, 12, 1, 4, 2, 0, 1, 5, 4, 6, 12, 1, 0,
|
|
9, 4, 7, 5, 10, 2, 6, 9, 11, 2, 12, 6, 7, 5, 11, 0, 3, 2);
|
|
barBottomCharShiftArray: array[0..64] of LongInt =
|
|
(2, 10, 12, 5, 9, 1, 5, 4, 3, 9, 11, 5, 10, 1, 6, 3, 4, 1, 10, 0, 2, 11, 8,
|
|
6, 1, 12, 3, 8, 6, 4, 4, 11, 0, 6, 1, 9, 11, 5, 3, 7, 3, 10, 7, 11, 8, 2,
|
|
10, 3, 5, 8, 0, 3, 12, 11, 8, 4, 5, 1, 3, 0, 7, 12, 9, 8, 10);
|
|
|
|
{ TOneCode }
|
|
|
|
function TOneCode.AnsiToInt(str: AnsiString): Integer;
|
|
begin
|
|
Result := StrToInt(String(str));
|
|
end;
|
|
|
|
function TOneCode.Bars(source: AnsiString): AnsiString;
|
|
function PlaceToInt(str: AnsiString; i: integer): LongInt;
|
|
begin
|
|
Result := AnsiToInt(Substring(str, i, 1));
|
|
end;
|
|
function IsDigital(str: AnsiString): boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
for i := 1 to Length(str) do
|
|
if not (str[i] in ['0'..'9']) then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
var
|
|
fcs: LongInt;
|
|
l: Int64;
|
|
v: Int64;
|
|
encoded, ds, zip: AnsiString;
|
|
byteArray: TLongIntArray;
|
|
ai, ai1: array[0..64] of LongInt;
|
|
ad: array[0..9, 0..1] of Int64;
|
|
i: SmallInt;
|
|
begin
|
|
Result := '';
|
|
source := TrimOff(source, ' -.');
|
|
if not ((Length(source) in [20, 25, 29, 31]) and IsDigital(source) and
|
|
(source[2] in ['0'..'4'])) then
|
|
Exit;
|
|
l := 0;
|
|
encoded := '';
|
|
ds := '';
|
|
zip := Substring(source, 20);
|
|
SetLength(byteArray, 14);
|
|
case Length(zip) of
|
|
5: l := StrToInt64(String(zip))+ 1;
|
|
9: l := StrToInt64(String(zip))+ 100001;
|
|
11: l := StrToInt64(String(zip))+ 1000100001;
|
|
end;
|
|
v := l * 10 + PlaceToInt(source, 0);
|
|
v := v * 5 + PlaceToInt(source, 1);
|
|
ds := AnsiString(IntToStr(v)) + Substring(source, 2, 18);
|
|
byteArray[12] := l and 255;
|
|
byteArray[11] := (l shr 8) and 255;
|
|
byteArray[10] := (l shr 16) and 255;
|
|
byteArray[9] := (l shr 24) and 255;
|
|
byteArray[8] := (l shr 32) and 255;
|
|
OneCodeMathMultiply(byteArray, 13, 10);
|
|
OneCodeMathAdd(byteArray, 13, PlaceToInt(source, 0));
|
|
OneCodeMathMultiply(byteArray, 13, 5);
|
|
OneCodeMathAdd(byteArray, 13, PlaceToInt(source, 1));
|
|
for i := 2 to 19 do
|
|
begin
|
|
OneCodeMathMultiply(byteArray, 13, 10);
|
|
OneCodeMathAdd(byteArray, 13, PlaceToInt(source, i));
|
|
end;
|
|
fcs := OneCodeMathFcs(byteArray);
|
|
for i := 0 to 9 do
|
|
begin
|
|
codewordArray[i][0] := entries2Of13 + entries5Of13;
|
|
codewordArray[i][1] := 0;
|
|
end;
|
|
codewordArray[0][0] := 659;
|
|
codewordArray[9][0] := 636;
|
|
OneCodeMathDivide(ds);
|
|
codewordArray[9][1] := codewordArray[9][1] * 2;
|
|
if (fcs shr 10) <> 0 then
|
|
codewordArray[0][1] := codewordArray[0][1] + 659;
|
|
for i := 0 to 9 do
|
|
begin
|
|
if codewordArray[i][1] >= entries2Of13 + entries5Of13 then
|
|
Exit;
|
|
ad[i][0] := 8192;
|
|
if codewordArray[i][1] >= entries2Of13 Then
|
|
ad[i][1] := table2Of13[codewordArray[i][1] - entries2Of13]
|
|
else
|
|
ad[i][1] := table5Of13[codewordArray[i][1]];
|
|
end;
|
|
for i := 0 to 9 do
|
|
if fcs and (1 shl i) <> 0 then
|
|
ad[i][1] := not LongInt(ad[i][1]) and 8191;
|
|
for i := 0 to 64 do
|
|
begin
|
|
ai[i] := (LongInt(ad[barTopCharIndexArray[i]][1]) shr barTopCharShiftArray[i]) and 1;
|
|
ai1[i] := (LongInt(ad[barBottomCharIndexArray[i]][1]) shr barBottomCharShiftArray[i]) and 1;
|
|
end;
|
|
encoded := ''; // T: track, D: descender, A: ascender, F: full bar
|
|
for i := 0 to 64 do
|
|
if (ai[i] = 0) and (ai1[i] = 0) then
|
|
encoded := encoded + 'T'
|
|
else if (ai[i] = 0) and (ai1[i] <> 0) then
|
|
encoded := encoded + 'D'
|
|
else if (ai[i] <> 0) and (ai1[i] = 0) then
|
|
encoded := encoded + 'A'
|
|
else if (ai[i] <> 0) and (ai1[i] <> 0) then
|
|
encoded := encoded + 'F';
|
|
Result := encoded;
|
|
end;
|
|
|
|
constructor TOneCode.Create;
|
|
begin
|
|
table2Of13 := OneCodeInfo(1);
|
|
table5Of13 := OneCodeInfo(2);
|
|
end;
|
|
|
|
function TOneCode.OneCodeInfo(topic: LongInt): TLongIntArray;
|
|
var
|
|
a: TLongIntArray;
|
|
begin
|
|
case topic of
|
|
1:
|
|
begin
|
|
SetLength(a, table2Of13Size + 1);
|
|
OneCodeInitializeNof13Table(a, 2, table2Of13Size);
|
|
entries5Of13 := table2Of13Size;
|
|
end;
|
|
2:
|
|
begin
|
|
SetLength(a, table5Of13Size + 1);
|
|
OneCodeInitializeNof13Table(a, 5, table5Of13Size);
|
|
entries2Of13 := table5Of13Size;
|
|
end;
|
|
end;
|
|
Result := a;
|
|
end;
|
|
|
|
function TOneCode.OneCodeInitializeNof13Table(ai: TLongIntArray; i,
|
|
j: LongInt): Boolean;
|
|
var
|
|
i1, j1, k1, l1, l: LongInt;
|
|
k: SmallInt;
|
|
flag: Boolean;
|
|
begin
|
|
i1 := 0;
|
|
j1 := j - 1;
|
|
for k := 0 to 8191 do
|
|
begin
|
|
k1 := 0;
|
|
for l1 := 0 to 12 do
|
|
if k and (1 shl l1) <> 0 then
|
|
k1 := k1 + 1;
|
|
if k1 = i Then
|
|
begin
|
|
l := OneCodeMathReverse(k) shr 3;
|
|
flag := k = l;
|
|
if l >= k then
|
|
if flag then
|
|
begin
|
|
ai[j1] := k;
|
|
j1 := j1 - 1;
|
|
end
|
|
else
|
|
begin
|
|
ai[i1] := k;
|
|
i1 := i1 + 1;
|
|
ai[i1] := l;
|
|
i1 := i1 + 1;
|
|
end;
|
|
end;
|
|
end;
|
|
Result := i1 = j1 + 1;
|
|
end;
|
|
|
|
function TOneCode.OneCodeMathAdd(bytearray: TLongIntArray; i,
|
|
j: LongInt): Boolean;
|
|
var
|
|
x, l, k: LongInt;
|
|
begin
|
|
Result := (bytearray <> nil) and (i >= 1);
|
|
if not Result then
|
|
Exit;
|
|
x := (bytearray[i - 1] or (bytearray[i - 2] shl 8)) + j;
|
|
l := x or 65535;
|
|
k := i - 3;
|
|
bytearray[i - 1] := x and 255;
|
|
bytearray[i - 2] := (x shr 8) and 255;
|
|
while (l = 1) and (k > 0) do
|
|
begin
|
|
x := l + bytearray[k];
|
|
bytearray[k] := x and 255;
|
|
l := x or 255;
|
|
k := k - 1;
|
|
end;
|
|
end;
|
|
|
|
function TOneCode.OneCodeMathDivide(v: AnsiString): Boolean;
|
|
var
|
|
j, k, divider, divident, l: LongInt;
|
|
i: SmallInt;
|
|
n, r, copy, left: AnsiString;
|
|
begin
|
|
j := 10;
|
|
n := v;
|
|
for k := j - 1 downto 1 do
|
|
begin
|
|
r := '';
|
|
divider := codewordArray[k][0];
|
|
copy := n;
|
|
left := '0';
|
|
l := Length(copy);
|
|
i := 1;
|
|
while i <= l do
|
|
begin
|
|
divident := AnsiToInt(Substring(copy, 0, i));
|
|
while (divident < divider) and (i < l - 1) do
|
|
begin
|
|
r := r + '0';
|
|
i := i + 1;
|
|
divident := AnsiToInt(Substring(copy, 0, i));
|
|
end;
|
|
r := r + AnsiString(IntToStr(divident div divider));
|
|
left := PadLeft(AnsiString(IntToStr(divident mod divider)), i, '0');
|
|
copy := left + Substring(copy, i);
|
|
|
|
Inc(i);
|
|
end;
|
|
n := TrimStart(r, '0');
|
|
if n = '' then
|
|
n := '0';
|
|
codewordArray[k][1] := StrToInt(String(left));
|
|
if k = 1 then
|
|
codewordArray[0][1] := StrToInt(String(r));
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
function TOneCode.OneCodeMathFcs(bytearray: TLongIntArray): LongInt;
|
|
var
|
|
c, i, j, l, k: LongInt;
|
|
b: SmallInt;
|
|
begin
|
|
c := 3893;
|
|
i := 2047;
|
|
j := bytearray[0] shl 5;
|
|
for b := 2 to 7 do
|
|
begin
|
|
if (i xor j) and 1024 <> 0 then i := i shl 1 xor c
|
|
else i := i shl 1;
|
|
i := i and 2047;
|
|
j := j shl 1;
|
|
end;
|
|
for l := 1 to 12 do
|
|
begin
|
|
k := bytearray[l] shl 3;
|
|
for b := 0 to 7 do
|
|
begin
|
|
if (i xor k) and 1024 <> 0 then i := i shl 1 xor c
|
|
else i := i shl 1;
|
|
i := i and 2047;
|
|
k := k shl 1;
|
|
end;
|
|
end;
|
|
Result := i;
|
|
end;
|
|
|
|
function TOneCode.OneCodeMathMultiply(bytearray: TLongIntArray; i,
|
|
j: LongInt): Boolean;
|
|
var
|
|
x, l, k: LongInt;
|
|
begin
|
|
Result := (bytearray <> nil) and (i >= 1);
|
|
if not Result then
|
|
Exit;
|
|
l := 0;
|
|
k := i - 1;
|
|
while k >=1 do
|
|
begin
|
|
x := (bytearray[k] or (bytearray[k - 1] shl 8)) * j + l;
|
|
bytearray[k] := x and 255;
|
|
bytearray[k - 1] := (x shr 8) and 255;
|
|
l := x shr 16;
|
|
k := k - 2;
|
|
end;
|
|
if k = 0 then
|
|
bytearray[0] := (bytearray[0] * j + l) and 255;
|
|
end;
|
|
|
|
function TOneCode.OneCodeMathReverse(i: LongInt): LongInt;
|
|
var
|
|
j: LongInt;
|
|
k: SmallInt;
|
|
begin
|
|
j := 0;
|
|
for k := 0 to 15 do
|
|
begin
|
|
j := j shl 1;
|
|
j := j or i and 1;
|
|
i := i shr 1;
|
|
end;
|
|
Result := j;
|
|
end;
|
|
|
|
function TOneCode.PadLeft(str: AnsiString; TotalWidth: Integer;
|
|
PaddingChar: AnsiChar): AnsiString;
|
|
begin
|
|
Result := str;
|
|
while Length(Result) < TotalWidth do
|
|
Result := PaddingChar + Result;
|
|
end;
|
|
|
|
function TOneCode.Substring(str: AnsiString; startIndex: Integer;
|
|
len: Integer = -1): AnsiString;
|
|
begin
|
|
if len = -1 then
|
|
len := Length(str);
|
|
Result := Copy(str, startIndex + 1, len); // i + 1: delphi string is 1-based
|
|
end;
|
|
|
|
function TOneCode.TrimOff(source, bad: AnsiString): AnsiString;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := source;
|
|
for i := Length(Result) downto 1 do
|
|
if Pos(Result[i], bad) <> 0 then
|
|
Delete(Result, i, 1);
|
|
end;
|
|
|
|
function TOneCode.TrimStart(str: AnsiString; TrimChar: AnsiChar): AnsiString;
|
|
begin
|
|
Result := str;
|
|
while (Result <> '') and (Result[1] = TrimChar) do
|
|
Delete(Result, 1, 1);
|
|
end;
|
|
|
|
end.
|