frxbarcod.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  ( a:'/'; b:'/'; c:'15'; data:'113222' ),
  ( a:'0'; b:'0'; c:'16'; data:'123122' ),
  ( a:'1'; b:'1'; c:'17'; data:'123221' ),
  ( a:'2'; b:'2'; c:'18'; data:'223211' ),
  ( a:'3'; b:'3'; c:'19'; data:'221132' ),
  ( a:'4'; b:'4'; c:'20'; data:'221231' ),
  ( a:'5'; b:'5'; c:'21'; data:'213212' ),
  ( a:'6'; b:'6'; c:'22'; data:'223112' ),
  ( a:'7'; b:'7'; c:'23'; data:'312131' ),
  ( a:'8'; b:'8'; c:'24'; data:'311222' ),
  ( a:'9'; b:'9'; c:'25'; data:'321122' ),
  ( a:':'; b:':'; c:'26'; data:'321221' ),
  ( a:';'; b:';'; c:'27'; data:'312212' ),
  ( a:'<'; b:'<'; c:'28'; data:'322112' ),
  ( a:'='; b:'='; c:'29'; data:'322211' ),
  ( a:'>'; b:'>'; c:'30'; data:'212123' ),
  ( a:'?'; b:'?'; c:'31'; data:'212321' ),
  ( a:'@'; b:'@'; c:'32'; data:'232121' ),
  ( a:'A'; b:'A'; c:'33'; data:'111323' ),
  ( a:'B'; b:'B'; c:'34'; data:'131123' ),
  ( a:'C'; b:'C'; c:'35'; data:'131321' ),
  ( a:'D'; b:'D'; c:'36'; data:'112313' ),
  ( a:'E'; b:'E'; c:'37'; data:'132113' ),
  ( a:'F'; b:'F'; c:'38'; data:'132311' ),
  ( a:'G'; b:'G'; c:'39'; data:'211313' ),
  ( a:'H'; b:'H'; c:'40'; data:'231113' ),
  ( a:'I'; b:'I'; c:'41'; data:'231311' ),
  ( a:'J'; b:'J'; c:'42'; data:'112133' ),
  ( a:'K'; b:'K'; c:'43'; data:'112331' ),
  ( a:'L'; b:'L'; c:'44'; data:'132131' ),
  ( a:'M'; b:'M'; c:'45'; data:'113123' ),
  ( a:'N'; b:'N'; c:'46'; data:'113321' ),
  ( a:'O'; b:'O'; c:'47'; data:'133121' ),
  ( a:'P'; b:'P'; c:'48'; data:'313121' ),
  ( a:'Q'; b:'Q'; c:'49'; data:'211331' ),
  ( a:'R'; b:'R'; c:'50'; data:'231131' ),
  ( a:'S'; b:'S'; c:'51'; data:'213113' ),
  ( a:'T'; b:'T'; c:'52'; data:'213311' ),
  ( a:'U'; b:'U'; c:'53'; data:'213131' ),
  ( a:'V'; b:'V'; c:'54'; data:'311123' ),
  ( a:'W'; b:'W'; c:'55'; data:'311321' ),
  ( a:'X'; b:'X'; c:'56'; data:'331121' ),
  ( a:'Y'; b:'Y'; c:'57'; data:'312113' ),
  ( a:'Z'; b:'Z'; c:'58'; data:'312311' ),
  ( a:'['; b:'['; c:'59'; data:'332111' ),
  ( a:'\'; b:'\'; c:'60'; data:'314111' ),
  ( a:']'; b:']'; c:'61'; data:'221411' ),
  ( a:'^'; b:'^'; c:'62'; data:'431111' ),
  ( a:'_'; b:'_'; c:'63'; data:'111224' ),
  ( a:' '; b:'`'; c:'64'; data:'111422' ),
  ( a:' '; b:'a'; c:'65'; data:'121124' ),
  ( a:' '; b:'b'; c:'66'; data:'121421' ),
  ( a:' '; b:'c'; c:'67'; data:'141122' ),
  ( a:' '; b:'d'; c:'68'; data:'141221' ),
  ( a:' '; b:'e'; c:'69'; data:'112214' ),
  ( a:' '; b:'f'; c:'70'; data:'112412' ),
  ( a:' '; b:'g'; c:'71'; data:'122114' ),
  ( a:' '; b:'h'; c:'72'; data:'122411' ),
  ( a:' '; b:'i'; c:'73'; data:'142112' ),
  ( a:' '; b:'j'; c:'74'; data:'142211' ),
  ( a:' '; b:'k'; c:'75'; data:'241211' ),
  ( a:' '; b:'l'; c:'76'; data:'221114' ),
  ( a:' '; b:'m'; c:'77'; data:'413111' ),
  ( a:' '; b:'n'; c:'78'; data:'241112' ),
  ( a:' '; b:'o'; c:'79'; data:'134111' ),
  ( a:' '; b:'p'; c:'80'; data:'111242' ),
  ( a:' '; b:'q'; c:'81'; data:'121142' ),
  ( a:' '; b:'r'; c:'82'; data:'121241' ),
  ( a:' '; b:'s'; c:'83'; data:'114212' ),
  ( a:' '; b:'t'; c:'84'; data:'124112' ),
  ( a:' '; b:'u'; c:'85'; data:'124211' ),
  ( a:' '; b:'v'; c:'86'; data:'411212' ),
  ( a:' '; b:'w'; c:'87'; data:'421112' ),
  ( a:' '; b:'x'; c:'88'; data:'421211' ),
  ( a:' '; b:'y'; c:'89'; data:'212141' ),
  ( a:' '; b:'z'; c:'90'; data:'214121' ),
  ( a:' '; b:'{'; c:'91'; data:'412121' ),
  ( a:' '; b:'|'; c:'92'; data:'111143' ),
  ( a:' '; b:'}'; c:'93'; data:'111341' ),
  ( a:' '; b:'~'; c:'94'; data:'131141' ),
  ( a:' '; b:' '; c:'95'; data:'114113' ),
  ( a:' '; b:' '; c:'96'; data:'114311' ),
  ( a:' '; b:' '; c:'97'; data:'411113' ),
  ( a:' '; b:' '; c:'98'; data:'411311' ),
  ( a:' '; b:' '; c:'99'; data:'113141' ),
  ( a:' '; b:' '; c:' '; data:'114131' ),
  ( a:' '; b:' '; c:' '; data:'311141' ),
  ( a:' '; b:' '; c:' '; data:'411131' ) { FNC1 }
  );

StartA = '211412';
StartB = '211214';
StartC = '211232';
Stop = '2331112';

{find Code 128 Codeset A or B}
function Find_Code128AB(c:char):integer;
var
  i:integer;
  v:char;
begin
  for i:=0 to High(tabelle_128) do
  begin
    if FTyp = bcCode128A then
      v:= tabelle_128[i].a
    else
      v:= tabelle_128[i].b;

    if c = v then
    begin
      result:= i;
      exit;
    end;
  end;
  result:=-1;
end;

{ find Code 128 Codeset C }
function Find_Code128C(c:string):integer;
  var i:integer;
  begin
    for i:=0 to High(tabelle_128) do begin
      if tabelle_128[i].c = c then begin
       result:= i;
       exit;
      end;
    end;
    result:=-1;
  end;

var i, j, idx:integer;
  startcode:string;
  checksum:integer;
  codeword_pos:integer;

begin
  case FTyp of
    bcCode128A, bcCodeEAN128A:
      begin checksum:= 103; startcode:= StartA; end;
    bcCode128B, bcCodeEAN128B:
      begin checksum:= 104; startcode:= StartB; end;
    bcCode128C, bcCodeEAN128C:
      begin checksum:= 105; startcode:= StartC; end;
    else
      raise Exception.CreateFmt('%s:wrong BarcodeType in Code_128', [self.ClassName]);
  end;

  result:= startcode; {Startcode}
  codeword_pos:= 1;

  case FTyp of
    bcCodeEAN128A,
    bcCodeEAN128B,
    bcCodeEAN128C:
      begin
      {
      special identifier
      FNC1 = function code 1
      for EAN 128 barcodes
      }
      result:= result+tabelle_128[102].data;
      Inc(checksum, 102*codeword_pos);
      Inc(codeword_pos);
      {
      if there is no checksum at the end of the string
      the EAN128 needs one (modulo 10)
      }
      if FCheckSum then FText:=DoCheckSumming(FTEXT);
      end;
  end;

  if (FTyp = bcCode128C) or (FTyp = bccodeEAN128C) then
  begin
    if (Length(FText) mod 2<>0) then FText:='0'+FText;
    for i:=1 to (Length(FText) div 2) do
    begin
      j:=(i-1)*2+1;
      idx:=Find_Code128C(copy(Ftext,j,2));
      if idx < 0 then idx:= Find_Code128C('00');
      result:= result+tabelle_128[idx].data;
      Inc(checksum, idx*codeword_pos);
      Inc(codeword_pos);
    end;
  end
  else
    for i:=1 to Length(FText) do
    begin
      idx:= Find_Code128AB(FText[i]);
      if idx < 0 then
        idx:= Find_Code128AB(' ');
      result:= result+tabelle_128[idx].data;
      Inc(checksum, idx*codeword_pos);
      Inc(codeword_pos);
    end;

  checksum:= checksum mod 103;
  result:= result+tabelle_128[checksum].data;

  result:= result+Stop; {Stopcode}
  Result:= Convert(Result);
end;

function TfrxBarcode.Code_93:string;
type TCode93 =
  record
    c:char;
    data:array[0..5] of char;
  end;

const tabelle_93:array[0..46] of TCode93 = (
  ( c:'0'; data:'131112' ),
  ( c:'1'; data:'111213' ),
  ( c:'2'; data:'111312' ),
  ( c:'3'; data:'111411' ),
  ( c:'4'; data:'121113' ),
  ( c:'5'; data:'121212' ),
  ( c:'6'; data:'121311' ),
  ( c:'7'; data:'111114' ),
  ( c:'8'; data:'131211' ),
  ( c:'9'; data:'141111' ),
  ( c:'A'; data:'211113' ),
  ( c:'B'; data:'211212' ),
  ( c:'C'; data:'211311' ),
  ( c:'D'; data:'221112' ),
  ( c:'E'; data:'221211' ),
  ( c:'F'; data:'231111' ),
  ( c:'G'; data:'112113' ),
  ( c:'H'; data:'112212' ),
  ( c:'I'; data:'112311' ),
  ( c:'J'; data:'122112' ),
  ( c:'K'; data:'132111' ),
  ( c:'L'; data:'111123' ),
  ( c:'M'; data:'111222' ),
  ( c:'N'; data:'111321' ),
  ( c:'O'; data:'121122' ),
  ( c:'P'; data:'131121' ),
  ( c:'Q'; data:'212112' ),
  ( c:'R'; data:'212211' ),
  ( c:'S'; data:'211122' ),
  ( c:'T'; data:'211221' ),
  ( c:'U'; data:'221121' ),
  ( c:'V'; data:'222111' ),
  ( c:'W'; data:'112122' ),
  ( c:'X'; data:'112221' ),
  ( c:'Y'; data:'122121' ),
  ( c:'Z'; data:'123111' ),
  ( c:'-'; data:'121131' ),
  ( c:'.'; data:'311112' ),
  ( c:' '; data:'311211' ),
  ( c:'$'; data:'321111' ),
  ( c:'/'; data:'112131' ),
  ( c:'+'; data:'113121' ),
  ( c:'%'; data:'211131' ),
  ( c:'['; data:'121221' ), {only used for Extended Code 93}
  ( c:']'; data:'312111' ), {only used for Extended Code 93}
  ( c:'{'; data:'311121' ), {only used for Extended Code 93}
  ( c:'}'; data:'122211' ) {only used for Extended Code 93}
  );

{find Code 93}
function Find_Code93(c:char):integer;
var
  i:integer;
begin
  for i:=0 to High(tabelle_93) do
  begin
    if c = tabelle_93[i].c then
    begin
      result:= i;
      exit;
    end;
  end;
  result:=-1;
end;

var
  i, idx:integer;
  checkC, checkK, {Checksums}
  weightC, weightK:integer;
begin

  result:= '111141'; {Startcode}

  for i:=1 to Length(FText) do
  begin
    idx:= Find_Code93(FText[i]);
    if idx < 0 then
      raise Exception.CreateFmt('%s:Code93 bad Data <%s>', [self.ClassName,FText]);
    result:= result+tabelle_93[idx].data;
  end;

  checkC:= 0;
  checkK:= 0;

  weightC:= 1;
  weightK:= 2;

  for i:=Length(FText) downto 1 do
  begin
    idx:= Find_Code93(FText[i]);

    Inc(checkC, idx*weightC);
    Inc(checkK, idx*weightK);

    Inc(weightC);
    if weightC > 20 then weightC:= 1;
    Inc(weightK);
    if weightK > 15 then weightC:= 1;
  end;

  Inc(checkK, checkC);

  checkC:= checkC mod 47;
  checkK:= checkK mod 47;

  result:= result+tabelle_93[checkC].data+
    tabelle_93[checkK].data;

  result:= result+'1111411'; {Stopcode}
  Result:= Convert(Result);
end;

function TfrxBarcode.Code_93Extended:string;
const code93x:array[0..127] of string[2] =
  (
  (']U'), ('[A'), ('[B'), ('[C'), ('[D'), ('[E'), ('[F'), ('[G'),
  ('[H'), ('[I'), ('[J'), ('[K'), ('[L'), ('[M'), ('[N'), ('[O'),
  ('[P'), ('[Q'), ('[R'), ('[S'), ('[T'), ('[U'), ('[V'), ('[W'),
  ('[X'), ('[Y'), ('[Z'), (']A'), (']B'), (']C'), (']D'), (']E'),
   (' '), ('{A'), ('{B'), ('{C'), ('{D'), ('{E'), ('{F'), ('{G'),
  ('{H'), ('{I'), ('{J'), ('{K'), ('{L'), ('{M'), ('{N'), ('{O'),
  ( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
   ('8'), ('9'), ('{Z'), (']F'), (']G'), (']H'), (']I'), (']J'),
  (']V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
   ('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
   ('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
   ('X'), ('Y'), ('Z'), (']K'), (']L'), (']M'), (']N'), (']O'),
  (']W'), ('}A'), ('}B'), ('}C'), ('}D'), ('}E'), ('}F'), ('}G'),
  ('}H'), ('}I'), ('}J'), ('}K'), ('}L'), ('}M'), ('}N'), ('}O'),
  ('}P'), ('}Q'), ('}R'), ('}S'), ('}T'), ('}U'), ('}V'), ('}W'),
  ('}X'), ('}Y'), ('}Z'), (']P'), (']Q'), (']R'), (']S'), (']T')
  );

var
  save:string;
  i:integer;
begin
 {CharToOem(PChar(FText), save);}

  save:= FText;
  FText:= '';

  for i:=1 to Length(save) do
  begin
    if ord(save[i]) <= 127 then
      FText:= FText+code93x[ord(save[i])];
  end;

  {Showmessage(Format('Text:<%s>', [FText]));}

  result:= Code_93;
  FText:= save;
end;

function TfrxBarcode.Code_MSI:string;
const tabelle_MSI:array['0'..'9'] of string[8] =
  (
  ( '51515151' ), {'0'}
  ( '51515160' ), {'1'}
  ( '51516051' ), {'2'}
  ( '51516060' ), {'3'}
  ( '51605151' ), {'4'}
  ( '51605160' ), {'5'}
  ( '51606051' ), {'6'}
  ( '51606060' ), {'7'}
  ( '60515151' ), {'8'}
  ( '60515160' ) {'9'}
  );

var
  i:integer;
  check_even, check_odd, checksum:integer;
begin
  result:= '60'; {Startcode}
  check_even:= 0;
  check_odd:= 0;

  for i:=1 to Length(FText) do
  begin
    if odd(i-1) then
      check_odd:= check_odd*10+ord(FText[i])
    else
      check_even:= check_even+ord(FText[i]);

    result:= result+tabelle_MSI[FText[i]];
  end;

  checksum:= quersumme(check_odd*2)+check_even;

  checksum:= checksum mod 10;
  if checksum > 0 then
    checksum:= 10-checksum;

  result:= result+tabelle_MSI[chr(ord('0')+checksum)];

  result:= result+'515'; {Stopcode}
end;

function TfrxBarcode.Code_PostNet:string;
const tabelle_PostNet:array['0'..'9'] of string[10] =
  (
  ( '5151A1A1A1' ), {'0'}
  ( 'A1A1A15151' ), {'1'}
  ( 'A1A151A151' ), {'2'}
  ( 'A1A15151A1' ), {'3'}
  ( 'A151A1A151' ), {'4'}
  ( 'A151A151A1' ), {'5'}
  ( 'A15151A1A1' ), {'6'}
  ( '51A1A1A151' ), {'7'}
  ( '51A1A151A1' ), {'8'}
  ( '51A151A1A1' ) {'9'}
  );
var
  i:integer;
begin
  result:= '51';

  for i:=1 to Length(FText) do
  begin
    result:= result+tabelle_PostNet[FText[i]];
  end;
  result:= result+'5';
end;

function TfrxBarcode.Code_Codabar:string;
type TCodabar =
  record
    c:char;
    data:array[0..6] of char;
  end;

const tabelle_cb:array[0..19] of TCodabar = (
  ( c:'1'; data:'5050615' ),
  ( c:'2'; data:'5051506' ),
  ( c:'3'; data:'6150505' ),
  ( c:'4'; data:'5060515' ),
  ( c:'5'; data:'6050515' ),
  ( c:'6'; data:'5150506' ),
  ( c:'7'; data:'5150605' ),
  ( c:'8'; data:'5160505' ),
  ( c:'9'; data:'6051505' ),
  ( c:'0'; data:'5050516' ),
  ( c:'-'; data:'5051605' ),
  ( c:'$'; data:'5061505' ),
  ( c:':'; data:'6050606' ),
  ( c:'/'; data:'6060506' ),
  ( c:'.'; data:'6060605' ),
  ( c:'+'; data:'5060606' ),
  ( c:'A'; data:'5061515' ),
  ( c:'B'; data:'5151506' ),
  ( c:'C'; data:'5051516' ),
  ( c:'D'; data:'5051615' )
  );

{find Codabar}
function Find_Codabar(c:char):integer;
var
  i:integer;
begin
  for i:=0 to High(tabelle_cb) do
  begin
    if c = tabelle_cb[i].c then
    begin
      result:= i;
      exit;
    end;
  end;
  result:=-1;
end;

var
  i, idx:integer;