RSS订阅 | 匿名投稿
您的位置:网站首页 > 图像 > 正文

delphi 使用ECC200绘制二维码

作者:admin 来源: 日期:2011/8/11 13:28:56 人气: 标签:

 函数的具体实现如下:

procedure Generate2DCode(AStr: string; ASize: Integer; ABmp: TBitmap);
var
s : TByteArray;
m : TByteArray;
i, j: Integer;
w, h : integer;
cc: Integer;
begin
if not Assigned(ABmp) then
Exit;
SetLength(s, Length(AStr));
for i := 1 to Length(AStr) do
begin
s[i-1] := Ord(AStr[i]);
end;
  // 此函数来自ECC200.pas
CalcECC200(s, ecc200_Autosize, ecc200_Square, m, w, h); 
ABmp.Width := w * ASize;
ABmp.Height := h * ASize;
for i := 0 to h - 1 do
begin
for j := 0 to w - 1 do
begin
cc := m[i * w + j];
if cc = 1 then
begin
ABmp.Canvas.Brush.Color := clBlack;
ABmp.Canvas.Rectangle(Rect(
j*ASize,
i*ASize,
j*ASize+ASize,
i*ASize+ASize));
end;
end;
end;
end;

调用时使用:
var
bmp: TBitmap;
begin
bmp:=TBitmap.Create;
  // 第二个参数表示每个小格的边长
Generate2DCode('1234567890', 2, bmp);
  // TODO: your code here
bmp.Free;
end;

 

 



实现效果如下:

 


unit ECC200;

interface
uses DateUtils;

type

TByteArray = array of byte;

TECC200Size = (
ecc200_Autosize,
ecc200_10x10,
ecc200_12x12,
ecc200_14x14,
ecc200_16x16,
ecc200_18x18,
ecc200_20x20,
ecc200_22x22,
ecc200_24x24,
ecc200_26x26,
ecc200_32x32,
ecc200_36x36,
ecc200_40x40,
ecc200_44x44,
ecc200_48x48,
ecc200_52x52,
ecc200_64x64,
ecc200_72x72,
ecc200_80x80,
ecc200_88x88,
ecc200_96x96,
ecc200_104x104,
ecc200_120x120,
ecc200_132x132,
ecc200_144x144,
ecc200_8x18,
ecc200_8x32,
ecc200_12x26,
ecc200_12x36,
ecc200_16x36,
ecc200_16x48);

TECC200Shape = (ecc200_Square, ecc200_Rectangle);

TECC200SymbolParam = record
Size : TECC200Size;
Rows,
Cols,
RegionRows,
RegionCols,
RegionVCount,
RegionHCount,
MappingMatrixRows,
MappingMatrixCols,
DataLength,
ErrorLength,
BlockDataLength,
BlockErrorLength,
BlockCount: Integer;
end;

var
ECC200SymbolParams : array [TECC200Size] of TECC200SymbolParam = (
(
Size : ecc200_Autosize;
Rows : 0;
Cols : 0;
RegionRows : 0;
RegionCols : 0;
RegionVCount : 0;
RegionHCount : 0;
MappingMatrixRows : 0;
MappingMatrixCols : 0;
DataLength : 0;
ErrorLength : 0;
BlockDataLength : 0;
BlockErrorLength : 0;
BlockCount : 0;
),
(
Size : ecc200_10x10;
Rows : 10;
Cols : 10;
RegionRows : 8;
RegionCols : 8;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 8;
MappingMatrixCols : 8;
DataLength : 3;
ErrorLength : 5;
BlockDataLength : 3;
BlockErrorLength : 5;
BlockCount : 1;
),
(
Size : ecc200_12x12;
Rows : 12;
Cols : 12;
RegionRows : 10;
RegionCols : 10;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 10;
MappingMatrixCols : 10;
DataLength : 5;
ErrorLength : 7;
BlockDataLength : 5;
BlockErrorLength : 7;
BlockCount : 1;
),
(
Size : ecc200_14x14;
Rows : 14;
Cols : 14;
RegionRows : 12;
RegionCols : 12;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 12;
MappingMatrixCols : 12;
DataLength : 8;
ErrorLength : 10;
BlockDataLength : 8;
BlockErrorLength : 10;
BlockCount : 1;
),
(
Size : ecc200_16x16;
Rows : 16;
Cols : 16;
RegionRows : 14;
RegionCols : 14;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 14;
MappingMatrixCols : 14;
DataLength : 12;
ErrorLength : 12;
BlockDataLength : 12;
BlockErrorLength : 12;
BlockCount : 1;
),
(
Size : ecc200_18x18;
Rows : 18;
Cols : 18;
RegionRows : 16;
RegionCols : 16;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 16;
MappingMatrixCols : 16;
DataLength : 18;
ErrorLength : 14;
BlockDataLength : 18;
BlockErrorLength : 14;
BlockCount : 1;
),
(
Size : ecc200_20x20;
Rows : 20;
Cols : 20;
RegionRows : 18;
RegionCols : 18;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 18;
MappingMatrixCols : 18;
DataLength : 22;
ErrorLength : 18;
BlockDataLength : 22;
BlockErrorLength : 18;
BlockCount : 1;
),
(
Size : ecc200_22x22;
Rows : 22;
Cols : 22;
RegionRows : 20;
RegionCols : 20;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 20;
MappingMatrixCols : 20;
DataLength : 30;
ErrorLength : 20;
BlockDataLength : 30;
BlockErrorLength : 20;
BlockCount : 1;
),
(
Size : ecc200_24x24;
Rows : 24;
Cols : 24;
RegionRows : 22;
RegionCols : 22;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 22;
MappingMatrixCols : 22;
DataLength : 36;
ErrorLength : 24;
BlockDataLength : 36;
BlockErrorLength : 24;
BlockCount : 1;
),
(
Size : ecc200_26x26;
Rows : 26;
Cols : 26;
RegionRows : 24;
RegionCols : 24;
RegionVCount : 1;
RegionHCount : 1;
MappingMatrixRows : 24;
MappingMatrixCols : 24;
DataLength : 44;
ErrorLength : 28;
BlockDataLength : 44;
BlockErrorLength : 28;
BlockCount : 1;
),
(
Size : ecc200_32x32;
Rows : 32;
Cols : 32;
RegionRows : 14;
RegionCols : 14;
RegionVCount : 2;
RegionHCount : 2;
MappingMatrixRows : 28;
MappingMatrixCols : 28;
DataLength : 62;
ErrorLength : 36;
BlockDataLength : 62;
BlockErrorLength : 36;
BlockCount : 1;
),
(
Size : ecc200_36x36;
Rows : 36;
Cols : 36;
RegionRows : 16;
RegionCols : 16;
RegionVCount : 2;
RegionHCount : 2;
MappingMatrixRows : 32;
MappingMatrixCols : 32;
DataLength : 86;
ErrorLength : 42;
BlockDataLength : 86;
BlockErrorLength : 42;
BlockCount : 1;
),
(
Size : ecc200_40x40;
Rows : 40;
Cols : 40;
RegionRows : 18;
RegionCols : 18;
RegionVCount : 2;
RegionHCount : 2;
MappingMatrixRows : 36;
MappingMatrixCols : 36;
DataLength : 114;
ErrorLength : 48;
BlockDataLength : 114;
BlockErrorLength : 48;
BlockCount : 1;
),
(
Size : ecc200_44x44;
Rows : 44;
Cols : 44;
RegionRows : 20;
RegionCols : 20;
RegionVCount : 2;
RegionHCount : 2;
MappingMatrixRows : 40;
MappingMatrixCols : 40;
DataLength : 144;
ErrorLength : 56;
BlockDataLength : 144;
BlockErrorLength : 56;
BlockCount : 1;
),
(
Size : ecc200_48x48;
Rows : 48;
Cols : 48;
RegionRows : 22;
RegionCols : 22;
RegionVCount : 2;
RegionHCount : 2;
MappingMatrixRows : 44;
MappingMatrixCols : 44;
DataLength : 174;
ErrorLength : 68;
BlockDataLength : 174;
BlockErrorLength : 68;
BlockCount : 1;
),
(
Size : ecc200_52x52;
Rows : 52;
Cols : 52;
RegionRows : 24;
RegionCols : 24;
RegionVCount : 2;
RegionHCount : 2;
MappingMatrixRows : 48;
MappingMatrixCols : 48;
DataLength : 204;
ErrorLength : 84;
BlockDataLength : 102;
BlockErrorLength : 42;
BlockCount : 2;
),
(
Size : ecc200_64x64;
Rows : 64;
Cols : 64;
RegionRows : 14;
RegionCols : 14;
RegionVCount : 4;
RegionHCount : 4;
MappingMatrixRows : 56;
MappingMatrixCols : 56;
DataLength : 280;
ErrorLength : 112;
BlockDataLength : 140;
BlockErrorLength : 56;
BlockCount : 2;
),
(
Size : ecc200_72x72;
Rows : 72;
Cols : 72;
RegionRows : 16;
RegionCols : 16;
RegionVCount : 4;
RegionHCount : 4;
MappingMatrixRows : 64;
MappingMatrixCols : 64;
DataLength : 368;
ErrorLength : 144;
BlockDataLength : 92;
BlockErrorLength : 36;
BlockCount : 4;
),
(
Size : ecc200_80x80;
Rows : 80;
Cols : 80;
RegionRows : 18;
RegionCols : 18;
RegionVCount : 4;
RegionHCount : 4;
MappingMatrixRows : 72;
MappingMatrixCols : 72;
DataLength : 456;
ErrorLength : 192;
BlockDataLength : 114;
BlockErrorLength : 48;
BlockCount : 4;
),
(
Size : ecc200_88x88;
Rows : 88;
Cols : 88;
RegionRows : 20;
RegionCols : 20;
RegionVCount : 4;
RegionHCount : 4;
MappingMatrixRows : 80;
MappingMatrixCols : 80;
DataLength : 576;
ErrorLength : 224;
BlockDataLength : 144;
BlockErrorLength : 56;
BlockCount : 4;
),
(
Size : ecc200_96x96;
Rows : 96;
Cols : 96;
RegionRows : 22;
RegionCols : 22;
RegionVCount : 4;
RegionHCount : 4;
MappingMatrixRows : 88;
MappingMatrixCols : 88;
DataLength : 696;
ErrorLength : 272;
BlockDataLength : 174;
BlockErrorLength : 68;
BlockCount : 4;
),
(
Size : ecc200_104x104;
Rows : 104;
Cols : 104;
RegionRows : 24;
RegionCols : 24;
RegionVCount : 4;
RegionHCount : 4;
MappingMatrixRows : 96;
MappingMatrixCols : 96;
DataLength : 816;
ErrorLength : 336;
BlockDataLength : 136;
BlockErrorLength : 56;
BlockCount : 6;
),
(
Size : ecc200_120x120;
Rows : 120;
Cols : 120;
RegionRows : 18;
RegionCols : 18;
RegionVCount : 6;
RegionHCount : 6;
MappingMatrixRows : 108;
MappingMatrixCols : 108;
DataLength : 1050;
ErrorLength : 408;
BlockDataLength : 175;
BlockErrorLength : 68;
BlockCount : 6;
),
(
Size : ecc200_132x132;
Rows : 132;
Cols : 132;
RegionRows : 20;
RegionCols : 20;
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
for s := ecc200_8x18 to ecc200_16x48 do
begin
if ECC200SymbolParams[s].DataLength = CurPos then
begin
Result := True;
Break;
end;
if ECC200SymbolParams[s].DataLength > CurPos then Break;
end;
end;
end;

function NearestSize(Shape : TEcc200Shape; CurPos: Integer): Integer;
var
s : TECC200Size;
outlen: Integer;
begin
if Shape = ecc200_Square then
begin
for s := ecc200_10x10 to ecc200_144x144 do
begin
outlen := ECC200SymbolParams[s].DataLength;
if outlen > CurPos then
begin
Result := outlen;
break;
end;
end;
end
else
begin
for s := ecc200_8x18 to ecc200_16x48 do
begin
outlen := ECC200SymbolParams[s].DataLength;
if outlen > CurPos then
begin
Result := outlen;
break;
end;
end;
end;
if outlen < CurPos then raise Exception.Create('数据超出二维码容量!');
end;

procedure TriByteEncode(InByte1, InByte2, InByte3: Byte; var OutByte1, OutByte2: Byte);
var
w: Word;
begin
w := 1600 * InByte1 + 40 * InByte2 + InByte3 + 1;
OutByte1 := w div 256;
OutByte2 := w mod 256;
end;

function C40Value(ASCII: Byte) : Byte;
begin
case ASCII of
32: Result := 3;
48..57: Result := ASCII - 48 + 4;
65..90: Result := ASCII - 65 + 14;
00..31: Result := ASCII;
33..47: Result := ASCII - 33;
58..64: Result := ASCII - 58 + 15;
91..95: Result := ASCII - 91 + 22;
96..127: Result := ASCII - 96;
else raise Exception.Create('C40编码算法错误,请通知开发人员! 错误信息:ASCII码大于127');
end;
end;

function NextAreTwoDigit(var Source: TByteArray; SourceIndex: Integer): Boolean;
begin
Result := False;
if SourceIndex >= Length(Source) - 1 then Exit;
Result := (Source[SourceIndex] in [48..57])
and (Source[SourceIndex + 1] in [48..57]);
end;

procedure ASCII_EncodeDoubleDigit(
var Source: TByteArray;
var SourceIndex: Integer;
var Buffer: TByteArray;
var BufferIndex: Integer);
begin
Buffer[BufferIndex] :=
((Source[SourceIndex] - 48) * 10 + Source[SourceIndex + 1] - 48) + 130;
Inc(SourceIndex, 2);
Inc(BufferIndex);
end;

procedure SwitchModeTo(
var Buffer: TByteArray;
var BufferIndex: Integer;
ToMode: TEncodeMode);
begin
case ToMode of
emC40:
begin
Buffer[BufferIndex] := 230; Inc(BufferIndex);
end;

emText:
begin
Buffer[BufferIndex] := 239; Inc(BufferIndex);
end;

emX12:
begin
Buffer[BufferIndex] := 238; Inc(BufferIndex);
end;

emEDIFACT:
begin
Buffer[BufferIndex] := 240; Inc(BufferIndex);
end;

emBase256:
begin
Buffer[BufferIndex] := 231; Inc(BufferIndex);
end;
end;
end;

procedure SwitchTriByteBack(var Buffer: TByteArray; var BufferIndex: Integer);
begin
Buffer[BufferIndex] := 254; Inc(BufferIndex);
end;

procedure SwitchMode(
var Source: TByteArray;
var SourceIndex: Integer;
var Buffer: TByteArray;
var BufferIndex: Integer;
FromMode, ToMode: TEncodeMode);
begin
case FromMode of
emASCII:
begin
SwitchModeTo(Buffer, BufferIndex, ToMode);
end;

emC40:
begin
SwitchTriByteBack(Buffer, BufferIndex);
SwitchModeTo(Buffer, BufferIndex, ToMode);
end;

emText:
begin
SwitchTriByteBack(Buffer, BufferIndex);
SwitchModeTo(Buffer, BufferIndex, ToMode);
end;

emX12:
begin
SwitchTriByteBack(Buffer, BufferIndex);
SwitchModeTo(Buffer, BufferIndex, ToMode);
end;
end;
end;

function NextIsExtendASCII(var Source: TByteArray; SourceIndex: Integer): Boolean;
begin
Result := (Source[SourceIndex] > 127);
end;

procedure ASCII_EncodeExtendData(
var Source: TByteArray;
var SourceIndex: Integer;
var Buffer: TByteArray;
var BufferIndex: Integer);
begin
Buffer[BufferIndex] := 235;
Inc(BufferIndex);
Buffer[BufferIndex] := Source[SourceIndex] - 128 + 1;
Inc(BufferIndex);
Inc(sourceIndex);
end;

procedure ASCII_EncodeData(
var Source: TByteArray;
var SourceIndex: Integer;
var Buffer: TByteArray;
var BufferIndex: Integer);
begin
Buffer[BufferIndex] := Source[SourceIndex] + 1;
Inc(BufferIndex);
Inc(SourceIndex);
end;

function ASCII_Encode(
Shape: TECC200Shape;
EncodeMode: TEncodeMode;
var Source: TByteArray;
var SourceIndex: Integer;
var Buffer: TByteArray;
var BufferIndex: Integer): TEncodeMode;
begin
Result := EncodeMode;
while SourceIndex < Length(Source) do
begin
if NextAreTwoDigit(Source, SourceIndex) then
begin
ASCII_EncodeDoubleDigit(Source, SourceIndex, Buffer, BufferIndex);
Continue;
end;
Result := LookAhead(Source, SourceIndex, EncodeMode);
//
if Result <> emBase256 then Result := emASCII;
//
if Result <> emASCII then
begin
SwitchMode(Source, SourceIndex, Buffer, BufferIndex, EncodeMode, Result);
Exit;
end;
if NextIsExtendASCII(Source, SourceIndex) then
begin
ASCII_EncodeExtendData(Source, SourceIndex, Buffer, BufferIndex);
Continue;
end;
ASCII_EncodeData(Source, SourceIndex, Buffer, BufferIndex);
end;
end;






function C40_EncodeFromReady(
var Source: TByteArray;
var SourceIndex: Integer;
var Buffer: TByteArray;
var BufferIndex: Integer;
var Byte1, Byte2, Byte3: Byte): TTriByteState;
begin
if Source[SourceIndex] in C40BasicSet then
begin
Byte1 := C40Value(Source[SourceIndex]);
Inc(SourceIndex);
Result := tsByte1;
end
else if Source[SourceIndex] in C40Shift1Set then
begin
Byte1 := 0;
Byte2 := C40Value(Source[SourceIndex]);
Inc(SourceIndex);
Result := tsByte2;
end
else if Source[SourceIndex] in C40Shift2Set then
begin
Byte1 := 1;
Byte2 := C40Value(Source[SourceIndex]);
Inc(SourceIndex);
Result := tsByte2;
end
else if Source[SourceIndex] in C40Shift3Set then
begin
Byte1 := 2;
Byte2 := C40Value(Source[SourceIndex]);
Inc(SourceIndex);
Result := tsByte2;
end
else if Source[SourceIndex] > 127 then
begin
if (Source[SourceIndex] - 128) in C40BasicSet then
begin
Byte1 := 1;
Byte2 := 30;
Byte3 := C40Value(Source[SourceIndex]);
TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);
Inc(BufferIndex, 2);
Result := tsReady;
end