ecc200.~pas

delphi实现的二 维 码 生成 控制代 码

      RegionVCount :      6;
      RegionHCount :      6;
      MappingMatrixRows :  120;
      MappingMatrixCols :  120;
      DataLength :        1304;
      ErrorLength :       496;
      BlockDataLength :   163;
      BlockErrorLength :  62;
      BlockCount :        8;
    ),
    (
      Size :              ecc200_144x144;
      Rows :              144;
      Cols :              144;
      RegionRows :        22;
      RegionCols :        22;
      RegionVCount :      6;
      RegionHCount :      6;
      MappingMatrixRows :  132;
      MappingMatrixCols :  132;
      DataLength :        1558;
      ErrorLength :       620;
      BlockDataLength :   156;
      BlockErrorLength :  62;
      BlockCount :        10;
    ),
    (
      Size :              ecc200_8x18;
      Rows :              8;
      Cols :              18;
      RegionRows :        6;
      RegionCols :        16;
      RegionVCount :      1;
      RegionHCount :      1;
      MappingMatrixRows :  6;
      MappingMatrixCols :  16;
      DataLength :        5;
      ErrorLength :       7;
      BlockDataLength :   5;
      BlockErrorLength :  7;
      BlockCount :        1;
    ),
    (
      Size :              ecc200_8x32;
      Rows :              8;
      Cols :              32;
      RegionRows :        6;
      RegionCols :        14;
      RegionVCount :      1;
      RegionHCount :      2;
      MappingMatrixRows :  6;
      MappingMatrixCols :  28;
      DataLength :        10;
      ErrorLength :       11;
      BlockDataLength :   10;
      BlockErrorLength :  11;
      BlockCount :        1;
    ),
    (
      Size :              ecc200_12x26;
      Rows :              12;
      Cols :              26;
      RegionRows :        10;
      RegionCols :        24;
      RegionVCount :      1;
      RegionHCount :      1;
      MappingMatrixRows :  10;
      MappingMatrixCols :  24;
      DataLength :        16;
      ErrorLength :       14;
      BlockDataLength :   16;
      BlockErrorLength :  14;
      BlockCount :        1;
    ),
    (
      Size :              ecc200_12x36;
      Rows :              12;
      Cols :              36;
      RegionRows :        10;
      RegionCols :        16;
      RegionVCount :      1;
      RegionHCount :      2;
      MappingMatrixRows :  10;
      MappingMatrixCols :  32;
      DataLength :        22;
      ErrorLength :       18;
      BlockDataLength :   22;
      BlockErrorLength :  18;
      BlockCount :        1;
    ),
    (
      Size :              ecc200_16x36;
      Rows :              16;
      Cols :              36;
      RegionRows :        14;
      RegionCols :        16;
      RegionVCount :      1;
      RegionHCount :      2;
      MappingMatrixRows :  14;
      MappingMatrixCols :  32;
      DataLength :        32;
      ErrorLength :       24;
      BlockDataLength :   32;
      BlockErrorLength :  24;
      BlockCount :        1;
    ),
    (
      Size :              ecc200_16x48;
      Rows :              16;
      Cols :              48;
      RegionRows :        14;
      RegionCols :        22;
      RegionVCount :      1;
      RegionHCount :      2;
      MappingMatrixRows :  14;
      MappingMatrixCols :  44;
      DataLength :        49;
      ErrorLength :       28;
      BlockDataLength :   49;
      BlockErrorLength :  28;
      BlockCount :        1;
    )
  );

procedure CalcECC200(Source : TByteArray; Size : TECC200Size;
  Shape : TECC200Shape;
  var DataMatrix : TByteArray;
  var MatrixWidth, MatrixHeight : integer);

implementation

uses SysUtils, ReedSolomon, Forms;

const
  Ploy5 : array [0..5] of byte = (228, 48, 15, 111, 62, 1);
  Ploy7 : array [0..7] of byte = (23, 68, 144, 134, 240, 92, 254, 1);
  Ploy10 : array [0..10] of byte = (28, 24, 185, 166, 223, 248, 116, 255, 110,
    61, 1);
  Ploy11 : array [0..11] of byte = (175, 138, 205, 12, 194, 168, 39, 245, 60,
    97, 120, 1);
  Ploy12 : array [0..12] of byte = (41, 153, 158, 91, 61, 42, 142, 213, 97, 178,
    100, 242, 1);
  Ploy14 : array [0..14] of byte = (156, 97, 192, 252, 95, 9, 157, 119, 138, 45,
    18, 186, 83, 185, 1);
  Ploy18 : array [0..18] of byte = (83, 195, 100, 39, 188, 75, 66, 61, 241, 213,
    109, 129, 94, 254, 225, 48, 90, 188, 1);
  Ploy20 : array [0..20] of byte = (15, 195, 244, 9, 233, 71, 168, 2, 188, 160,
    153, 145, 253, 79, 108, 82, 27, 174, 186, 172, 1);
  Ploy24 : array [0..24] of byte = (52, 190, 88, 205, 109, 39, 176, 21, 155,
    197, 251, 223, 155, 21, 5, 172, 254, 124, 12, 181, 184, 96, 50, 193, 1);
  Ploy28 : array [0..28] of byte = (211, 231, 43, 97, 71, 96, 103, 174, 37, 151,
    170, 53, 75, 34, 249, 121, 17, 138, 110, 213, 141, 136, 120, 151, 233, 168,
    93, 255, 1);
  Ploy36 : array [0..36] of byte = (245, 127, 242, 218, 130, 250, 162, 181, 102,
    120, 84, 179, 220, 251, 80, 182, 229, 18, 2, 4, 68, 33, 101, 137, 95, 119,
    115, 44, 175, 184, 59, 25, 225, 98, 81, 112, 1);
  Ploy42 : array [0..42] of byte = (77, 193, 137, 31, 19, 38, 22, 153, 247, 105,
    122, 2, 245, 133, 242, 8, 175, 95, 100, 9, 167, 105, 214, 111, 57, 121, 21,
    1, 253, 57, 54, 101, 248, 202, 69, 50, 150, 177, 226, 5, 9, 5, 1);
  Ploy48 : array [0..48] of byte = (245, 132, 172, 223, 96, 32, 117, 22, 238,
    133, 238, 231, 205, 188, 237, 87, 191, 106, 16, 147, 118, 23, 37, 90, 170,
    205, 131, 88, 120, 100, 66, 138, 186, 240, 82, 44, 176, 87, 187, 147, 160,
    175, 69, 213, 92, 253, 225, 19, 1);
  Ploy56 : array [0..56] of byte = (175, 9, 223, 238, 12, 17, 220, 208, 100, 29,
    175, 170, 230, 192, 215, 235, 150, 159, 36, 223, 38, 200, 132, 54, 228, 146,
    218, 234, 117, 203, 29, 232, 144, 238, 22, 150, 201, 117, 62, 207, 164, 13,
    137, 245, 127, 67, 247, 28, 155, 43, 203, 107, 233, 53, 143, 46, 1);
  Ploy62 : array [0..62] of byte = (242, 93, 169, 50, 144, 210, 39, 118, 202,
    188, 201, 189, 143, 108, 196, 37, 185, 112, 134, 230, 245, 63, 197, 190,
    250, 106, 185, 221, 175, 64, 114, 71, 161, 44, 147, 6, 27, 218, 51, 63, 87,
    10, 40, 130, 188, 17, 163, 31, 176, 170, 4, 107, 232, 7, 94, 166, 224, 124,
    86, 47, 11, 204, 1);
  Ploy68 : array [0..68] of byte = (220, 228, 173, 89, 251, 149, 159, 56, 89,
    33, 147, 244, 154, 36, 73, 127, 213, 136, 248, 180, 234, 197, 158, 177, 68,
    122, 93, 213, 15, 160, 227, 236, 66, 139, 153, 185, 202, 167, 179, 25, 220,
    232, 96, 210, 231, 136, 223, 239, 181, 241, 59, 52, 172, 25, 49, 232, 211,
    189, 64, 54, 108, 153, 132, 63, 96, 103, 82, 186, 1);

  C40BasicSet = [32, 48..57, 65..90];
  C40Shift1Set = [0..31];
  C40Shift2Set = [33..47, 58..64, 91..95];
  C40Shift3Set = [96..127];

  TextBasicSet = [32, 48..57, 97..122];
  TextShift1Set = [0..31];
  TextShift2Set = [33..47, 58..64, 91..95];
  TextShift3Set = [96, 65..90, 123..127];

  X12Set = [13, 42, 62, 32, 48..57, 65..90];

  EDIFACTSet = [32..94];

type
  TEncodeMode = (emASCII, emC40, emText, emX12, emEDIFACT, emBase256);
  TTriByteState = (tsReady, tsByte1, tsByte2); //用于C40, Text, X12编码时记录算法的状态

function Random253(Pad_codeword_value: Byte; Pad_codeword_position: Integer): Byte;
var
  pseudo_random_number, temp_variable :Integer;
begin
  pseudo_random_number := ((149 * Pad_codeword_position) mod 253) + 1;
  temp_variable := Pad_codeword_value + pseudo_random_number;
  if temp_variable <= 254 then
    Result := temp_variable
  else
    Result := temp_variable - 254;
end;

function Random255(Base256_codeword_value: Byte; Base256_codeword_position: Integer): Byte;
var
  pseudo_random_number, temp_variable: Integer;
begin
  pseudo_random_number := ((149 * Base256_codeword_position) mod 255) + 1;
  temp_variable := Base256_codeword_value + pseudo_random_number;
  if temp_variable <= 255 then
    Result := temp_variable
  else
    Result := temp_variable - 256;
end;

function LookAhead(var Source : TByteArray; FromPos : integer; CurEncodeMode : TEncodeMode): TEncodeMode;
var
  ASCIICount,
  C40Count,
  TextCount,
  X12Count,
  EDFCount,
  B256Count : single;
  b : byte;
  ToPos: Integer;

label J, K, L, M, N, O, P, Q, R, S;
begin
  ToPos := FromPos;
J:
  if CurEncodeMode = emASCII then
  begin
    ASCIICount := 0;
    C40Count := 1;
    TextCount := 1;
    X12Count := 1;
    EDFCount := 1;
    B256Count := 1.25;
  end
  else
  begin
    ASCIICount := 1;
    C40Count := 2;
    TextCount := 2;
    X12Count := 2;
    EDFCount := 2;
    B256Count := 2.25;
  end;
  case CurEncodeMode of
    emC40     : C40Count := 0;
    emText    : TextCount := 0;
    emX12     : X12Count := 0;
    emEDIFACT : EDFCount := 0;
    emBase256 : B256Count := 0;
  end;
  ToPos := FromPos;
K:
  if ToPos > High(Source) then
  begin
    ASCIICount := Trunc(ASCIICount + 0.9999999);
    C40Count := Trunc(C40Count + 0.9999999);
    TextCount := Trunc(TextCount + 0.9999999);
    X12Count := Trunc(X12Count + 0.9999999);
    EDFCount := Trunc(EDFCount + 0.9999999);
    B256Count := Trunc(B256Count + 0.9999999);

    if (ASCIICount <= C40Count)
      and (ASCIICount <= TextCount)
      and (ASCIICount <= X12Count)
      and (ASCIICount <= EDFCount)
      and (ASCIICount <= B256Count) then
    begin
      Result := emASCII;
      exit;
    end;

    if (B256Count < ASCIICount)
      and (B256Count < C40Count)
      and (B256Count < TextCount)
      and (B256Count < X12Count)
      and (B256Count < EDFCount) then
    begin
      Result := emBase256;
      exit;
    end;

    if (EDFCount < ASCIICount)
      and (EDFCount < C40Count)
      and (EDFCount < TextCount)
      and (EDFCount < X12Count)
      and (EDFCount <B256Count) then
    begin
      Result := emEDIFACT;
      exit;
    end;

    if (TextCount < ASCIICount)
      and (TextCount < C40Count)
      and (TextCount < X12Count)
      and (TextCount < EDFCount)
      and (TextCount < B256Count) then
    begin
      Result := emText;
      exit;
    end;

    if (X12Count < ASCIICount)
      and (X12Count < C40Count)
      and (X12Count < TextCount)
      and (X12Count < EDFCount)
      and (X12Count < B256Count) then
    begin
      Result := emX12;
      exit;
    end;

    Result := emC40;
    exit;
  end;

  b := Source[ToPos];

L:
  if b in [48..57] then ASCIICount := ASCIICount + 1/2
  else if b > 127 then ASCIICount := ASCIICount + 2
  else ASCIICount := ASCIICount + 1;

M:
  if b in C40BasicSet then C40Count := C40Count + 2/3
  else if b > 127 then C40Count := C40Count + 8/3
  else C40Count := C40Count + 4/3;
N:
  if b in TextBasicSet then TextCount := TextCount + 2/3
  else if b > 127 then TextCount := TextCount + 8/3
  else TextCount := TextCount + 4/3;
O:
  if b in X12Set then X12Count := X12Count + 2/3
  else if b > 127 then X12Count := X12Count + 13/3
  else X12Count := X12Count +10/3;
P:
  if b in EDIFACTSet then EDFCount := EDFCount + 3/4
  else if b > 127 then EDFCount := EDFCount + 17/4
  else EDFCount := EDFCount + 13/4;
Q:
  if b > 255 then B256Count := B256Count + 4  
  else B256Count := B256Count + 1;
R:
  if ToPos - FromPos >= 4 then
  begin
    if (ASCIICount + 1 <= C40Count)
      and (ASCIICount + 1 <= TextCount)
      and (ASCIICount + 1 <= X12Count)
      and (ASCIICount + 1 <= EDFCount)
      and (ASCIICount + 1 <= B256Count) then
    begin
      Result := emASCII;
      exit;
    end;

    if (B256Count + 1 <= ASCIICount) or (
      ((B256Count <= C40Count)
      and (B256Count <= TextCount)
      and (B256Count <= X12Count)
      and (B256Count <= EDFCount))) then
    begin
      Result := emBase256;
      exit;
    end;

    if (EDFCount + 1 < ASCIICount)
      and (EDFCount + 1 < C40Count)
      and (EDFCount + 1 < TextCount)
      and (EDFCount + 1 < X12Count)
      and (EDFCount + 1 < B256Count) then
    begin
      Result := emEDIFACT;
      exit;
    end;

    if (TextCount + 1 < ASCIICount)
      and (TextCount + 1 < C40Count)
      and (TextCount + 1 < X12Count)
      and (TextCount + 1 < EDFCount)
      and (TextCount + 1 < B256Count) then
    begin
      Result := emText;
      exit;
    end;

    if (X12Count + 1 < ASCIICount)
      and (X12Count + 1 < C40Count)
      and (X12Count + 1 < TextCount)
      and (X12Count + 1 < EDFCount)
      and (X12Count + 1 < B256Count) then
    begin
      Result := emX12;
      exit;
    end;

    if (C40Count + 1 < ASCIICount)
      and (C40Count + 1 < B256COunt)
      and (C40Count + 1 < EDFCount)
      and (C40Count + 1 < TextCount) then
    begin
      if C40Count < X12Count then
      begin
        Result := emC40;
        exit;
      end;
      if C40Count = X12Count then
      begin
        if (ToPos < High(Source)) and (Source[ToPos] in [13, 42, 62]) then
        begin
          Result := emX12;
          exit;
        end;
      end;
      Result := emC40;
      exit;
    end;
  end;
S:
  Inc(ToPos);
  goto K;
end;

function UpToBound(Shape : TEcc200Shape; CurPos: Integer): Boolean;
var
  s : TECC200Size;
begin
  Result := False;
  if Shape = ecc200_Square then
  begin
    for s := ecc200_10x10 to ecc200_144x144 do
    begin
      if ECC200SymbolParams[s].DataLength = CurPos then
      begin
        Result := True;
        Break;
      end;
      if ECC200SymbolParams[s].DataLength > CurPos then Break;
    end
  end
  else
  begin