Delphi，VC++，VB，C#等实现二维条码绘制

最新推荐文章于 2023-09-01 17:30:59 发布
最新推荐文章于 2023-09-01 17:30:59 发布
阅读量2.2k 收藏 2
点赞数
文章标签： 二维码

Delphi，VC++，VB，C#等实现二维条码绘制  

2011-01-31 16:04:15|  分类： Delphi笔记 |字号 订阅

/*Title:Delphi，VC++，VB，C#等实现二维条码绘制

*Author:Insun

*Blog:http://yxmhero1989.blog.163.com

*From:www.4safer.com

*/

先认识几个基本概念：
PDF417  ----条形码
2D BarCode ---二维码- --  QRCode  ---Quick Response Code 二维空间码
DataMatrix  -- 数据矩阵

 其他参见我的：关于二维码(About 2D Barcode) http://yxmhero1989.blog.163.com/blog/static/11215795620110172842999/

Data　Matrix 二维条码的发展 http://www.systron.com.cn/datamatrix.htm
ECC200原始出处是 DataMatrix，官方网址在http://www.neodynamic.com/barcodes/DataMatrix_Barcode.aspx
先说Delphi实现二维条码绘制，需要用到ECC200.pas和ReedSolomon.pas
uses ECC200,ReedSolomon;
否则肯定找不到'ReedSolomon.dcu' 和'ECC200.dcu'啦。
[Fatal Error] ECC200.pas(569): File not found: 'ReedSolomon.dcu'

由于pudn上有个源码

《delphi实现的二 维 码 生成 控制代 码-delphi realize two-dimensional code generated control code》

ECC200.pas：http://read.pudn.com/downloads111/sourcecode/delphi_control/460570/Delphi/ECC200.pas__.htm

ReedSolomon.pas：http://read.pudn.com/downloads111/sourcecode/delphi_control/460570/Delphi/ReedSolomon.pas__.htm

Reed–Solomon error correction 关于Reed–Solomon纠错码 可以看：http://en.wikipedia.org/wiki/Reed%E2%80%93Solomon_error_correction

关于reed-solomon codes 老外有篇算法论文：
http://ptgmedia.pearsoncmg.com/images/art_sklar7_reed-solomon/elementLinks/art_sklar7_reed-solomon.pdf

 

      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;
 CalcECC200(s, ecc200_Autosize, ecc200_Square, m, w, h); // ECC200.pas 
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;

调用很简单：

    procedure TForm1.FormCreate(Sender: TObject);
var
bmp: TBitmap;
begin
bmp:=TBitmap.Create;
  // 第二个参数表示每个小格的边长
Generate2DCode('Insun祝您新年快乐  Blog：http://yxmhero1989.blog.163.com ', 2, bmp);
  // TODO: your code here
     //bmp.SaveToFile('1.bmp');
     Image1.Picture.Assign(bmp);
bmp.Free;
end;  

如图所示：

Delphi，VC++，VB，C等实现二维条码绘制 - InSun - Minghacker is Insun
VC++，VB，C#一笔带过，自己看References 源码
 
QRcodeDecoder.rar  VC++6.0写的- -囧
Delphi，VC++，VB，C等实现二维条码绘制 - InSun - Minghacker is Insun
 
 VB MakeTwoBarCode：
 
 
Delphi，VC++，VB，C等实现二维条码绘制 - InSun - Minghacker is Insun
 
 

 References：

1。使用ECC200绘制二维码

http://hi.baidu.com/rarnu/blog/item/373ead772ee40010b151b9d1.html

2.。VB MakeTwoBarCode.rar (125.79 kB) 源代码下载
http://www.hackchina.com/dlpre.php?id=194965

3。C# 实现QRCode
http://www.pudn.com/downloads136/sourcecode/windows/csharp/detail581330.html

http://www.7880.com/download/ewbm-22338.html

4。QRcodeDecoder.rar  VC++
http://www.hackchina.com/cont/76458
5.。利用QRmaker制作二维码
http://windyli.blog.51cto.com/1300305/284574

6
http://www.barcommune.com/Pdf417.html
7。Java解析与生成二维码的源码下载
http://download.csdn.net/source/2580954unit ECC200; d

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 
    else if (Source[SourceIndex] - 128) in C40Shift1Set then 
    begin 
      Byte1 := 1; 
      Byte2 := 30; 
      Byte3 := 0; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := C40Value(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift2Set then 
    begin 
      Byte1 := 1; 
      Byte2 := 30; 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(SourceIndex, 2); 
      Byte1 := C40Value(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift3Set then 
    begin 
      Byte1 := 1; 
      Byte2 := 30; 
      Byte3 := 2; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := C40Value(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else raise Exception.Create('C40字符集设计有遗漏， 请通知开发人员！'); 
  end; 
end; 
 
function C40_EncodeFromByte1( 
  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 
    Byte2 := C40Value(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte2; 
  end 
  else if Source[SourceIndex] in C40Shift1Set then 
  begin 
    Byte2 := 0; 
    Byte3 := C40Value(Source[SourceIndex]); 
    Inc(SourceIndex); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] in C40Shift2Set then 
  begin 
    Byte2 := 1; 
    Byte3 := C40Value(Source[SourceIndex]); 
    Inc(SourceIndex); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]);  
    Inc(BufferIndex, 2); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] in C40Shift3Set then 
  begin 
    Byte2 := 2; 
    Byte3 := C40Value(Source[SourceIndex]); 
    Inc(SourceIndex); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] > 127 then 
  begin 
    if (Source[SourceIndex] - 128) in C40BasicSet then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := C40Value(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift1Set then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 0; 
      Byte2 := C40Value(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift2Set then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 1; 
      Byte2 := C40Value(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift3Set then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 2; 
      Byte2 := C40Value(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else raise Exception.Create('C40字符集设计有遗漏， 请通知开发人员！'); 
  end; 
end; 
 
function C40_EncodeFromByte2( 
  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 
    Byte3 := C40Value(Source[SourceIndex]); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Inc(SourceIndex); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] in C40Shift1Set then 
  begin 
    Byte3 := 0; 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Byte1 := C40Value(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte1; 
  end 
  else if Source[SourceIndex] in C40Shift2Set then 
  begin 
    Byte3 := 1; 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Byte1 := C40Value(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte1; 
  end 
  else if Source[SourceIndex] in C40Shift3Set then 
  begin 
    Byte3 := 2; 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Byte1 := C40Value(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte1; 
  end 
  else if Source[SourceIndex] > 127 then 
  begin 
    if (Source[SourceIndex] - 128) in C40BasicSet then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := C40Value(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift1Set then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := 0; 
      Byte3 := C40Value(Source[SourceIndex]); 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Result := tsReady; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift2Set then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := 1; 
      Byte3 := C40Value(Source[SourceIndex]); 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Result := tsReady; 
    end 
    else if (Source[SourceIndex] - 128) in C40Shift3Set then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := 2; 
      Byte3 := C40Value(Source[SourceIndex]); 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Result := tsReady; 
    end 
    else raise Exception.Create('C40字符集设计有遗漏， 请通知开发人员！'); 
  end; 
end; 
 
function C40_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode; 
var 
  State: TTriByteState; 
  Byte1, Byte2, Byte3: Byte; 
begin 
  State := tsReady; 
  while SourceIndex < Length(Source) do 
  begin 
    case State of 
      tsReady: 
      begin 
        Result := LookAhead(Source, SourceIndex, EncodeMode); 
        if Result <> EncodeMode then 
        begin 
          SwitchMode(Source, SourceIndex, Buffer, BufferIndex, EncodeMode, Result); 
          Exit; 
        end; 
        State := C40_EncodeFromReady(Source, SourceIndex, Buffer, BufferIndex, Byte1, Byte2, Byte3); 
      end; 
 
      tsByte1: 
      begin 
        State := C40_EncodeFromByte1(Source, SourceIndex, Buffer, BufferIndex, Byte1, Byte2, Byte3); 
      end; 
 
      tsByte2: 
      begin 
        State := C40_EncodeFromByte2(Source, SourceIndex, Buffer, BufferIndex, Byte1, Byte2, Byte3); 
      end; 
    end; 
  end; 
 
  case State of 
    tsReady: 
    begin 
      if not UpToBound(Shape, BufferIndex) then 
      begin 
        if NearestSize(Shape, BufferIndex) - BufferIndex > 1 then 
        begin 
          SwitchTriByteBack(Buffer, BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
      end; 
    end; 
 
    tsByte1: 
    begin 
      case NearestSize(Shape, BufferIndex) - BufferIndex of 
        1: 
        begin 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; 
          Inc(BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
 
        else 
        begin 
          SwitchTriByteBack(Buffer, BufferIndex); 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; 
          Inc(BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
      end; 
    end; 
 
    tsByte2: 
    begin 
      case NearestSize(Shape, BufferIndex) - BufferIndex of 
        2: 
        begin 
          Byte3 := 0; 
          TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
          Inc(BufferIndex, 2); 
        end; 
 
        else 
        begin 
          SwitchTriByteBack(Buffer, BufferIndex); 
          Result := emASCII; 
          Buffer[BufferIndex] := Source[SourceIndex - 2] + 1; Inc(BufferIndex); 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; Inc(BufferIndex); 
        end; 
      end; 
    end; 
  end; 
end; 
 
function TextValue(ASCII: Byte) : Byte; 
begin 
  case ASCII of 
    32:       Result := 3; 
    48..57:   Result := ASCII - 48 + 4; 
    65..90:   Result := ASCII - 65 + 1; 
    00..31:   Result := ASCII; 
    33..47:   Result := ASCII - 33; 
    58..64:   Result := ASCII - 58 + 15; 
    91..95:   Result := ASCII - 91 + 22; 
    96:       Result := 0; 
    97..127:  Result := ASCII - 97 + 14; 
    else raise Exception.Create('Text编码算法错误，请通知开发人员！ 错误信息：ASCII码大于127'); 
  end; 
end; 
 
function Text_EncodeFromReady( 
  var Source: TByteArray; 
  var SourceIndex: Integer; 
  var Buffer: TByteArray; 
  var BufferIndex: Integer; 
  var Byte1, Byte2, Byte3: Byte): TTriByteState; 
begin 
  if Source[SourceIndex] in TextBasicSet then 
  begin 
    Byte1 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte1; 
  end 
  else if Source[SourceIndex] in TextShift1Set then 
  begin 
    Byte1 := 0; 
    Byte2 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte2; 
  end 
  else if Source[SourceIndex] in TextShift2Set then 
  begin 
    Byte1 := 1; 
    Byte2 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte2; 
  end 
  else if Source[SourceIndex] in TextShift3Set then 
  begin 
    Byte1 := 2; 
    Byte2 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte2; 
  end 
  else if Source[SourceIndex] > 127 then 
  begin 
    if (Source[SourceIndex] - 128) in TextBasicSet then 
    begin 
      Byte1 := 1; 
      Byte2 := 30; 
      Byte3 := TextValue(Source[SourceIndex]); 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Inc(BufferIndex, 2); 
      Result := tsReady; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift1Set then 
    begin 
      Byte1 := 1; 
      Byte2 := 30; 
      Byte3 := 0; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Inc(BufferIndex, 2); 
      Byte1 := TextValue(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift2Set then 
    begin 
      Byte1 := 1; 
      Byte2 := 30; 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Inc(SourceIndex, 2); 
      Byte1 := TextValue(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift3Set then 
    begin 
      Byte1 := 1; 
      Byte2 := 30; 
      Byte3 := 2; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Inc(BufferIndex, 2); 
      Byte1 := TextValue(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else raise Exception.Create('Text字符集设计有遗漏， 请通知开发人员！'); 
  end; 
end; 
 
function Text_EncodeFromByte1( 
  var Source: TByteArray; 
  var SourceIndex: Integer; 
  var Buffer: TByteArray; 
  var BufferIndex: Integer; 
  var Byte1, Byte2, Byte3: Byte): TTriByteState; 
begin 
  if Source[SourceIndex] in TextBasicSet then 
  begin 
    Byte2 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte2; 
  end 
  else if Source[SourceIndex] in TextShift1Set then 
  begin 
    Byte2 := 0; 
    Byte3 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] in TextShift2Set then 
  begin 
    Byte2 := 1; 
    Byte3 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] in TextShift3Set then 
  begin 
    Byte2 := 2; 
    Byte3 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] > 127 then 
  begin 
    if (Source[SourceIndex] - 128) in TextBasicSet then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := TextValue(Source[SourceIndex]); 
      Result := tsByte1; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift1Set then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 0; 
      Byte2 := TextValue(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift2Set then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 1; 
      Byte2 := TextValue(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift3Set then 
    begin 
      Byte2 := 1; 
      Byte3 := 30; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 2; 
      Byte2 := TextValue(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else raise Exception.Create('Text字符集设计有遗漏， 请通知开发人员！'); 
  end; 
end; 
 
function Text_EncodeFromByte2( 
  var Source: TByteArray; 
  var SourceIndex: Integer; 
  var Buffer: TByteArray; 
  var BufferIndex: Integer; 
  var Byte1, Byte2, Byte3: Byte): TTriByteState; 
begin 
  if Source[SourceIndex] in TextBasicSet then 
  begin 
    Byte3 := TextValue(Source[SourceIndex]); 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Inc(SourceIndex); 
    Result := tsReady; 
  end 
  else if Source[SourceIndex] in TextShift1Set then 
  begin 
    Byte3 := 0; 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Byte1 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte1; 
  end 
  else if Source[SourceIndex] in TextShift2Set then 
  begin 
    Byte3 := 1; 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Byte1 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte1; 
  end 
  else if Source[SourceIndex] in TextShift3Set then 
  begin 
    Byte3 := 2; 
    TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
    Inc(BufferIndex, 2); 
    Byte1 := TextValue(Source[SourceIndex]); 
    Inc(SourceIndex); 
    Result := tsByte1; 
  end 
  else if Source[SourceIndex] > 127 then 
  begin 
    if (Source[SourceIndex] - 128) in TextBasicSet then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := TextValue(Source[SourceIndex]); 
      Result := tsByte2; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift1Set then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := 0; 
      Byte3 := TextValue(Source[SourceIndex]); 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Result := tsReady; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift2Set then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := 1; 
      Byte3 := TextValue(Source[SourceIndex]); 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Result := tsReady; 
    end 
    else if (Source[SourceIndex] - 128) in TextShift3Set then 
    begin 
      Byte3 := 1; 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Byte1 := 30; 
      Byte2 := 2; 
      Byte3 := TextValue(Source[SourceIndex]); 
      TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
      Inc(BufferIndex, 2); 
      Result := tsReady; 
    end 
    else raise Exception.Create('Text字符集设计有遗漏， 请通知开发人员！'); 
  end; 
end; 
 
function Text_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode; 
var 
  State: TTriByteState; 
  Byte1, Byte2, Byte3: Byte; 
begin 
  State := tsReady; 
  while SourceIndex < Length(Source) do 
  begin 
    case State of 
      tsReady: 
      begin 
        Result := LookAhead(Source, SourceIndex, EncodeMode); 
        if Result <> EncodeMode then 
        begin 
          SwitchMode(Source, SourceIndex, Buffer, BufferIndex, EncodeMode, Result); 
          Exit; 
        end; 
        State := Text_EncodeFromReady(Source, SourceIndex, Buffer, BufferIndex, Byte1, Byte2, Byte3); 
      end; 
 
      tsByte1: 
      begin 
        State := Text_EncodeFromByte1(Source, SourceIndex, Buffer, BufferIndex, Byte1, Byte2, Byte3); 
      end; 
 
      tsByte2: 
      begin 
        State := Text_EncodeFromByte2(Source, SourceIndex, Buffer, BufferIndex, Byte1, Byte2, Byte3); 
      end; 
    end; 
  end; 
 
  case State of 
    tsReady: 
    begin 
      if not UpToBound(Shape, BufferIndex) then 
      begin 
        if NearestSize(Shape, BufferIndex) - BufferIndex > 1 then 
        begin 
          SwitchTriByteBack(Buffer, BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
      end; 
    end; 
 
    tsByte1: 
    begin 
      case NearestSize(Shape, BufferIndex) - BufferIndex of 
        1: 
        begin 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; 
          Inc(BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
 
        else 
        begin 
          SwitchTriByteBack(Buffer, BufferIndex); 
          Result := emASCII; 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; 
          Inc(BufferIndex); 
          Exit; 
        end; 
      end; 
    end; 
 
    tsByte2: 
    begin 
      case NearestSize(Shape, BufferIndex) - BufferIndex of 
        2: 
        begin 
          Byte3 := 0; 
          TriByteEncode(Byte1, Byte2, Byte3, Buffer[BufferIndex], Buffer[BufferIndex + 1]); 
          Inc(BufferIndex, 2); 
        end; 
 
        else 
        begin 
          SwitchTriByteBack(Buffer, BufferIndex); 
          Result := emASCII; 
          Buffer[BufferIndex] := Source[SourceIndex - 2] + 1; Inc(BufferIndex); 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; Inc(BufferIndex); 
        end; 
      end; 
    end; 
  end; 
end; 
 
function X12Value(ASCII: Byte) : Byte; 
begin 
  case ASCII of 
    13: Result := 0; 
    42: Result := 1; 
    62: Result := 2; 
    32: Result := 3; 
    48..57: Result := ASCII - 48 + 4; 
    65..90: Result := ASCII - 65 + 14;  
  end; 
end; 
 
//X12字符集没有Unlatch和Pad字符，因此，必须三个X12字符一组进行编码。如果 
//可编码字符不足三个，必须退出X12编码模式 
function X12_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode; 
var 
  State: TTriByteState; 
  NewMode: TEncodeMode; 
  Byte1, Byte2, Byte3: Byte; 
begin 
  State := tsReady; 
  while (SourceIndex <= Length(Source) - 3) 
  and (Source[SourceIndex] in X12Set) 
  and (Source[SourceIndex + 1] in X12Set) 
  and (Source[SourceIndex + 2] in X12Set) do 
  begin 
    TriByteEncode( 
        X12Value(Source[SourceIndex]), 
        X12Value(Source[SourceIndex + 1]), 
        X12Value(Source[SourceIndex + 2]), 
        Buffer[BufferIndex], 
        Buffer[BufferIndex + 1]); 
        Inc(SourceIndex, 3); 
        Inc(BufferIndex, 2); 
  end; 
 
  if SourceIndex < Length(Source) then 
  begin 
    case Length(Source) - SourceIndex of 
      1: 
      begin 
        case NearestSize(Shape, BufferIndex) - BufferIndex of 
          1: 
          begin 
            ASCII_EncodeData(Source, SourceIndex, Buffer, BufferIndex); 
            Result := emASCII; 
            Exit; 
          end; 
 
          else 
          begin 
            SwitchTriByteBack(Buffer, BufferIndex); 
            ASCII_EncodeData(Source, SourceIndex, Buffer, BufferIndex); 
            Result := emASCII; 
          end; 
 
        end; 
      end; 
 
      2: 
      begin 
        case NearestSize(Shape, BufferIndex) - BufferIndex of 
          2: 
          begin 
            TriByteEncode( 
              X12Value(Source[SourceIndex]), 
              X12Value(Source[SourceIndex + 1]), 
              0, 
              Source[SourceIndex], 
              Source[SourceIndex + 1]); 
          end; 
 
          else 
          begin 
            SwitchTriByteBack(Buffer, BufferIndex); 
            Result := emASCII; 
          end; 
        end; 
      end; 
    end; 
  end; 
 
  if UptoBound(Shape, BufferIndex) then Exit; 
  if NearestSize(Shape, BufferIndex) - BufferIndex <= 1 then Exit; 
  SwitchTriByteBack(Buffer, BufferIndex); 
  Result := emASCII; 
end; 
 
type 
  TFourBytes = array[0..3] of Byte; 
 
procedure EDIFACT_EncodeFourBytes(var Bytes: TFourBytes; var Buffer: TByteArray; var BufferIndex: Integer); 
var 
  T: Longword; 
begin 
  T := (((Bytes[0] * 64 + Bytes[1]) * 64 + Bytes[2]) * 64) + Bytes[3]; 
  Buffer[BufferIndex] := T div $10000;  T := T mod $10000;  Inc(BufferIndex); 
  Buffer[BufferIndex] := T div $100;    T := T mod $100;    Inc(BufferIndex); 
  Buffer[BufferIndex] := T;                                 Inc(BufferIndex); 
end; 
 
function EDIFACTValue(ASCII: Byte): Byte; 
begin 
  if ASCII in [64..94] then Result := ASCII - 64 
  else if ASCII in [32..63] then Result := ASCII 
  else raise Exception.Create('EDIFACT 求值错误，ASCII超出EDIFACT字符集范围！'); 
end; 
 
function EDIFACT_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode; 
var 
  Index, I: Integer; 
  Bytes: TFourBytes; 
begin 
  Index := 0; 
  while SourceIndex < Length(Source) do 
  begin 
    if Index = 0 then 
    begin 
      Result := LookAhead(Source, SourceIndex, EncodeMode); 
      if Result <> EncodeMode then 
      begin 
        Bytes[Index] := 31; 
        Inc(Index); 
        for I := Index to 3 do Bytes[I] := 0; 
        EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex); 
        Exit; 
      end; 
    end; 
    if (Source[SourceIndex] in EDIFACTSet) then 
    begin 
      Bytes[Index] := EDIFACTValue(Source[SourceIndex]); 
      Inc(Index); 
      Inc(SourceIndex); 
      if Index = 4 then 
      begin 
        EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex); 
        Index := 0; 
      end; 
    end 
    else 
    begin 
      Bytes[Index] := 31; 
      Inc(Index); 
      for I := Index to 3 do Bytes[I] := 0; 
      EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex); 
      Result := emASCII; 
      Exit; 
    end; 
  end; 
 
  case Index of 
    0: 
    begin 
      if UptoBound(Shape, BufferIndex) then Exit; 
    end; 
 
    1: 
    begin 
      case NearestSize(Shape, BufferIndex) - BufferIndex of 
        1..2: 
        begin 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; 
          Inc(BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
 
        else 
        begin 
          Bytes[1] := 31; 
          Bytes[2] := 0; 
          Bytes[3] := 0; 
          EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
      end; 
    end; 
 
    2: 
    begin 
      case NearestSize(Shape, BufferIndex) - BufferIndex of 
        1..2: 
        begin 
          Buffer[BufferIndex] := Source[SourceIndex - 2] + 1; 
          Inc(BufferIndex); 
          Buffer[BufferIndex] := Source[SourceIndex - 1] + 1; 
          Inc(BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
 
        else 
        begin 
          Bytes[2] := 31; 
          Bytes[3] := 0; 
          EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex); 
          Result := emASCII; 
          Exit; 
        end; 
      end; 
    end; 
 
    3: 
    begin 
      Bytes[3] := 31; 
      EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex); 
      Result := emASCII; 
      Exit; 
    end; 
  end; 
 
  Bytes[Index] := 31; 
  Inc(Index); 
  for I := Index to 3 do Bytes[I] := 0; 
  EDIFACT_EncodeFourBytes(Bytes, Buffer, BufferIndex); 
  Result := emASCII; 
end; 
 
function Base256_Encode(Shape: TECC200Shape; EncodeMode: TEncodeMode; var Source: TByteArray; var SourceIndex: Integer; var Buffer: TByteArray; var BufferIndex: Integer): TEncodeMode; 
var 
  Len: Integer; 
  Bytes: array [0..5000] of Byte; 
  I: Integer; 
begin 
  Len := 0; 
  while SourceIndex < Length(Source) do 
  begin 
    Result := LookAhead(Source, SourceIndex, EncodeMode); 
    if (Result <> emBase256) or (Len > 1555) then 
    begin 
      Result := emASCII; 
      case Len of 
        0: 
        begin 
          Buffer[BufferIndex] := Random255(Len, BufferIndex + 1); 
          Inc(BufferIndex); 
          Exit; 
        end; 
 
        1..249: 
        begin 
          Buffer[BufferIndex] := Random255(Len, BufferIndex + 1); 
          Inc(BufferIndex); 
          for I := 0 to Len - 1 do 
          begin 
            Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1); 
            Inc(BufferIndex); 
          end; 
          Exit; 
        end; 
 
        250..1555: 
        begin 
          Buffer[BufferIndex] := Random255(Len div 250 + 249, BufferIndex + 1); 
          Inc(BufferIndex); 
          Buffer[BufferIndex] := Random255(Len mod 250, BufferIndex + 1); 
          Inc(BufferIndex); 
          for I := 0 to Len - 1 do 
          begin 
            Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1); 
            Inc(BufferIndex); 
          end; 
          Exit; 
        end; 
 
        else raise Exception.Create('Base256数据块大于1555字节！'); 
      end; 
    end 
    else 
    begin 
      Bytes[Len] := Source[SourceIndex]; 
      Inc(SourceIndex); 
      Inc(Len); 
    end; 
  end; 
 
  case Len of 
    0: 
    begin 
      Buffer[BufferIndex] := Random255(Len, BufferIndex + 1);; 
      Inc(BufferIndex); 
    end; 
 
    1..249: 
    begin 
      Buffer[BufferIndex] := Random255(Len, BufferIndex + 1); 
      Inc(BufferIndex); 
      for I := 0 to Len - 1 do 
      begin 
        Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1); 
        Inc(BufferIndex); 
      end; 
    end; 
 
    250..1555: 
    begin 
      Buffer[BufferIndex] := Random255(Len div 250 + 249, BufferIndex + 1); 
      Inc(BufferIndex); 
      Buffer[BufferIndex] := Random255(Len mod 250, BufferIndex + 1); 
      Inc(BufferIndex); 
      for I := 0 to Len - 1 do 
      begin 
        Buffer[BufferIndex] := Random255(Bytes[I], BufferIndex + 1); 
        Inc(BufferIndex); 
      end; 
    end; 
 
    else raise Exception.Create('Base256数据块大于1555字节！'); 
  end; 
  Result := emASCII; 
end; 
 
procedure MakeCodeword(Source : TByteArray; Size : TECC200Size; Shape : TEcc200Shape; var EncodeStream : TByteArray; var EncodeSize : TECC200Size); 
var 
  Buffer : TByteArray; 
  SourceIndex, BufferIndex: Integer; 
  EncodeMode: TEncodeMode; 
  s: TECC200Size; 
  outlen, i: Integer; 
begin 
  SetLength(Buffer, 5000); 
  EncodeMode := emASCII; 
  SourceIndex := 0; 
  BufferIndex := 0; 
  while SourceIndex < Length(Source) do 
  begin 
    while (EncodeMode = emASCII)    and (SourceIndex < Length(Source)) do EncodeMode := ASCII_Encode   (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex); 
    while (EncodeMode = emC40)      and (SourceIndex < Length(Source)) do EncodeMode := C40_Encode     (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex); 
    while (EncodeMode = emText)     and (SourceIndex < Length(Source)) do EncodeMode := Text_Encode    (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex); 
    while (EncodeMode = emX12)      and (SourceIndex < Length(Source)) do EncodeMode := X12_Encode     (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex); 
    while (EncodeMode = emEDIFACT)  and (SourceIndex < Length(Source)) do EncodeMode := EDIFACT_Encode (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex); 
    while (EncodeMode = emBase256)  and (SourceIndex < Length(Source)) do EncodeMode := Base256_Encode (Shape, EncodeMode, Source, SourceIndex, Buffer, BufferIndex); 
  end; 
 
  if Size = ecc200_Autosize then 
  begin 
    if Shape = ecc200_Square then 
    begin 
      for s := ecc200_10x10 to ecc200_144x144 do 
      begin 
        outlen := ECC200SymbolParams[s].DataLength; 
        if outlen >= BufferIndex then 
        begin 
          EncodeSize := s; 
          break; 
        end; 
      end; 
    end 
    else 
    begin 
      for s := ecc200_8x18 to ecc200_16x48 do 
      begin 
        outlen := ECC200SymbolParams[s].DataLength; 
        if outlen >= BufferIndex then 
        begin 
          EncodeSize := s; 
          break; 
        end; 
      end; 
    end; 
    if outlen < BufferIndex then raise Exception.Create('数据超出二维码容量！'); 
  end 
  else 
  begin 
    EncodeSize := Size; 
    outlen := ECC200SymbolParams[Size].DataLength; 
    if outlen < BufferIndex then raise Exception.Create('数据超出二维码容量！'); 
  end; 
 
  SetLength(EncodeStream, outlen); 
  for i := 0 to BufferIndex - 1 do 
  begin 
    EncodeStream[i] := Buffer[i]; 
  end; 
  if BufferIndex < outlen then 
  begin 
    EncodeStream[BufferIndex] := 129; 
    for i := BufferIndex + 1 to outlen - 1 do 
    begin 
      EncodeStream[i] := Random253(129, i + 1); 
    end; 
  end; 
end; 
 
function Encode(CodewordStream : TByteArray; Size : TECC200Size) : TByteArray; 
var 
  x, y, z : TPloy; 
  i, j, p : integer; 
  BlockCount, DataLen, ErrorLen : integer; 
begin 
  case Size of 
    ecc200_10x10 : 
    begin 
      SetLength(y, Length(Ploy5)); 
      for i := 0 to 5 do y[i] := Ploy5[i]; 
    end; 
    ecc200_12x12 : 
    begin 
      SetLength(y, Length(Ploy7)); 
      for i := 0 to 7 do y[i] := Ploy7[i]; 
    end; 
    ecc200_14x14 : 
    begin 
      SetLength(y, Length(Ploy10)); 
      for i := 0 to 10 do y[i] := Ploy10[i]; 
    end; 
    ecc200_16x16 : 
    begin 
      SetLength(y, Length(Ploy12)); 
      for i := 0 to 12 do y[i] := Ploy12[i]; 
    end; 
    ecc200_18x18 : 
    begin 
      SetLength(y, Length(Ploy14)); 
      for i := 0 to 14 do y[i] := Ploy14[i]; 
    end; 
    ecc200_20x20 : 
    begin 
      SetLength(y, Length(Ploy18)); 
      for i := 0 to 18 do y[i] := Ploy18[i]; 
    end; 
    ecc200_22x22 : 
    begin 
      SetLength(y, Length(Ploy20)); 
      for i := 0 to 20 do y[i] := Ploy20[i]; 
    end; 
    ecc200_24x24 : 
    begin 
      SetLength(y, Length(Ploy24)); 
      for i := 0 to 24 do y[i] := Ploy24[i]; 
    end; 
    ecc200_26x26 : 
    begin 
      SetLength(y, Length(Ploy28)); 
      for i := 0 to 28 do y[i] := Ploy28[i]; 
    end; 
    ecc200_32x32 : 
    begin 
      SetLength(y, Length(Ploy36)); 
      for i := 0 to 36 do y[i] := Ploy36[i]; 
    end; 
    ecc200_36x36 : 
    begin 
      SetLength(y, Length(Ploy42)); 
      for i := 0 to 42 do y[i] := Ploy42[i]; 
    end; 
    ecc200_40x40 : 
    begin 
      SetLength(y, Length(Ploy48)); 
      for i := 0 to 48 do y[i] := Ploy48[i]; 
    end; 
    ecc200_44x44 : 
    begin 
      SetLength(y, Length(Ploy56)); 
      for i := 0 to 56 do y[i] := Ploy56[i]; 
    end; 
    ecc200_48x48 : 
    begin 
      SetLength(y, Length(Ploy68)); 
      for i := 0 to 68 do y[i] := Ploy68[i]; 
    end; 
    ecc200_52x52 : 
    begin 
      SetLength(y, Length(Ploy42)); 
      for i := 0 to 42 do y[i] := Ploy42[i]; 
    end; 
    ecc200_64x64 : 
    begin 
      SetLength(y, Length(Ploy56)); 
      for i := 0 to 56 do y[i] := Ploy56[i]; 
    end; 
    ecc200_72x72 : 
    begin 
      SetLength(y, Length(Ploy36)); 
      for i := 0 to 36 do y[i] := Ploy36[i]; 
    end; 
    ecc200_80x80 : 
    begin 
      SetLength(y, Length(Ploy48)); 
      for i := 0 to 48 do y[i] := Ploy48[i]; 
    end; 
    ecc200_88x88 : 
    begin 
      SetLength(y, Length(Ploy56)); 
      for i := 0 to 56 do y[i] := Ploy56[i]; 
    end; 
    ecc200_96x96 : 
    begin 
      SetLength(y, Length(Ploy68)); 
      for i := 0 to 68 do y[i] := Ploy68[i]; 
    end; 
    ecc200_104x104 : 
    begin 
      SetLength(y, Length(Ploy56)); 
      for i := 0 to 56 do y[i] := Ploy56[i]; 
    end; 
    ecc200_120x120 : 
    begin 
      SetLength(y, Length(Ploy68)); 
      for i := 0 to 68 do y[i] := Ploy68[i]; 
    end; 
    ecc200_132x132 : 
    begin 
      SetLength(y, Length(Ploy62)); 
      for i := 0 to 62 do y[i] := Ploy62[i]; 
    end; 
    ecc200_144x144 : 
    begin 
      SetLength(y, Length(Ploy62)); 
      for i := 0 to 62 do y[i] := Ploy62[i]; 
    end; 
    ecc200_8x18 : 
    begin 
      SetLength(y, Length(Ploy7)); 
      for i := 0 to 7 do y[i] := Ploy7[i]; 
    end; 
    ecc200_8x32 : 
    begin 
      SetLength(y, Length(Ploy11)); 
      for i := 0 to 11 do y[i] := Ploy11[i]; 
    end; 
    ecc200_12x26 : 
    begin 
      SetLength(y, Length(Ploy14)); 
      for i := 0 to 14 do y[i] := Ploy14[i]; 
    end; 
    ecc200_12x36 : 
    begin 
      SetLength(y, Length(Ploy18)); 
      for i := 0 to 18 do y[i] := Ploy18[i]; 
    end; 
    ecc200_16x36 : 
    begin 
      SetLength(y, Length(Ploy24)); 
      for i := 0 to 24 do y[i] := Ploy24[i]; 
    end; 
    ecc200_16x48 : 
    begin 
      SetLength(y, Length(Ploy28)); 
      for i := 0 to 28 do y[i] := Ploy28[i]; 
    end; 
  end; 
 
  SetLength(Result, ECC200SymbolParams[Size].DataLength + ECC200SymbolParams[Size].ErrorLength); 
  BlockCount := ECC200SymbolParams[Size].BlockCount; 
  DataLen := ECC200SymbolParams[Size].BlockDataLength; 
  ErrorLen := ECC200SymbolParams[Size].BlockErrorLength; 
 
  for i := 0 to BlockCount -1 do 
  begin 
    x := nil; 
    if (Size = ECC200_144x144) and (i >= 8) then 
      DataLen := 155; 
    SetLength(x, DataLen + ErrorLen); 
    p := i; 
    for j := High(x) downto High(x) - DataLen + 1 do 
    begin 
      x[j] := CodewordStream[p]; 
      Result[p] := CodewordStream[p]; 
      inc(p, BlockCount); 
    end; 
    z := PloyMod(x, y); 
    for j := High(z) downto 0 do 
    begin 
      Result[p] := z[j]; 
      inc(p, BlockCount); 
    end; 
  end; 
end; 
 
function Mapping(EncodeStream : TByteArray; Size : TECC200Size) : TByteArray; 
type 
  TExpandByte = array [0..7] of byte; 
var 
  E : array of TExpandByte; 
  r : array of integer; 
  i, j : integer; 
  b : byte; 
 
  p : TECC200SymbolParam; 
 
  //These vars are from ECC200 Standard 
  nrow, ncol : integer; 
  chr, row, col : integer; 
 
  procedure module(row, col, chr, bit : integer); 
  begin 
    if row < 0 then 
    begin 
      inc(row, nrow); 
      inc(col, 4 - ((nrow + 4) mod 8)); 
    end; 
    if col < 0 then 
    begin 
      inc(col, ncol); 
      inc(row, 4 - ((ncol + 4) mod 8)); 
    end; 
 
    r[row * ncol + col] := chr * 10 + 1; 
    Result[row * ncol + col] := E[chr - 1, bit - 1]; 
  end; 
 
  procedure utah(row, col, chr : integer); 
  begin 
    module(row - 2, col - 2, chr, 1); 
    module(row - 2, col - 1, chr, 2); 
    module(row - 1, col - 2, chr, 3); 
    module(row - 1, col - 1, chr, 4); 
    module(row - 1, col, chr, 5); 
    module(row, col - 2, chr, 6); 
    module(row, col - 1, chr, 7); 
    module(row, col, chr, 8); 
  end; 
 
  procedure corner1(chr : integer); 
  begin 
    module(nrow - 1, 0, chr, 1); 
    module(nrow - 1, 1, chr, 2); 
    module(nrow - 1, 2, chr, 3); 
    module(0, ncol - 2, chr, 4); 
    module(0, ncol - 1, chr, 5); 
    module(1, ncol - 1, chr, 6); 
    module(2, ncol - 1, chr, 7); 
    module(3, ncol - 1, chr, 8); 
  end; 
 
  procedure corner2(chr : integer); 
  begin 
    module(nrow - 3, 0, chr, 1); 
    module(nrow - 2, 0, chr, 2); 
    module(nrow - 1, 0, chr, 3); 
    module(0, ncol - 4, chr, 4); 
    module(0, ncol - 3, chr, 5); 
    module(0, ncol - 2, chr, 6); 
    module(0, ncol - 1, chr, 7); 
    module(1, ncol - 1, chr, 8); 
  end; 
 
  procedure corner3(chr : integer); 
  begin 
    module(nrow - 3, 0, chr, 1); 
    module(nrow - 2, 0, chr, 2); 
    module(nrow - 1, 0, chr, 3); 
    module(0, ncol - 2, chr, 4); 
    module(0, ncol - 1, chr, 5); 
    module(1, ncol - 1, chr, 6); 
    module(2, ncol - 1, chr, 7); 
    module(3, ncol - 1, chr, 8); 
  end; 
 
  procedure corner4(chr : integer); 
  begin 
    module(nrow - 1, 0, chr, 1); 
    module(nrow - 1, ncol - 1, chr, 2); 
    module(0, ncol - 3, chr, 3); 
    module(0, ncol - 2, chr, 4); 
    module(0, ncol - 1, chr, 5); 
    module(1, ncol - 3, chr, 6); 
    module(1, ncol - 2, chr, 7); 
    module(1, ncol - 1, chr, 8); 
  end; 
var 
  mmm : integer; 
begin 
  p := ECC200SymbolParams[Size]; 
  mmm := Length(EncodeStream); 
  SetLength(e, mmm); 
  for i:= 0 to High(E) do 
  begin 
    b := EncodeStream[i]; 
    for j := 7 downto 0 do 
    begin 
      E[i, j] := b mod 2; 
      b := b shr 1; 
    end; 
  end; 
 
  ncol := p.RegionCols * p.RegionHCount; 
  nrow := p.RegionRows * p.RegionVCount; 
 
  SetLength(Result, ncol * nrow); 
  SetLength(r, ncol * nrow); 
 
  for i := 0 to High(Result) do 
  begin 
    Result[i]:= 0; 
    r[i] := 0; 
  end; 
 
  chr := 1; 
  row := 4; 
  col := 0; 
 
  repeat 
 
    if (row = nrow) and (col = 0) then 
    begin 
      corner1(chr); 
      inc(chr); 
    end; 
 
    if (row = nrow - 2) and (col = 0) and (ncol mod 4 <> 0) then 
    begin 
      corner2(chr); 
      inc(chr); 
    end; 
 
    if (row = nrow - 2) and (col = 0) and (ncol mod 8 = 4) then 
    begin 
      corner3(chr); 
      inc(chr); 
    end; 
 
    if (row = nrow + 4) and (col = 2) and (ncol mod 8 = 0) then 
    begin 
      corner4(chr); 
      inc(chr); 
    end; 
 
    repeat 
 
      if (row < nrow) and (col >= 0) and (r[row * ncol + col] = 0) then 
      begin 
        utah(row, col, chr); 
        inc(chr); 
      end; 
      dec(row, 2); 
      inc(col, 2); 
    until not((row >= 0) and (col <ncol)); 
    inc(row); 
    inc(col, 3); 
 
    repeat 
      if (row >= 0) and (col < ncol) and (r[row * ncol + col] = 0) then 
      begin 
        utah(row, col, chr); 
        inc(chr); 
      end; 
      inc(row, 2); 
      dec(col, 2); 
    until not ((row < nrow) and (col >= 0)); 
    inc(row, 3); 
    inc(col); 
  until not ((row < nrow) or (col < ncol)); 
 
  if r[nrow * ncol - 1] = 0 then 
  begin 
    Result[nrow * ncol - 1] := 1; 
    Result[nrow * ncol - ncol - 2] := 1; 
    r[nrow * ncol - 1] := 1; 
    r[nrow * ncol - ncol - 2] := 1; 
  end; 
end; 
 
function Alignment(MatrixMapping : TByteArray; Size : TECC200Size) : TByteArray; 
var 
  i, j, m, n : integer; 
  row, col, row1, col1 : integer; 
  p : TECC200SymbolParam; 
  ncol, ncol1 : integer; 
  b : byte; 
  Demo: Boolean; 
begin 
  p := ECC200SymbolParams[Size]; 
  SetLength(Result, p.Rows * p.Cols); 
  ncol := p.Cols - 2 * p.RegionHCount; 
  ncol1 := p.Cols; 
  for i := 0 to High(Result) do Result[i] := 0; 
  Demo := False; 
{$IFDEF DEMO} 
  if (YearOf(Now) > 2006) and (Random(100) > 90) then Demo := True; 
{$ENDIF} 
 
  for i := 0 to p.RegionHCount - 1 do 
  begin 
    for j := 0 to p.RegionVCount -1 do 
    begin 
      for m := 0 to p.RegionCols - 1 do 
      begin 
        for n := 0 to p.RegionRows - 1 do 
        begin 
          row := j * p.RegionRows + n; 
          col := i * p.RegionCols + m; 
          row1 := j * (p.RegionRows + 2) + 1 + n; 
          col1 := i * (p.RegionCols + 2) + 1 + m; 
          Result[row1 * ncol1 + col1] := MatrixMapping[row * ncol + col]; 
{$IFDEF DEMO} 
          if Demo then Result[row1 * ncol1 + col1] := Random(100) mod 2; 
{$ENDIF} 
        end; 
      end; 
    end; 
  end; 
  for i := 0 to p.RegionHCount - 1 do 
  begin 
    col := i * (p.RegionCols + 2); 
    col1 := (i + 1) * (p.RegionCols + 2) - 1; 
    for j := 0 to p.Rows - 1 do 
    begin 
      Result[j * p.Cols + col] := 1; 
      Result[j * p.Cols + col1] := j mod 2; 
    end; 
  end; 
  for i := 0 to p.RegionVCount - 1 do 
  begin 
    row := i * (p.RegionRows + 2); 
    row1 := (i + 1) * (p.RegionRows + 2) - 1; 
    for j := 0 to p.Cols - 1 do 
    begin 
      Result[row * p.Cols + j] := (j + 1) mod 2; 
      Result[row1 * p.Cols + j] := 1; 
    end; 
  end;  
end; 
 
procedure CalcECC200(Source : TByteArray; Size : TECC200Size; 
  Shape : TECC200Shape; 
  var DataMatrix : TByteArray; 
  var MatrixWidth, MatrixHeight : integer); 
var 
  CodewordStream : TByteArray; 
  EncodeStream : TByteArray; 
  MatrixMapping : TByteArray; 
  EncodeSize : TECC200Size; 
  I: Integer; 
begin 
{$IFDEF DEMO} 
  if Length(Source) >= 12 then 
  begin 
    I := Length(Source) - 4; 
    Source[I] := Ord('D'); Inc(I); 
    Source[I] := Ord('E'); Inc(I); 
    Source[I] := Ord('M'); Inc(I); 
unit ReedSolomon;
 
interface 
 
type 
 
  TPloy = array of byte; 

function Add(x, y : byte) : byte; 
function Mul(x, y : byte) : byte; 
 
function PloyMod(x, y : TPloy) : TPloy; 
 
implementation 
 
uses SysUtils; 
 
function Add(x, y : byte) : byte; 
begin 
  Result := x xor y; 
end; 
 
function Mul(x, y : byte) : byte; 
var 
   i : integer; 
   b : byte; 
   wx, wy, r : longword; 
begin 
  wx := x; 
  wy := y; 
  r := 0; 
  for i := 0 to 7 do 
  begin 
    b := wy mod 2; 
    wy := wy shr 1; 
    if b <> 0 then 
    begin 
      r := r xor wx; 
    end; 
    wx := wx shl 1; 
  end; 
  if r >= 32768 then r := r xor (301 * 128); 
  if r >= 16384 then r := r xor (301 * 64); 
  if r >= 8192  then r := r xor (301 * 32); 
  if r >= 4096  then r := r xor (301 * 16); 
  if r >= 2048  then r := r xor (301 * 8); 
  if r >= 1024  then r := r xor (301 * 4); 
  if r >= 512   then r := r xor (301 * 2); 
  if r >= 256   then r := r xor (301); 
  Result := r; 
end; 
 
function PloyMod(x, y : TPloy) : TPloy; 
var 
  i, j, k : integer; 
  xx : byte; 
begin 
  if y[Length(y) - 1] <> 1 then 
  begin 
    raise Exception.Create('除式必须是首一多项式！'); 
  end; 
  for i := High(x) downto High(y) do 
  begin 
    xx := x[i]; 
    if xx > 0 then 
    begin 
      for j := High(y) downto 0 do 
      begin 
        k := i - Length(y)+ 1 + j; 
        x[k] := Add(x[k], Mul(y[j], xx)); 
      end; 
    end; 
  end; 
  SetLength(Result, High(y)); 
  for i := 0 to High(y) - 1 do Result[i] := x[i]; 
end;
end.




Source[I] := Ord('O'); Inc(I); end; {$ENDIF} MakeCodeword(Source, Size, Shape, CodewordStream, EncodeSize); EncodeStream := Encode(CodewordStream, EncodeSize); MatrixMapping := Mapping(EncodeStream, EncodeSize); DataMatrix := Alignment(MatrixMapping, EncodeSize);
 MatrixWidth := ECC200SymbolParams[EncodeSize].Cols; MatrixHeight := ECC200SymbolParams[EncodeSize].Rows; end; end.






                

        

        

    

  


    

      

        

            

              
                
                  PhoenixTR
                
              
            

            

                关注
              
            

        

        

          
      

      









                



	

		

			

				
					
二维条码编码平台（VB语言）

				
			

			

				

					07-28
				

			

		

		

			
				
VB制作PDF417,Qr_Code,DataMatrix二维条码编码，VB程序演示,有完整的详细接口说明，完整的DEMO，包括条码读码，是制作二维条码的经典作品。
以动态库(DLL)方式提供图片格式的二维条码解码，供二次开发。
● 生成PDF417、QR Code、DataMatrix等二维条码；
● QR码和DataMatrix码提供条码图象黑白二值信息缓存接口，便于激光机和雕刻机的操作； 
● 二维条码生成控件能将文字（任何语种的文字）、二进制数、照片（可压缩）、掌纹、指纹、声音、签名等信息编码生成二维条码，并可实施信息加密；
● DLL产品以结构形式设置条码各参数；
● 提供串口设置及调用函数；
● 通用性强，普遍适合一般串口通信传输。 

以动态库(DLL)方式提供人像照片压缩控件，以便用来生成二维条码。
● 使用先进压缩技术，压缩比高，失真小; 
● 压缩后的图片可控制在1K以内;

			
		

	



                

              
                



	

		

			

				
					
二维条码代码 vb02 2016-05-29.zip

				
			

			

				

					05-30
				

			

		

		

			
				
二维条码VB6.0代码

			
		

	



                


  
              

                


	

		

			

				
					
DELPHI 二维条码

				
			

			

				

					06-29
				

			

		

		

			
				
解决打印二维条码打印汉字出现乱码问题,在window xp下实现,并编译为OCX控件在PHP中应用

			
		

	





	

		

			

				
					
C#编写的DataMatrix代码

				
			

			

				

					07-08
				

			

		

		

			
				
VS2012版本，下载时注意，输入要编码的内容即可绘制出二维码，程序完全是手写的，若有不太规范的地方请谅解

			
		

	



		

			
		



	

		

			

				
					
用Delphi 8、VB.net以及C#混合编程(转贴)

				
			

			

				

					qdzx2008的专栏
				

				

					02-04
					
					1859
					
				

			

		

		

			
				
这个礼拜三晚上的.net讲座被取消了，原因是与我的课程冲突，并且近20天内不允许停调课。所以只能在这里将我讲座中的部分演示内容预先公布一下了。演示内容之一便是“同一平台、多种语言”。在.net的CLR平台上不同语言编写的程序可以相互调用。其UML图如下：我们使用Delphi 8编写Person类，并编译成DLL文件。代码如下：unit TPerson;interfacetype  Pers

			
		

	





	

		

			

				
					
delphi代码实现一维条形码控件.rar

				
			

			

				

					05-26
				

			

		

		

			
				
在Delphi编程环境中，开发一款能够生成一维条形码的控件是一项常见的需求，尤其在数据跟踪、库存管理或产品标识等领域。本资源“delphi代码实现一维条形码控件.rar”提供了一个无需额外插件的解决方案，特别针对...

			
		

	





	

		

			

				
					
Delphi7与C#实现Des加解密互通Demo,全网找遍只次一份

				
			

			

				

					07-12
				

			

		

		

			
				
本文将深入探讨如何在Delphi 7和C#这两种不同的编程环境中实现DES（Data Encryption Standard）加解密的互通性。DES是一种广泛使用的对称加密算法，它能有效地保护数据的安全，防止未经授权的访问。  标题中的...

			
		

	





	

		

			

				
					
VB编写程序实现VB源码转换为Delphi

				
			

			

				

					05-07
				

			

		

		

			
				
标题中的“VB编写程序实现VB源码转换为Delphi”是指使用Visual Basic（VB）编程语言编写的一个工具，它的功能是将VB的源代码转换成Delphi的源代码。这通常是为了让VB编写的程序能在Delphi环境中运行，或者利用Delphi...

			
		

	





	

		

			

				
					
opc编程例子、工具DELPHI、VC++、C#、VB等例子

				
			

			

				

					05-23
				

			

		

		

			
				
本压缩包包含了一系列关于OPC编程的实例，适用于DELPHI、VC++、C#、VB等多种编程语言，帮助开发者更好地理解和应用OPC技术。  1. **OPC基础概念**：OPC分为OPC DA（Data Access）、OPC HDA（Historical Data Access...

			
		

	





	

		

			

				
					
使用delphi打印条形码

				
			

			

				

					04-14
				

			

		

		

			
				
本篇文章将详细介绍如何在Delphi环境下利用控件实现条形码的打印。  首先，我们需要理解条形码的基本概念。条形码是一种将数字、字母或特殊字符转化为一组宽度不等的黑白条纹图形，通过光学扫描设备读取并解码为可...

			
		

	





	

		

			

				
					
C# DataMatrix.net使用

				
			

			

				

					08-13
				

			

		

		

			
				
NULL
博文链接：https://thoreau.iteye.com/blog/2295354

			
		

	





	

		

			

				
					
DataMatrix二维条码编码和解码源代码（C#）

				
			

			

				

					11-17
				

			

		

		

			
				
用C#语言编写的DataMatrix二维条码编码和解码源代码，可以在项目中直接使用

			
		

	





	

		

			

				
					
C# 生成DataMatrix二维码

				
			

			

				

					08-24
				

			

		

		

			
				
使用DataMatrix.net.dll库
生成DataMatrix二维码
可预览与打印
可根据需求进行二次开发
Demo程序完美可用

			
		

	





	

		

			

				
					
C# 生成DataMatriX二维码，有需要的可以下载了。

				
			

			

				

					07-14
				

			

		

		

			
				
C# DLL生成Data matriX 二维码，可以将打包好的DLL用Static方法调用，直接将DLL挂在数据库里面用Function来调用，将不再需要先将二维码生成图片再引用。

			
		

	





	

		

			

				
					
华视CVR100U驱动及VB\VC\Delphi\C#例子（可用）

				
			

			

				

					11-21
				

			

		

		

			
				
华视CVR100U驱动及VB\VC\Delphi\C#例子（可用），我试了好久，终于找到了这个可用的，

			
		

	





	

		

			

				
					
C++、C#、JAVA 、 DELPHI、VB各个程序的优缺点你知道吗？

					
最新发布

				
			

			

				

					单片机一哥的博客
				

				

					09-01
					
					1194
					
				

			

		

		

			
				
刚好我整理了一套嵌入式学习方向，其中技巧和干货简直满满，里面包含了编程教学、问题视频讲解、毕设800套和语言类教学，只需要回复个6，免费发给你，一条龙服务让你毫无顾虑好好学习。优势：面向对象特性好，开发速度快，拥有强大的.NET框架支持，适合Windows应用开发和Web开发。优势：跨平台能力强，拥有丰富的类库和工具支持，适合大规模企业级应用开发，具有良好的安全性和可靠性。优势：易学易用，图形化开发环境，适合快速开发Windows应用程序，具有丰富的第三方组件库支持。

			
		

	





	

		

			

				
					
C# QRCode、DataMatrix和其他条形码的生成和解码软件

				
			

			

				

					weixin_33881753的博客
				

				

					12-26
					
					1093
					
				

			

		

		

			
				
今天制造了一个C#的软件，具体是用于生成二维码和条形码的，包括常用的QRCode、DataMatrix、Code128、EAN-8等等。
使用的第三方类库是Zxing.net和DataMatrix.net；另外，程序中也用了委托。
（这两个类库可以在VS2015的NuGet管理器中下载）
但说明一下，其中发现PDF_417是有问题，具体问题是生成的条形码，再解析为字符串时，前面多了“A ”，...

			
		

	





	

		

			

				
					
vc++datamatrix二维码识别

				
			

			

				

					Keivin
				

				

					01-25
					
					2358
					
				

			

		

		

			
				
VC++开发常用功能一系列文章(欢迎订阅，持续更新...）



zbar zxing都不能识别datamatrix二维码 ，这咱二维码需要专门的库来识别












#include <iostream>
#include "funset.hpp"

int main(int argc, char* argv[])
{
	// Note: windows10 vs2013 will crash, windows7 vs2013 is normal
	//int re...

			
		

	





	

		

			

				
					
C# 生成 DataMatrix 格式的二维码

				
			

			

				

					weixin_30553837的博客
				

				

					06-25
					
					1429
					
				

			

		

		

			
				
该文主要是利用OnBarcode.dll 生成DataMatrix 格式的二维码的一些简单方法和操作技巧。关于QrBarcode的二维码比较常见和简单，网上有很多资源。
1、附件为dll
2、利用上述控件生成二维码的核心代码：
  (a)C#代码:

   DataMatrix datamatrix = new DataMatrix();   datamatrix.Data ...

			
		

	





	

		

			

				
					
zxing.delphi-v_3.0 读取二维条码

				
			

			

				

					07-28
				

			

		

		

			
				
zxing.delphi-v_3.0是一个可以帮助我们在Delphi编程中读取二维条码的开源库。它是基于Google的ZXing项目开发的，ZXing是一个功能强大的用于解码条码的开源库。  使用zxing.delphi-v_3.0读取二维条码非常简便。首先，...

			
		

	



              




          




        



    





    



      

      

        
      

      





	

		评论	
	

	
	




  

    

      添加红包
      
    

    

      

        
        

          
          
        

        
请填写红包祝福语或标题

      

      

        
        

          
          个
        

        
红包个数最小为10个

      

      

        
        

          
          元
        

        
红包金额最低5元

      

      

        
        

          当前余额3.43元
          前往充值 >
        

      

      

        

          需支付：10.00元
        

        
        
      

    

  





  

    
    
  

  

    
    
  








  

    

      

        

          

            
            
成就一亿技术人!

          

          

        

        

          

          

            领取后你会自动成为博主和红包主的粉丝
            规则
          

        

      

      

        

          

            
              
            
            

              
hope_wisdom
 发出的红包
            

          

        

        

          

          

          

        

      

    

    

  



      
      

      
实付元

      
使用余额支付

      

        

          

            
            点击重新获取
          

        

        
扫码支付

      

      

        
          
            
          
          
        
      

      

        
        钱包余额
          0
          

            
            

              

                
抵扣说明：

                
 1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
 2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

              

            

          

      

      余额充值