开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 界面编程 > Static控件 > 查看源码
BarDef.inc
资源名称：Barcode.VCL.component.v1.8.6.48.Full.Source.Delphi　[点击查看]
上传用户：xdwang_66
上传日期：2016-04-26
资源大小：1726k
文件大小：31k
源码类别：

Static控件

开发平台：

Delphi

BarDef.inc：源码内容
  1. // =============================================================================
  2. //
  3. // Barcode VCL Component
  4. //
  5. // For Delphi 4/5/6/7, C++ Builder 4/5/6, BDS 2005/2005, Turbo Delphi 2006
  6. //
  7. // Copyright (c) 2001, 2007  Han-soft Software, all rights reserved.
  8. //
  9. // $Rev: 44 $   $Id: BarDef.inc 44 2007-01-16 01:16:04Z hanjy $
  10. //
  11. // =============================================================================
  13. {********************}
  14. {  For make barcode  }
  15. {********************}
  17. { Convert codebar data }
  18. function Convert(const s:string):string;
  19. var
  20.   i, v : integer;
  21. begin
  22.   Result := s;  { same Length as Input - string }
  23.   for i:=1 to Length(s) do
  24.   begin
  25.     v := ord(s[i]) - 1;
  27.     if odd(i) then
  28.       Inc(v, 5);
  29.     Result[i] := Chr(v);
  30.   end;
  31. end;
  33. { Calculate sum of digitally }
  34. function quersumme(x:integer):integer;
  35. var
  36.   sum:integer;
  37. begin
  38.   sum := 0;
  39.   while x > 0 do
  40.   begin
  41.     sum := sum + (x mod 10);
  42.     x := x div 10;
  43.   end;
  44.   result := sum;
  45. end;
  47. { Calculate checksum }
  48. function CheckSumModulo10(const data:string):string;
  49. var
  50.   i,fak,sum : Integer;
  51. begin
  52.   sum := 0;
  53.   fak := Length(data);
  54.   for i:=1 to Length(data) do
  55.   begin
  56.     if (fak mod 2) = 0 then
  57.       sum := sum + (StrToInt(data[i])*1)
  58.     else
  59.       sum := sum + (StrToInt(data[i])*3);
  60.     dec(fak);
  61.   end;
  62.   if (sum mod 10) = 0 then
  63.     result := data+'0'
  64.   else
  65.     result := data+IntToStr(10-(sum mod 10));
  66. end;
  68. { Get checksum }
  69. function DoCheckSumming(const CS_CheckSum:TCheckSum; const data:string):string;
  70. begin
  71.   case CS_CheckSum of
  72.     csNone:
  73.       Result := data;
  74.     csModulo10:
  75.       Result := CheckSumModulo10(data);
  76.   end;
  77. end;
  79. { Assist function for Get barcode data }
  80. function SetLen(pI:byte; HL_BarCode:string):string;
  81. begin
  82.   Result := StringOfChar('0', pI-Length(HL_BarCode)) + HL_BarCode;
  83. end;
  85. { Assist function for get UPC data }
  86. function getSupp(Nr : String) : String;
  87. var
  88.   i,fak,sum : Integer;
  89.   tmp   : string;
  90. begin
  91.   sum := 0;
  92.   tmp := copy(Nr,1,Length(Nr)-1);
  93.   fak := Length(tmp);
  94.   for i:=1 to length(tmp) do
  95.   begin
  96.     if (fak mod 2) = 0 then
  97.       sum := sum + (StrToInt(tmp[i])*9)
  98.     else
  99.       sum := sum + (StrToInt(tmp[i])*3);
  100.     dec(fak);
  101.   end;
  102.   sum:=((sum mod 10) mod 10) mod 10;
  103.   result := tmp+IntToStr(sum);
  104. end;
  106. {********************}
  107. {  For EAN           }
  108. {********************}
  110. { Pattern for Barcode EAN Charset A - L1   S1   L2   S2 }
  111. const tabelle_EAN_A:array['0'..'9'] of string =
  112.   (
  113.   ('2605'),    { 0 }
  114.   ('1615'),    { 1 }
  115.   ('1516'),    { 2 }
  116.   ('0805'),    { 3 }
  117.   ('0526'),    { 4 }
  118.   ('0625'),    { 5 }
  119.   ('0508'),    { 6 }
  120.   ('0706'),    { 7 }
  121.   ('0607'),    { 8 }
  122.   ('2506')     { 9 }
  123.   );
  125. { Pattern for Barcode EAN Charset B - S1   L1   S2   L2 }
  126. const tabelle_EAN_B:array['0'..'9'] of string =
  127.   (
  128.   ('0517'),    { 0 }
  129.   ('0616'),    { 1 }
  130.   ('1606'),    { 2 }
  131.   ('0535'),    { 3 }
  132.   ('1705'),    { 4 }
  133.   ('0715'),    { 5 }
  134.   ('3505'),    { 6 }
  135.   ('1525'),    { 7 }
  136.   ('2515'),    { 8 }
  137.   ('1507')     { 9 }
  138.   );
  140. { Pattern for Barcode EAN Charset C - S1   L1   S2   L2 }
  141. const tabelle_EAN_C:array['0'..'9'] of string =
  142.   (
  143.   ('7150' ),    { 0 }
  144.   ('6160' ),    { 1 }
  145.   ('6061' ),    { 2 }
  146.   ('5350' ),    { 3 }
  147.   ('5071' ),    { 4 }
  148.   ('5170' ),    { 5 }
  149.   ('5053' ),    { 6 }
  150.   ('5251' ),    { 7 }
  151.   ('5152' ),    { 8 }
  152.   ('7051' )     { 9 }
  153.   );
  155. { Get EAN8 data }
  156. function  Code_EAN8(const H_BarCode:string; const H_CheckSum:TCheckSum):string;
  157. var
  158.   i : integer;
  159.   tmp : String;
  160. begin
  161.   if H_CheckSum <> csNone then
  162.   begin
  163.     tmp := SetLen(7,H_BarCode);
  164.     tmp := DoCheckSumming(H_CheckSum,copy(tmp,length(tmp)-6,7));
  165.   end
  166.   else
  167.     tmp := SetLen(8,H_BarCode);
  169.   Assert(Length(tmp)=8, 'EAN8 : ' + ErrorLength);
  171.   result := '505';   {Startcode}
  173.   for i:=1 to 4 do
  174.     result := result + tabelle_EAN_A[tmp[i]] ;
  176.   result := result + '05050';   {Center Guard Pattern}
  178.   for i:=5 to 8 do
  179.     result := result + tabelle_EAN_C[tmp[i]] ;
  181.   result := result + '505';   {Stopcode}
  182. end;
  184. { Pattern for Barcode EAN 13 }
  185. const tabelle_ParityEAN13:array[0..9, 1..6] of char =
  186.   (
  187.   ('A', 'A', 'A', 'A', 'A', 'A'),    { 0 }
  188.   ('A', 'A', 'B', 'A', 'B', 'B'),    { 1 }
  189.   ('A', 'A', 'B', 'B', 'A', 'B'),    { 2 }
  190.   ('A', 'A', 'B', 'B', 'B', 'A'),    { 3 }
  191.   ('A', 'B', 'A', 'A', 'B', 'B'),    { 4 }
  192.   ('A', 'B', 'B', 'A', 'A', 'B'),    { 5 }
  193.   ('A', 'B', 'B', 'B', 'A', 'A'),    { 6 }
  194.   ('A', 'B', 'A', 'B', 'A', 'B'),    { 7 }
  195.   ('A', 'B', 'A', 'B', 'B', 'A'),    { 8 }
  196.   ('A', 'B', 'B', 'A', 'B', 'A')     { 9 }
  197.   );
  199. { Get EAN13 data}
  200. function  Code_EAN13(const H_BarCode:string; const H_CheckSum:TCheckSum):string;
  201. var
  202.   i, LK: integer;
  203.   tmp : String;
  204. begin
  205.   if H_CheckSum <> csNone then
  206.   begin
  207.     tmp := SetLen(12,H_BarCode);
  208.     tmp := DoCheckSumming(H_CheckSum, tmp);
  209.   end
  210.   else
  211.     tmp := SetLen(13,H_BarCode);
  213.   Assert(Length(tmp) = 13, 'EAN13 : ' + ErrorLength);
  215.   LK := StrToInt(tmp[1]);
  216.   tmp := copy(tmp,2,12);
  218.   result := '505';   {Startcode}
  220.   for i:=1 to 6 do
  221.   begin
  222.     case tabelle_ParityEAN13[LK,i] of
  223.       'A' : result := result + tabelle_EAN_A[tmp[i]];
  224.       'B' : result := result + tabelle_EAN_B[tmp[i]] ;
  225.       'C' : result := result + tabelle_EAN_C[tmp[i]] ;
  226.   end;
  227.   end;
  229.   result := result + '05050';   {Center Guard Pattern}
  231.   for i:=7 to 12 do
  232.     result := result + tabelle_EAN_C[tmp[i]] ;
  234.     result := result + '505';   {Stopcode}
  235. end;
  237. {********************}
  238. {  For Code 25       }
  239. {********************}
  241. {Pattern for Barcode 2 of 5}
  242. const tabelle_2_5:array['0'..'9', 1..5] of char =
  243.   (
  244.   ('0', '0', '1', '1', '0'),    {'0'}
  245.   ('1', '0', '0', '0', '1'),    {'1'}
  246.   ('0', '1', '0', '0', '1'),    {'2'}
  247.   ('1', '1', '0', '0', '0'),    {'3'}
  248.   ('0', '0', '1', '0', '1'),    {'4'}
  249.   ('1', '0', '1', '0', '0'),    {'5'}
  250.   ('0', '1', '1', '0', '0'),    {'6'}
  251.   ('0', '0', '0', '1', '1'),    {'7'}
  252.   ('1', '0', '0', '1', '0'),    {'8'}
  253.   ('0', '1', '0', '1', '0')     {'9'}
  254.   );
  256. { Get Code25 interleaved data }
  257. function  Code_2_5_interleaved(const H_BarCode:string):string;
  258. var
  259.   i, j: integer;
  260.   c : char;
  262. begin
  263.   result := '5050';   {Startcode}
  265.   for i:=1 to Length(H_BarCode) div 2 do
  266.   begin
  267.     for j:= 1 to 5 do
  268.     begin
  269.       if tabelle_2_5[H_BarCode[i*2-1], j] = '1' then
  270.         c := '6'
  271.       else
  272.         c := '5';
  273.       result := result + c;
  274.       if tabelle_2_5[H_BarCode[i*2], j] = '1' then
  275.         c := '1'
  276.       else
  277.         c := '0';
  278.       result := result + c;
  279.     end;
  280.   end;
  282.   result := result + '605';    {Stopcode}
  283. end;
  285. { Get Code25 industrial data }
  286. function  Code_2_5_industrial(const H_BarCode:string):string;
  287. var
  288.   i, j: integer;
  289. begin
  290.   result := '606050';   {Startcode}
  292.   for i:=1 to Length(H_BarCode) do
  293.   begin
  294.     for j:= 1 to 5 do
  295.     begin
  296.     if tabelle_2_5[H_BarCode[i], j] = '1' then
  297.       result := result + '60'
  298.     else
  299.       result := result + '50';
  300.     end;
  301.   end;
  303.   result := result + '605060';   {Stopcode}
  304. end;
  306. { Get Code25 matrix data }
  307. function  Code_2_5_matrix(const H_BarCode:string):string;
  308. var
  309.   i, j: integer;
  310.   c :char;
  311. begin
  312.   result := '705050';   {Startcode}
  314.   for i:=1 to Length(H_BarCode) do
  315.   begin
  316.     for j:= 1 to 5 do
  317.     begin
  318.       if tabelle_2_5[H_BarCode[i], j] = '1' then
  319.         c := '1'
  320.       else
  321.         c := '0';
  323.       if odd(j) then
  324.         c := chr(ord(c)+5);
  325.       result := result + c;
  326.     end;
  327.    result := result + '0';
  328.   end;
  330.   result := result + '70505';   {Stopcode}
  331. end;
  333. {********************}
  334. {  For Code 39       }
  335. {********************}
  337. { Get Code39  data }
  338. function  Code_39(const H_BarCode:string; const H_CheckSum:TCheckSum):string;
  340. type TCode39 =
  341.   record
  342.     c : char;
  343.     data : array[0..9] of char;
  344.     chk: shortint;
  345.   end;
  347. const tabelle_39: array[0..43] of TCode39 = (
  348.   ( c:'0'; data:'505160605'; chk:0 ),
  349.   ( c:'1'; data:'605150506'; chk:1 ),
  350.   ( c:'2'; data:'506150506'; chk:2 ),
  351.   ( c:'3'; data:'606150505'; chk:3 ),
  352.   ( c:'4'; data:'505160506'; chk:4 ),
  353.   ( c:'5'; data:'605160505'; chk:5 ),
  354.   ( c:'6'; data:'506160505'; chk:6 ),
  355.   ( c:'7'; data:'505150606'; chk:7 ),
  356.   ( c:'8'; data:'605150605'; chk:8 ),
  357.   ( c:'9'; data:'506150605'; chk:9 ),
  358.   ( c:'A'; data:'605051506'; chk:10),
  359.   ( c:'B'; data:'506051506'; chk:11),
  360.   ( c:'C'; data:'606051505'; chk:12),
  361.   ( c:'D'; data:'505061506'; chk:13),
  362.   ( c:'E'; data:'605061505'; chk:14),
  363.   ( c:'F'; data:'506061505'; chk:15),
  364.   ( c:'G'; data:'505051606'; chk:16),
  365.   ( c:'H'; data:'605051605'; chk:17),
  366.   ( c:'I'; data:'506051605'; chk:18),
  367.   ( c:'J'; data:'505061605'; chk:19),
  368.   ( c:'K'; data:'605050516'; chk:20),
  369.   ( c:'L'; data:'506050516'; chk:21),
  370.   ( c:'M'; data:'606050515'; chk:22),
  371.   ( c:'N'; data:'505060516'; chk:23),
  372.   ( c:'O'; data:'605060515'; chk:24),
  373.   ( c:'P'; data:'506060515'; chk:25),
  374.   ( c:'Q'; data:'505050616'; chk:26),
  375.   ( c:'R'; data:'605050615'; chk:27),
  376.   ( c:'S'; data:'506050615'; chk:28),
  377.   ( c:'T'; data:'505060615'; chk:29),
  378.   ( c:'U'; data:'615050506'; chk:30),
  379.   ( c:'V'; data:'516050506'; chk:31),
  380.   ( c:'W'; data:'616050505'; chk:32),
  381.   ( c:'X'; data:'515060506'; chk:33),
  382.   ( c:'Y'; data:'615060505'; chk:34),
  383.   ( c:'Z'; data:'516060505'; chk:35),
  384.   ( c:'-'; data:'515050606'; chk:36),
  385.   ( c:'.'; data:'615050605'; chk:37),
  386.   ( c:' '; data:'516050605'; chk:38),
  387.   ( c:'*'; data:'515060605'; chk:0 ),
  388.   ( c:'$'; data:'515151505'; chk:39),
  389.   ( c:'/'; data:'515150515'; chk:40),
  390.   ( c:'+'; data:'515051515'; chk:41),
  391.   ( c:'%'; data:'505151515'; chk:42)
  392.   );
  394. function FindIdx(z:char):integer;
  395. var
  396.   i:integer;
  397. begin
  398.   for i:=0 to High(tabelle_39) do
  399.   begin
  400.     if z = tabelle_39[i].c then
  401.     begin
  402.       result := i;
  403.       exit;
  404.     end;
  405.   end;
  406.   result := -1;
  407. end;
  409. var
  410.   i, idx : integer;
  411.   checksum:integer;
  413. begin
  414.   checksum := 0;
  415.   {Startcode}
  416.   result := tabelle_39[FindIdx('*')].data + '0';
  418.   for i:=1 to Length(H_BarCode) do
  419.   begin
  420.     idx := FindIdx(H_BarCode[i]);
  421.     if idx < 0 then
  422.       continue;
  423.     result := result + tabelle_39[idx].data + '0';
  424.     Inc(checksum, tabelle_39[idx].chk);
  425.   end;
  427.   {Calculate Checksum Data}
  428.   if H_CheckSum <> csNone then
  429.     begin
  430.     checksum := checksum mod 43;
  431.     for i:=0 to High(tabelle_39) do
  432.       if checksum = tabelle_39[i].chk then
  433.       begin
  434.         result := result + tabelle_39[i].data + '0';
  435.         break;
  436.       end;
  437.     end;
  439.   {Stopcode}
  440.   result := result + tabelle_39[FindIdx('*')].data;
  441. end;
  443. { Get Code39 extended data }
  444. function  Code_39Extended(const H_BarCode:string;
  445.   const H_CheckSum:TCheckSum):string;
  446. const code39x : array[0..127] of string[2] =
  447.   (
  448.   ('%U'), ('$A'), ('$B'), ('$C'), ('$D'), ('$E'), ('$F'), ('$G'),
  449.   ('$H'), ('$I'), ('$J'), ('$K'), ('$L'), ('$M'), ('$N'), ('$O'),
  450.   ('$P'), ('$Q'), ('$R'), ('$S'), ('$T'), ('$U'), ('$V'), ('$W'),
  451.   ('$X'), ('$Y'), ('$Z'), ('%A'), ('%B'), ('%C'), ('%D'), ('%E'),
  452.    (' '), ('/A'), ('/B'), ('/C'), ('/D'), ('/E'), ('/F'), ('/G'),
  453.   ('/H'), ('/I'), ('/J'), ('/K'), ('/L'), ('/M'), ('/N'), ('/O'),
  454.   ( '0'),  ('1'),  ('2'),  ('3'),  ('4'),  ('5'),  ('6'),  ('7'),
  455.    ('8'),  ('9'), ('/Z'), ('%F'), ('%G'), ('%H'), ('%I'), ('%J'),
  456.   ('%V'),  ('A'),  ('B'),  ('C'),  ('D'),  ('E'),  ('F'),  ('G'),
  457.    ('H'),  ('I'),  ('J'),  ('K'),  ('L'),  ('M'),  ('N'),  ('O'),
  458.    ('P'),  ('Q'),  ('R'),  ('S'),  ('T'),  ('U'),  ('V'),  ('W'),
  459.    ('X'),  ('Y'),  ('Z'), ('%K'), ('%L'), ('%M'), ('%N'), ('%O'),
  460.   ('%W'), ('+A'), ('+B'), ('+C'), ('+D'), ('+E'), ('+F'), ('+G'),
  461.   ('+H'), ('+I'), ('+J'), ('+K'), ('+L'), ('+M'), ('+N'), ('+O'),
  462.   ('+P'), ('+Q'), ('+R'), ('+S'), ('+T'), ('+U'), ('+V'), ('+W'),
  463.   ('+X'), ('+Y'), ('+Z'), ('%P'), ('%Q'), ('%R'), ('%S'), ('%T')
  464.   );
  465. var
  466.   tmp:string;
  467.   i : integer;
  468. begin
  469.   tmp := '';
  470.   for i:=1 to Length(H_BarCode) do
  471.   begin
  472.     if ord(H_BarCode[i]) <= 127 then
  473.       tmp := tmp + code39x[ord(H_BarCode[i])];
  474.   end;
  475.   result := Code_39(tmp,H_CheckSum);
  476. end;
  478. {********************}
  479. {  For Code 128      }
  480. {********************}
  482. { Get Code128 data }
  483. function  Code_128(const H_BarType:TBarType; const H_BarCode:string;
  484.   const H_CheckSum:TCheckSum; var H_CheckNum:string):string;
  486.   type TCode128 =
  487.   record
  488.     a, b : char;
  489.     c : string[2];
  490.     data : string[6];
  491.   end;
  493. const tabelle_128: array[0..102] of TCode128 = (
  494.   ( a:' '; b:' '; c:'00'; data:'212222' ),
  495.   ( a:'!'; b:'!'; c:'01'; data:'222122' ),
  496.   ( a:'"'; b:'"'; c:'02'; data:'222221' ),
  497.   ( a:'#'; b:'#'; c:'03'; data:'121223' ),
  498.   ( a:'$'; b:'$'; c:'04'; data:'121322' ),
  499.   ( a:'%'; b:'%'; c:'05'; data:'131222' ),
  500.   ( a:'&'; b:'&'; c:'06'; data:'122213' ),
  501.   ( a:''''; b:''''; c:'07'; data:'122312'),
  502.   ( a:'('; b:'('; c:'08'; data:'132212' ),
  503.   ( a:')'; b:')'; c:'09'; data:'221213' ),
  504.   ( a:'*'; b:'*'; c:'10'; data:'221312' ),
  505.   ( a:'+'; b:'+'; c:'11'; data:'231212' ),
  506.   ( a:','; b:','; c:'12'; data:'112232' ),
  507.   ( a:'-'; b:'-'; c:'13'; data:'122132' ),
  508.   ( a:'.'; b:'.'; c:'14'; data:'122231' ),
  509.   ( a:'/'; b:'/'; c:'15'; data:'113222' ),
  510.   ( a:'0'; b:'0'; c:'16'; data:'123122' ),
  511.   ( a:'1'; b:'1'; c:'17'; data:'123221' ),
  512.   ( a:'2'; b:'2'; c:'18'; data:'223211' ),
  513.   ( a:'3'; b:'3'; c:'19'; data:'221132' ),
  514.   ( a:'4'; b:'4'; c:'20'; data:'221231' ),
  515.   ( a:'5'; b:'5'; c:'21'; data:'213212' ),
  516.   ( a:'6'; b:'6'; c:'22'; data:'223112' ),
  517.   ( a:'7'; b:'7'; c:'23'; data:'312131' ),
  518.   ( a:'8'; b:'8'; c:'24'; data:'311222' ),
  519.   ( a:'9'; b:'9'; c:'25'; data:'321122' ),
  520.   ( a:':'; b:':'; c:'26'; data:'321221' ),
  521.   ( a:';'; b:';'; c:'27'; data:'312212' ),
  522.   ( a:'<'; b:'<'; c:'28'; data:'322112' ),
  523.   ( a:'='; b:'='; c:'29'; data:'322211' ),
  524.   ( a:'>'; b:'>'; c:'30'; data:'212123' ),
  525.   ( a:'?'; b:'?'; c:'31'; data:'212321' ),
  526.   ( a:'@'; b:'@'; c:'32'; data:'232121' ),
  527.   ( a:'A'; b:'A'; c:'33'; data:'111323' ),
  528.   ( a:'B'; b:'B'; c:'34'; data:'131123' ),
  529.   ( a:'C'; b:'C'; c:'35'; data:'131321' ),
  530.   ( a:'D'; b:'D'; c:'36'; data:'112313' ),
  531.   ( a:'E'; b:'E'; c:'37'; data:'132113' ),
  532.   ( a:'F'; b:'F'; c:'38'; data:'132311' ),
  533.   ( a:'G'; b:'G'; c:'39'; data:'211313' ),
  534.   ( a:'H'; b:'H'; c:'40'; data:'231113' ),
  535.   ( a:'I'; b:'I'; c:'41'; data:'231311' ),
  536.   ( a:'J'; b:'J'; c:'42'; data:'112133' ),
  537.   ( a:'K'; b:'K'; c:'43'; data:'112331' ),
  538.   ( a:'L'; b:'L'; c:'44'; data:'132131' ),
  539.   ( a:'M'; b:'M'; c:'45'; data:'113123' ),
  540.   ( a:'N'; b:'N'; c:'46'; data:'113321' ),
  541.   ( a:'O'; b:'O'; c:'47'; data:'133121' ),
  542.   ( a:'P'; b:'P'; c:'48'; data:'313121' ),
  543.   ( a:'Q'; b:'Q'; c:'49'; data:'211331' ),
  544.   ( a:'R'; b:'R'; c:'50'; data:'231131' ),
  545.   ( a:'S'; b:'S'; c:'51'; data:'213113' ),
  546.   ( a:'T'; b:'T'; c:'52'; data:'213311' ),
  547.   ( a:'U'; b:'U'; c:'53'; data:'213131' ),
  548.   ( a:'V'; b:'V'; c:'54'; data:'311123' ),
  549.   ( a:'W'; b:'W'; c:'55'; data:'311321' ),
  550.   ( a:'X'; b:'X'; c:'56'; data:'331121' ),
  551.   ( a:'Y'; b:'Y'; c:'57'; data:'312113' ),
  552.   ( a:'Z'; b:'Z'; c:'58'; data:'312311' ),
  553.   ( a:'['; b:'['; c:'59'; data:'332111' ),
  554.   ( a:''; b:''; c:'60'; data:'314111' ),
  555.   ( a:']'; b:']'; c:'61'; data:'221411' ),
  556.   ( a:'^'; b:'^'; c:'62'; data:'431111' ),
  557.   ( a:'_'; b:'_'; c:'63'; data:'111224' ),
  558.   ( a:' '; b:'`'; c:'64'; data:'111422' ),
  559.   ( a:' '; b:'a'; c:'65'; data:'121124' ),
  560.   ( a:' '; b:'b'; c:'66'; data:'121421' ),
  561.   ( a:' '; b:'c'; c:'67'; data:'141122' ),
  562.   ( a:' '; b:'d'; c:'68'; data:'141221' ),
  563.   ( a:' '; b:'e'; c:'69'; data:'112214' ),
  564.   ( a:' '; b:'f'; c:'70'; data:'112412' ),
  565.   ( a:' '; b:'g'; c:'71'; data:'122114' ),
  566.   ( a:' '; b:'h'; c:'72'; data:'122411' ),
  567.   ( a:' '; b:'i'; c:'73'; data:'142112' ),
  568.   ( a:' '; b:'j'; c:'74'; data:'142211' ),
  569.   ( a:' '; b:'k'; c:'75'; data:'241211' ),
  570.   ( a:' '; b:'l'; c:'76'; data:'221114' ),
  571.   ( a:' '; b:'m'; c:'77'; data:'413111' ),
  572.   ( a:' '; b:'n'; c:'78'; data:'241112' ),
  573.   ( a:' '; b:'o'; c:'79'; data:'134111' ),
  574.   ( a:' '; b:'p'; c:'80'; data:'111242' ),
  575.   ( a:' '; b:'q'; c:'81'; data:'121142' ),
  576.   ( a:' '; b:'r'; c:'82'; data:'121241' ),
  577.   ( a:' '; b:'s'; c:'83'; data:'114212' ),
  578.   ( a:' '; b:'t'; c:'84'; data:'124112' ),
  579.   ( a:' '; b:'u'; c:'85'; data:'124211' ),
  580.   ( a:' '; b:'v'; c:'86'; data:'411212' ),
  581.   ( a:' '; b:'w'; c:'87'; data:'421112' ),
  582.   ( a:' '; b:'x'; c:'88'; data:'421211' ),
  583.   ( a:' '; b:'y'; c:'89'; data:'212141' ),
  584.   ( a:' '; b:'z'; c:'90'; data:'214121' ),
  585.   ( a:' '; b:'{'; c:'91'; data:'412121' ),
  586.   ( a:' '; b:'|'; c:'92'; data:'111143' ),
  587.   ( a:' '; b:'}'; c:'93'; data:'111341' ),
  588.   ( a:' '; b:'~'; c:'94'; data:'131141' ),
  589.   ( a:' '; b:' '; c:'95'; data:'114113' ),     { US,DEL,95 }
  590.   ( a:' '; b:' '; c:'96'; data:'114311' ),     { FNC3,FNC3,96 }
  591.   ( a:' '; b:' '; c:'97'; data:'411113' ),     { FNC2,FNC2,97 }
  592.   ( a:' '; b:' '; c:'98'; data:'411311' ),     { Shift,Shift,98 }
  593.   ( a:' '; b:' '; c:'99'; data:'113141' ),     { CodeC,CodeC,99 }
  594.   ( a:' '; b:' '; c:'CB'; data:'114131' ),     { CodeB,FNC4,CodeB }
  595.   ( a:' '; b:' '; c:'CA'; data:'311141' ),     { FNC4,CodeA,CodeA }
  596.   ( a:' '; b:' '; c:'F1'; data:'411131' )      { FNC1 }
  597.   );
  599. StartA = '211412';
  600. StartB = '211214';
  601. StartC = '211232';
  602. Stop   = '2331112';
  604. { Find Code 128 Codeset A or B }
  605. function Find_Code128AB(c:char; const H1_BarType:TBarType):integer;
  606. var
  607.   i:integer;
  608.   v:char;
  609. begin
  610.   for i:=0 to High(tabelle_128) do
  611.   begin
  612.     if H1_BarType = bcCode128A then
  613.       v := tabelle_128[i].a
  614.     else
  615.       v := tabelle_128[i].b;
  617.     if c = v then
  618.     begin
  619.       result := i;
  620.       exit;
  621.     end;
  622.     {Upgrade to 1.7.3 ->}
  623.     if Ord(c) >= 195 then
  624.     begin
  625.       result := Ord(c) - 100;
  626.       exit
  627.     end;
  628.     {Upgrade to 1.7.3 <-}
  629.   end;
  630.   result := -1;
  631. end;
  633. { Find Code 128 Codeset C }
  634. function Find_Code128C(c:string):integer;
  635. var
  636.   i:integer;
  637. begin
  638.   for i:=0 to High(tabelle_128) do begin
  639.     if tabelle_128[i].c = c then begin
  640.      result := i;
  641.      exit;
  642.     end;
  643.   end;
  644.   result := -1;
  645. end;
  647. var
  648.   i, j, idx: integer;
  649.   startcode:string;
  650.   checksum : integer;
  651.   codeword_pos : integer;
  652.   bar: string;
  653. begin
  655.   bar := H_BarCode;
  656.   case H_BarType of
  657.     bcCode128A, bcCodeEAN128A:
  658.       begin checksum := 103; startcode:= StartA; end;
  659.     bcCode128B, bcCodeEAN128B:
  660.       begin checksum := 104; startcode:= StartB; end;
  661.     bcCode128C, bcCodeEAN128C:
  662.       begin checksum := 105; startcode:= StartC; end;
  663.     else
  664.       raise Exception.CreateFmt('%s : %s', ['Code_128 : ',ErrorBarType]);
  665.   end;
  667.   result := startcode;
  668.   codeword_pos := 1;
  670.   case H_BarType of
  671.     bcCodeEAN128A,
  672.     bcCodeEAN128B,
  673.     bcCodeEAN128C:
  674.     begin
  675.       result := result + tabelle_128[102].data;
  676.       Inc(checksum, 102*codeword_pos);
  677.       Inc(codeword_pos);
  678.       if H_CheckSum <> csNone then bar:=DoCheckSumming(H_CheckSum, bar);
  679.     end;
  680.   end;
  682.   if (H_BarType = bcCode128C) or (H_BarType = bccodeEAN128C) then
  683.   begin
  684.     if (Length(bar) mod 2<>0) then bar :='0' + bar;
  685.     for i:=1 to (Length(bar) div 2) do
  686.     begin
  687.       j:=(i-1)*2+1;
  688.       idx:=Find_Code128C(copy(bar,j,2));
  689.       if idx < 0 then idx := Find_Code128C('00');
  690.       result := result + tabelle_128[idx].data;
  691.       Inc(checksum, idx*codeword_pos);
  692.       Inc(codeword_pos);
  693.     end;
  694.   end
  695.   else
  696.     for i:=1 to Length(bar) do
  697.     begin
  698.       idx := Find_Code128AB(bar[i],H_BarType);
  699.       if idx < 0 then
  700.         idx := Find_Code128AB(' ',H_BarType);
  701.       result := result + tabelle_128[idx].data;
  702.       Inc(checksum, idx*codeword_pos);
  703.       Inc(codeword_pos);
  704.     end;
  706.   checksum := checksum mod 103;
  707.   result := result + tabelle_128[checksum].data;
  709.   result := result + Stop;
  710.   Result := Convert(Result);
  711.   H_CheckNum := bar;
  712. end;
  714. {********************}
  715. {  For Code 93       }
  716. {********************}
  718. { Get Code93 data }
  719. function  Code_93(const H_BarCode:string):string;
  720. type TCode93 =
  721.   record
  722.     c : char;
  723.     data : array[0..5] of char;
  724.   end;
  726. const tabelle_93: array[0..46] of TCode93 = (
  727.   ( c:'0'; data:'131112'  ),
  728.   ( c:'1'; data:'111213'  ),
  729.   ( c:'2'; data:'111312'  ),
  730.   ( c:'3'; data:'111411'  ),
  731.   ( c:'4'; data:'121113'  ),
  732.   ( c:'5'; data:'121212'  ),
  733.   ( c:'6'; data:'121311'  ),
  734.   ( c:'7'; data:'111114'  ),
  735.   ( c:'8'; data:'131211'  ),
  736.   ( c:'9'; data:'141111'  ),
  737.   ( c:'A'; data:'211113'  ),
  738.   ( c:'B'; data:'211212'  ),
  739.   ( c:'C'; data:'211311'  ),
  740.   ( c:'D'; data:'221112'  ),
  741.   ( c:'E'; data:'221211'  ),
  742.   ( c:'F'; data:'231111'  ),
  743.   ( c:'G'; data:'112113'  ),
  744.   ( c:'H'; data:'112212'  ),
  745.   ( c:'I'; data:'112311'  ),
  746.   ( c:'J'; data:'122112'  ),
  747.   ( c:'K'; data:'132111'  ),
  748.   ( c:'L'; data:'111123'  ),
  749.   ( c:'M'; data:'111222'  ),
  750.   ( c:'N'; data:'111321'  ),
  751.   ( c:'O'; data:'121122'  ),
  752.   ( c:'P'; data:'131121'  ),
  753.   ( c:'Q'; data:'212112'  ),
  754.   ( c:'R'; data:'212211'  ),
  755.   ( c:'S'; data:'211122'  ),
  756.   ( c:'T'; data:'211221'  ),
  757.   ( c:'U'; data:'221121'  ),
  758.   ( c:'V'; data:'222111'  ),
  759.   ( c:'W'; data:'112122'  ),
  760.   ( c:'X'; data:'112221'  ),
  761.   ( c:'Y'; data:'122121'  ),
  762.   ( c:'Z'; data:'123111'  ),
  763.   ( c:'-'; data:'121131'  ),
  764.   ( c:'.'; data:'311112'  ),
  765.   ( c:' '; data:'311211'  ),
  766.   ( c:'$'; data:'321111'  ),
  767.   ( c:'/'; data:'112131'  ),
  768.   ( c:'+'; data:'113121'  ),
  769.   ( c:'%'; data:'211131'  ),
  770.   ( c:'['; data:'121221'  ),   {only used for Extended Code 93}
  771.   ( c:']'; data:'312111'  ),   {only used for Extended Code 93}
  772.   ( c:'{'; data:'311121'  ),   {only used for Extended Code 93}
  773.   ( c:'}'; data:'122211'  )    {only used for Extended Code 93}
  774.   );
  777. {Find Code 93}
  778. function Find_Code93(c:char):integer;
  779. var
  780.   i:integer;
  781. begin
  782.   for i:=0 to High(tabelle_93) do
  783.   begin
  784.     if c = tabelle_93[i].c then
  785.     begin
  786.       result := i;
  787.       exit;
  788.     end;
  789.   end;
  790.   result := -1;
  791. end;
  793. var
  794.   i, idx : integer;
  795.   checkC, checkK,   {Checksums}
  796.   weightC, weightK : integer;
  797. begin
  799.   result := '111141';   {Startcode}
  801.   for i:=1 to Length(H_BarCode) do
  802.   begin
  803.     idx := Find_Code93(H_BarCode[i]);
  804.     if idx < 0 then
  805.       raise Exception.CreateFmt('%s : %s', [H_BarCode, ErrorCode93]);
  806.     result := result + tabelle_93[idx].data;
  807.   end;
  809.   checkC := 0;
  810.   checkK := 0;
  812.   weightC := 1;
  813.   weightK := 2;
  815.   for i:=Length(H_BarCode) downto 1 do
  816.   begin
  817.     idx := Find_Code93(H_BarCode[i]);
  819.     Inc(checkC, idx*weightC);
  820.     Inc(checkK, idx*weightK);
  822.     Inc(weightC);
  823.     if weightC > 20 then weightC := 1;
  824.     Inc(weightK);
  825.     if weightK > 15 then weightC := 1;
  826.   end;
  828.   Inc(checkK, checkC);
  830.   checkC := checkC mod 47;
  831.   checkK := checkK mod 47;
  833.   result := result + tabelle_93[checkC].data +
  834.     tabelle_93[checkK].data;
  836.   result := result + '1111411';   {Stopcode}
  837.   Result := Convert(Result);
  838. end;
  840. { Get Code93 extended data }
  841. function  Code_93Extended(const H_BarCode:string):string;
  843. const code93x : array[0..127] of string[2] =
  844.   (
  845.   (']U'), ('[A'), ('[B'), ('[C'), ('[D'), ('[E'), ('[F'), ('[G'),
  846.   ('[H'), ('[I'), ('[J'), ('[K'), ('[L'), ('[M'), ('[N'), ('[O'),
  847.   ('[P'), ('[Q'), ('[R'), ('[S'), ('[T'), ('[U'), ('[V'), ('[W'),
  848.   ('[X'), ('[Y'), ('[Z'), (']A'), (']B'), (']C'), (']D'), (']E'),
  849.    (' '), ('{A'), ('{B'), ('{C'), ('{D'), ('{E'), ('{F'), ('{G'),
  850.   ('{H'), ('{I'), ('{J'), ('{K'), ('{L'), ('{M'), ('{N'), ('{O'),
  851.   ( '0'),  ('1'),  ('2'),  ('3'),  ('4'),  ('5'),  ('6'),  ('7'),
  852.    ('8'),  ('9'), ('{Z'), (']F'), (']G'), (']H'), (']I'), (']J'),
  853.   (']V'),  ('A'),  ('B'),  ('C'),  ('D'),  ('E'),  ('F'),  ('G'),
  854.    ('H'),  ('I'),  ('J'),  ('K'),  ('L'),  ('M'),  ('N'),  ('O'),
  855.    ('P'),  ('Q'),  ('R'),  ('S'),  ('T'),  ('U'),  ('V'),  ('W'),
  856.    ('X'),  ('Y'),  ('Z'), (']K'), (']L'), (']M'), (']N'), (']O'),
  857.   (']W'), ('}A'), ('}B'), ('}C'), ('}D'), ('}E'), ('}F'), ('}G'),
  858.   ('}H'), ('}I'), ('}J'), ('}K'), ('}L'), ('}M'), ('}N'), ('}O'),
  859.   ('}P'), ('}Q'), ('}R'), ('}S'), ('}T'), ('}U'), ('}V'), ('}W'),
  860.   ('}X'), ('}Y'), ('}Z'), (']P'), (']Q'), (']R'), (']S'), (']T')
  861.   );
  863. var
  864.   tmp : string;
  865.   i : integer;
  866. begin
  867.   tmp := '';
  868.   for i:=0 to Length(H_BarCode)-1 do
  869.   begin
  870.     if ord(H_BarCode[i]) <= 127 then
  871.       tmp := tmp + code93x[ord(H_BarCode[i])];
  872.   end;
  873.   result := Code_93(tmp);
  874. end;
  876. {********************}
  877. {  For Code MSI      }
  878. {********************}
  880. { Get Code MSI data }
  881. function  Code_MSI(const H_BarCode:string):string;
  883. const tabelle_MSI:array['0'..'9'] of string[8] =
  884.   (
  885.   ( '51515151' ),    {'0'}
  886.   ( '51515160' ),    {'1'}
  887.   ( '51516051' ),    {'2'}
  888.   ( '51516060' ),    {'3'}
  889.   ( '51605151' ),    {'4'}
  890.   ( '51605160' ),    {'5'}
  891.   ( '51606051' ),    {'6'}
  892.   ( '51606060' ),    {'7'}
  893.   ( '60515151' ),    {'8'}
  894.   ( '60515160' )     {'9'}
  895.   );
  897. var
  898.   i:integer;
  899.   check_even, check_odd, checksum:integer;
  900. begin
  901.   result := '60';    {Startcode}
  902.   check_even := 0;
  903.   check_odd  := 0;
  905.   for i:=1 to Length(H_BarCode) do
  906.   begin
  907.     if odd(i-1) then
  908.       check_odd := check_odd*10+ord(H_BarCode[i])
  909.     else
  910.       check_even := check_even+ord(H_BarCode[i]);
  912.     result := result + tabelle_MSI[H_BarCode[i]];
  913.   end;
  915.   checksum := quersumme(check_odd*2) + check_even;
  917.   checksum := checksum mod 10;
  918.   if checksum > 0 then
  919.     checksum := 10-checksum;
  921.   result := result + tabelle_MSI[chr(ord('0')+checksum)];
  923.   result := result + '515'; {Stopcode}
  924. end;
  926. {********************}
  927. {  For Post Net      }
  928. {********************}
  930. { Get Post Net data }
  931. function  Code_PostNet(const H_BarCode:string):string;
  933. const tabelle_PostNet:array['0'..'9'] of string[10] =
  934.   (
  935.   ( '5151A1A1A1' ),    {'0'}
  936.   ( 'A1A1A15151' ),    {'1'}
  937.   ( 'A1A151A151' ),    {'2'}
  938.   ( 'A1A15151A1' ),    {'3'}
  939.   ( 'A151A1A151' ),    {'4'}
  940.   ( 'A151A151A1' ),    {'5'}
  941.   ( 'A15151A1A1' ),    {'6'}
  942.   ( '51A1A1A151' ),    {'7'}
  943.   ( '51A1A151A1' ),    {'8'}
  944.   ( '51A151A1A1' )     {'9'}
  945.   );
  946. var
  947.   i:integer;
  948. begin
  949.   result := '51';
  951.   for i:=1 to Length(H_BarCode) do
  952.   begin
  953.     result := result + tabelle_PostNet[H_BarCode[i]];
  954.   end;
  955.   result := result + '5';
  956. end;
  959. {********************}
  960. {  For Codabar       }
  961. {********************}
  963. { Get Codabar data }
  964. function  Code_Codabar(const H_BarCode:string):string;
  965. type TCodabar =
  966.   record
  967.     c : char;
  968.     data : array[0..6] of char;
  969.   end;
  971. const tabelle_cb: array[0..19] of TCodabar = (
  972.   ( c:'1'; data:'5050615'  ),
  973.   ( c:'2'; data:'5051506'  ),
  974.   ( c:'3'; data:'6150505'  ),
  975.   ( c:'4'; data:'5060515'  ),
  976.   ( c:'5'; data:'6050515'  ),
  977.   ( c:'6'; data:'5150506'  ),
  978.   ( c:'7'; data:'5150605'  ),
  979.   ( c:'8'; data:'5160505'  ),
  980.   ( c:'9'; data:'6051505'  ),
  981.   ( c:'0'; data:'5050516'  ),
  982.   ( c:'-'; data:'5051605'  ),
  983.   ( c:'$'; data:'5061505'  ),
  984.   ( c:':'; data:'6050606'  ),
  985.   ( c:'/'; data:'6060506'  ),
  986.   ( c:'.'; data:'6060605'  ),
  987.   ( c:'+'; data:'5060606'  ),
  988.   ( c:'A'; data:'5061515'  ),
  989.   ( c:'B'; data:'5151506'  ),
  990.   ( c:'C'; data:'5051516'  ),
  991.   ( c:'D'; data:'5051615'  )
  992.   );
  994. {find Codabar}
  995. function Find_Codabar(c:char):integer;
  996. var
  997.   i:integer;
  998. begin
  999.   for i:=0 to High(tabelle_cb) do
  1000.   begin
  1001.     if c = tabelle_cb[i].c then
  1002.     begin
  1003.       result := i;
  1004.       exit;
  1005.     end;
  1006.   end;
  1007.   result := -1;
  1008. end;
  1010. var
  1011.   i, idx : integer;
  1012. begin
  1013.   result := tabelle_cb[Find_Codabar('A')].data + '0';
  1014.   for i:=1 to Length(H_BarCode) do
  1015.   begin
  1016.     idx := Find_Codabar(H_BarCode[i]);
  1017.     result := result + tabelle_cb[idx].data + '0';
  1018.   end;
  1019.   result := result + tabelle_cb[Find_Codabar('B')].data;
  1020. end;
  1022. {********************}
  1023. {  For Code UPC      }
  1024. {********************}
  1026. { Get Code UPC A data }
  1027. function  Code_UPC_A(const H_BarCode:string; const H_CheckSum:TCheckSum;
  1028.   var H_CheckNum:string):string;
  1029. var
  1030.   i : Integer;
  1031.   tmp, bar : string;
  1032. begin
  1033.   bar := SetLen(12,H_BarCode);
  1034.   if H_CheckSum<>csNone then
  1035.     tmp:=DoCheckSumming(H_CheckSum, copy(bar,1,11))
  1036.   else
  1037.     tmp:=bar;
  1038.   if H_CheckSum<>csNone then H_CheckNum := tmp;
  1039.   result := '505';
  1040.   for i:=1 to 6 do
  1041.     result := result + tabelle_EAN_A[tmp[i]];
  1042.   result := result + '05050';
  1043.   for i:=7 to 12 do
  1044.     result := result + tabelle_EAN_C[tmp[i]];
  1045.   result := result + '505';
  1046. end;
  1049. {UPC E Parity Pattern Table , Number System 0}
  1050. const tabelle_UPC_E0:array['0'..'9', 1..6] of char =
  1051.   (
  1052.   ('E', 'E', 'E', 'o', 'o', 'o' ),    { 0 }
  1053.   ('E', 'E', 'o', 'E', 'o', 'o' ),    { 1 }
  1054.   ('E', 'E', 'o', 'o', 'E', 'o' ),    { 2 }
  1055.   ('E', 'E', 'o', 'o', 'o', 'E' ),    { 3 }
  1056.   ('E', 'o', 'E', 'E', 'o', 'o' ),    { 4 }
  1057.   ('E', 'o', 'o', 'E', 'E', 'o' ),    { 5 }
  1058.   ('E', 'o', 'o', 'o', 'E', 'E' ),    { 6 }
  1059.   ('E', 'o', 'E', 'o', 'E', 'o' ),    { 7 }
  1060.   ('E', 'o', 'E', 'o', 'o', 'E' ),    { 8 }
  1061.   ('E', 'o', 'o', 'E', 'o', 'E' )     { 9 }
  1062.   );
  1064. { Get Code UPC E0 data }
  1065. function  Code_UPC_E0(const H_BarCode:string; const H_CheckSum:TCheckSum;
  1066.   var H_CheckNum:string):string;
  1067. var
  1068.   i,j : integer;
  1069.   tmp, bar : string;
  1070.   c   : char;
  1071. begin
  1072.   bar := SetLen(7,H_BarCode);
  1073.   tmp:=DoCheckSumming(H_CheckSum, Copy(bar,1,6));
  1074.   c:=tmp[7];
  1075.   if H_CheckSum<>csNone then H_CheckNum:=tmp else tmp := bar;
  1076.   result := '505';
  1077.   for i:=1 to 6 do
  1078.   begin
  1079.     if tabelle_UPC_E0[c,i]='E' then
  1080.     begin
  1081.       for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
  1082.     end
  1083.     else
  1084.     begin
  1085.       result := result + tabelle_EAN_A[tmp[i]];
  1086.     end;
  1087.   end;
  1088.   result := result + '050505';
  1089. end;
  1091. { Get Code UPC E1 data }
  1092. function  Code_UPC_E1(const H_BarCode:string; const H_CheckSum:TCheckSum;
  1093.   var H_CheckNum:string):string;
  1094. var
  1095.   i,j : integer;
  1096.   tmp,bar : string;
  1097.   c   : char;
  1098. begin
  1099.   bar := SetLen(7,H_BarCode);
  1100.   tmp :=DoCheckSumming(H_CheckSum, copy(bar,1,6));
  1101.   c:=tmp[7];
  1102.   if H_CheckSum<>csNone then H_CheckNum:=tmp else tmp := bar;
  1103.   result := '505';
  1104.   for i:=1 to 6 do
  1105.   begin
  1106.     if tabelle_UPC_E0[c,i]='E' then
  1107.     begin
  1108.       result := result + tabelle_EAN_A[tmp[i]];
  1109.     end
  1110.     else
  1111.     begin
  1112.       for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
  1113.     end;
  1114.   end;
  1115.   result := result + '050505';
  1116. end;
  1118. { Get Code UPC Supp5 data }
  1119. function  Code_Supp5(const H_BarCode:string; const H_CheckSum:TCheckSum;
  1120.   var H_CheckNum:string):string;
  1121. var
  1122.   i,j : Integer;
  1123.   tmp, bar : string;
  1124.   c   : Char;
  1125. begin
  1126.   bar := SetLen(5,H_BarCode);
  1127.   tmp:=getSupp(copy(bar,1,5)+'0');
  1128.   c:=tmp[6];
  1129.   if H_CheckSum<>csNone then H_CheckNum:=tmp else tmp := bar;
  1130.   result := '506';   {Startcode}
  1131.   for i:=1 to 5 do
  1132.   begin
  1133.     if tabelle_UPC_E0[c,(6-5)+i]='E' then
  1134.     begin
  1135.       for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
  1136.     end
  1137.     else
  1138.     begin
  1139.       result := result + tabelle_EAN_A[tmp[i]];
  1140.     end;
  1141.     if i<5 then result:=result+'05'; { character delineator }
  1142.   end;
  1143. end;
  1145. { Get Code UPC Supp2 data }
  1146. function  Code_Supp2(const H_BarCode:string; const H_CheckSum:TCheckSum;
  1147.   var H_CheckNum:string):string;
  1148. var
  1149.   i,j : integer;
  1150.   tmp, mS, bar: string;
  1151. begin
  1152.   bar := SetLen(2,H_BarCode);
  1153.   i:=StrToInt(bar);
  1154.   case i mod 4 of
  1155.     3: mS:='EE';
  1156.     2: mS:='Eo';
  1157.     1: mS:='oE';
  1158.     0: mS:='oo';
  1159.   end;
  1160.   tmp:=getSupp(copy(bar,1,5)+'0');
  1162.   if H_CheckSum<>csNone then H_CheckNum:=tmp else tmp := bar;
  1163.   result := '506';
  1164.   for i:=1 to 2 do
  1165.   begin
  1166.     if mS[i]='E' then
  1167.     begin
  1168.       for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
  1169.     end
  1170.     else
  1171.     begin
  1172.       result := result + tabelle_EAN_A[tmp[i]];
  1173.     end;
  1174.     if i<2 then result:=result+'05';
  1175.   end;
  1176. end;