frxbarcod.pas

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

var
  i:integer;
begin
  {calculate the with of the different lines (modules)}
  MakeModules;

  {numeric barcode type ?}
  if BCdata[Typ].num then
  begin
   FText:= Trim(FText); {remove blanks}
    for i:= 1 to Length(Ftext) do
      if (FText[i] > '9') or (FText[i] < '0') then
        raise Exception.Create('Barcode must be numeric');
  end;

  {get the pattern of the barcode}
  case Typ of
    bcCode_2_5_interleaved:Result:= Code_2_5_interleaved;
    bcCode_2_5_industrial:Result:= Code_2_5_industrial;
    bcCode_2_5_matrix:Result:= Code_2_5_matrix;
    bcCode39:Result:= Code_39;
    bcCode39Extended:Result:= Code_39Extended;
    bcCode128A,
    bcCode128B,
    bcCode128C,
    bcCodeEAN128A,
    bcCodeEAN128B,
    bcCodeEAN128C:Result:= Code_128;
    bcCode93:Result:= Code_93;
    bcCode93Extended:Result:= Code_93Extended;
    bcCodeMSI:Result:= Code_MSI;
    bcCodePostNet:Result:= Code_PostNet;
    bcCodeCodabar:Result:= Code_Codabar;
    bcCodeEAN8:Result:= Code_EAN8;
    bcCodeEAN13:Result:= Code_EAN13;
    bcCodeUPC_A:Result:= Code_UPC_A;
    bcCodeUPC_E0:Result:= Code_UPC_E0;
    bcCodeUPC_E1:Result:= Code_UPC_E1;
    bcCodeUPC_Supp2:Result:= Code_Supp2;
    bcCodeUPC_Supp5:Result:= Code_Supp5;
  else
    raise Exception.CreateFmt('%s:wrong BarcodeType', [self.ClassName]);
  end;

{
Showmessage(Format('Data <%s>', [Result]));
}
end;

function TfrxBarcode.GetWidth:integer;
var
  data:string;
  i:integer;
  w:integer;
  lt:TfrxBarLineType;
begin
  Result:= 0;

  {get barcode pattern}
  data:= MakeData;

  for i:=1 to Length(data) do {examine the pattern string}
  begin
    OneBarProps(data[i], w, lt);
    Inc(Result, w);
  end;
end;

function TfrxBarcode.DoCheckSumming(const data:string):string;
begin
  case FCheckSumMethod of

    csmNone:
      Result:= data;
    csmModulo10:
      Result:= CheckSumModulo10(data);

  end;
end;

{
////////////////////////////// EAN /////////////////////////////////////////
}

{
////////////////////////////// EAN8 /////////////////////////////////////////
}

{Pattern for Barcode EAN Charset A}
     {L1 S1 L2 S2}
const tabelle_EAN_A:array['0'..'9'] of string =
  (
  ('2605'), { 0 }
  ('1615'), { 1 }
  ('1516'), { 2 }
  ('0805'), { 3 }
  ('0526'), { 4 }
  ('0625'), { 5 }
  ('0508'), { 6 }
  ('0706'), { 7 }
  ('0607'), { 8 }
  ('2506') { 9 }
  );

{Pattern for Barcode EAN Charset C}
     {S1 L1 S2 L2}
const tabelle_EAN_C:array['0'..'9'] of string =
  (
  ('7150' ), { 0 }
  ('6160' ), { 1 }
  ('6061' ), { 2 }
  ('5350' ), { 3 }
  ('5071' ), { 4 }
  ('5170' ), { 5 }
  ('5053' ), { 6 }
  ('5251' ), { 7 }
  ('5152' ), { 8 }
  ('7051' ) { 9 }
  );

function TfrxBarcode.Code_EAN8:string;
var
  i:integer;
  tmp:String;
begin
  if FCheckSum then
  begin
    tmp:= SetLen(7);
    tmp:= DoCheckSumming(copy(tmp,length(tmp)-6,7));
  end
  else
    tmp:= SetLen(8);

  Assert(Length(tmp)=8, 'Invalid Text len (EAN8)');
  result:= '505'; {Startcode}

  for i:=1 to 4 do
    result:= result+tabelle_EAN_A[tmp[i]];

  result:= result+'05050'; {Center Guard Pattern}

  for i:=5 to 8 do
    result:= result+tabelle_EAN_C[tmp[i]];

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

{////////////////////////////// EAN13 ///////////////////////////////////////}

{Pattern for Barcode EAN Zeichensatz B}
     {L1 S1 L2 S2}
const tabelle_EAN_B:array['0'..'9'] of string =
  (
  ('0517'), { 0 }
  ('0616'), { 1 }
  ('1606'), { 2 }
  ('0535'), { 3 }
  ('1705'), { 4 }
  ('0715'), { 5 }
  ('3505'), { 6 }
  ('1525'), { 7 }
  ('2515'), { 8 }
  ('1507') { 9 }
  );

{Zuordung der Paraitaetsfolgen f箁 EAN13}
const tabelle_ParityEAN13:array[0..9, 1..6] of char =
  (
  ('A', 'A', 'A', 'A', 'A', 'A'), { 0 }
  ('A', 'A', 'B', 'A', 'B', 'B'), { 1 }
  ('A', 'A', 'B', 'B', 'A', 'B'), { 2 }
  ('A', 'A', 'B', 'B', 'B', 'A'), { 3 }
  ('A', 'B', 'A', 'A', 'B', 'B'), { 4 }
  ('A', 'B', 'B', 'A', 'A', 'B'), { 5 }
  ('A', 'B', 'B', 'B', 'A', 'A'), { 6 }
  ('A', 'B', 'A', 'B', 'A', 'B'), { 7 }
  ('A', 'B', 'A', 'B', 'B', 'A'), { 8 }
  ('A', 'B', 'B', 'A', 'B', 'A') { 9 }
  );

function TfrxBarcode.Code_EAN13:string;
var
   i, LK:integer;
   tmp:String;
begin
  if Length(FText)<>13 then
  begin
    FText:= SetLen(13);
    if FCheckSum then
      tmp:= DoCheckSumming(copy(FText,2,12));
    if FCheckSum then
      FText:= tmp
    else
      tmp:= FText;
  end
  else
    tmp:= FText;

  Assert(Length(tmp) = 13, 'Invalid Text len (EAN13)');

  LK:= StrToInt(tmp[1]);
  tmp:= copy(tmp,2,12);

  result:= '505'; {Startcode}

  for i:=1 to 6 do
  begin
    case tabelle_ParityEAN13[LK,i] of
      'A':result:= result+tabelle_EAN_A[tmp[i]];
      'B':result:= result+tabelle_EAN_B[tmp[i]];
      'C':result:= result+tabelle_EAN_C[tmp[i]];
  end;
  end;

  result:= result+'05050'; {Center Guard Pattern}

  for i:=7 to 12 do
    result:= result+tabelle_EAN_C[tmp[i]];

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

{Pattern for Barcode 2 of 5}
const tabelle_2_5:array['0'..'9', 1..5] of char =
  (
  ('0', '0', '1', '1', '0'), {'0'}
  ('1', '0', '0', '0', '1'), {'1'}
  ('0', '1', '0', '0', '1'), {'2'}
  ('1', '1', '0', '0', '0'), {'3'}
  ('0', '0', '1', '0', '1'), {'4'}
  ('1', '0', '1', '0', '0'), {'5'}
  ('0', '1', '1', '0', '0'), {'6'}
  ('0', '0', '0', '1', '1'), {'7'}
  ('1', '0', '0', '1', '0'), {'8'}
  ('0', '1', '0', '1', '0') {'9'}
  );

function TfrxBarcode.Code_2_5_interleaved:string;
var
  i, j:integer;
  c:char;

begin
  result:= '5050'; {Startcode}

  for i:=1 to Length(FText) div 2 do
  begin
    for j:= 1 to 5 do
    begin
      if tabelle_2_5[FText[i*2-1], j] = '1' then
        c:= '6'
      else
        c:= '5';
      result:= result+c;
      if tabelle_2_5[FText[i*2], j] = '1' then
        c:= '1'
      else
        c:= '0';
      result:= result+c;
    end;
  end;

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

function TfrxBarcode.Code_2_5_industrial:string;
var
  i, j:integer;
begin
  result:= '606050'; {Startcode}

  for i:=1 to Length(FText) do
  begin
    for j:= 1 to 5 do
    begin
    if tabelle_2_5[FText[i], j] = '1' then
      result:= result+'60'
    else
      result:= result+'50';
    end;
  end;

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

function TfrxBarcode.Code_2_5_matrix:string;
var
  i, j:integer;
  c:char;
begin
  result:= '705050'; {Startcode}

  for i:=1 to Length(FText) do
  begin
    for j:= 1 to 5 do
    begin
      if tabelle_2_5[FText[i], j] = '1' then
        c:= '1'
      else
        c:= '0';

    {Falls i ungerade ist dann mache L筩ke zu Strich}
      if odd(j) then
        c:= chr(ord(c)+5);
      result:= result+c;
    end;
   result:= result+'0'; {L筩ke zwischen den Zeichen}
  end;

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

function TfrxBarcode.Code_39:string;

type TCode39 =
  record
    c:char;
    data:array[0..9] of char;
    chk:shortint;
  end;

const tabelle_39:array[0..43] of TCode39 = (
  ( c:'0'; data:'505160605'; chk:0 ),
  ( c:'1'; data:'605150506'; chk:1 ),
  ( c:'2'; data:'506150506'; chk:2 ),
  ( c:'3'; data:'606150505'; chk:3 ),
  ( c:'4'; data:'505160506'; chk:4 ),
  ( c:'5'; data:'605160505'; chk:5 ),
  ( c:'6'; data:'506160505'; chk:6 ),
  ( c:'7'; data:'505150606'; chk:7 ),
  ( c:'8'; data:'605150605'; chk:8 ),
  ( c:'9'; data:'506150605'; chk:9 ),
  ( c:'A'; data:'605051506'; chk:10),
  ( c:'B'; data:'506051506'; chk:11),
  ( c:'C'; data:'606051505'; chk:12),
  ( c:'D'; data:'505061506'; chk:13),
  ( c:'E'; data:'605061505'; chk:14),
  ( c:'F'; data:'506061505'; chk:15),
  ( c:'G'; data:'505051606'; chk:16),
  ( c:'H'; data:'605051605'; chk:17),
  ( c:'I'; data:'506051605'; chk:18),
  ( c:'J'; data:'505061605'; chk:19),
  ( c:'K'; data:'605050516'; chk:20),
  ( c:'L'; data:'506050516'; chk:21),
  ( c:'M'; data:'606050515'; chk:22),
  ( c:'N'; data:'505060516'; chk:23),
  ( c:'O'; data:'605060515'; chk:24),
  ( c:'P'; data:'506060515'; chk:25),
  ( c:'Q'; data:'505050616'; chk:26),
  ( c:'R'; data:'605050615'; chk:27),
  ( c:'S'; data:'506050615'; chk:28),
  ( c:'T'; data:'505060615'; chk:29),
  ( c:'U'; data:'615050506'; chk:30),
  ( c:'V'; data:'516050506'; chk:31),
  ( c:'W'; data:'616050505'; chk:32),
  ( c:'X'; data:'515060506'; chk:33),
  ( c:'Y'; data:'615060505'; chk:34),
  ( c:'Z'; data:'516060505'; chk:35),
  ( c:'-'; data:'515050606'; chk:36),
  ( c:'.'; data:'615050605'; chk:37),
  ( c:' '; data:'516050605'; chk:38),
  ( c:'*'; data:'515060605'; chk:0 ),
  ( c:'$'; data:'515151505'; chk:39),
  ( c:'/'; data:'515150515'; chk:40),
  ( c:'+'; data:'515051515'; chk:41),
  ( c:'%'; data:'505151515'; chk:42)
  );

function FindIdx(z:char):integer;
var
  i:integer;
begin
  for i:=0 to High(tabelle_39) do
  begin
    if z = tabelle_39[i].c then
    begin
      result:= i;
      exit;
    end;
  end;
  result:=-1;
end;

var
  i, idx:integer;
  checksum:integer;

begin
  checksum:= 0;
  {Startcode}
  result:= tabelle_39[FindIdx('*')].data+'0';

  for i:=1 to Length(FText) do
  begin
    idx:= FindIdx(FText[i]);
    if idx < 0 then
      continue;
    result:= result+tabelle_39[idx].data+'0';
    Inc(checksum, tabelle_39[idx].chk);
  end;

  {Calculate Checksum Data}
  if FCheckSum then
    begin
    checksum:= checksum mod 43;
    for i:=0 to High(tabelle_39) do
      if checksum = tabelle_39[i].chk then
      begin
        result:= result+tabelle_39[i].data+'0';
        break;
      end;
    end;

  {Stopcode}
  result:= result+tabelle_39[FindIdx('*')].data;
end;

function TfrxBarcode.Code_39Extended:string;

const code39x: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
  save:= FText;
  FText:= '';

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

{
Code 128
}
function TfrxBarcode.Code_128:string;
type TCode128 =
  record
    a, b:char;
    c:string[2];
    data:string[6];
  end;

const tabelle_128:array[0..102] of TCode128 = (
  ( a:' '; b:' '; c:'00'; data:'212222' ),
  ( a:'!'; b:'!'; c:'01'; data:'222122' ),
  ( a:'"'; b:'"'; c:'02'; data:'222221' ),
  ( a:'#'; b:'#'; c:'03'; data:'121223' ),
  ( a:'$'; b:'$'; c:'04'; data:'121322' ),
  ( a:'%'; b:'%'; c:'05'; data:'131222' ),
  ( a:'&'; b:'&'; c:'06'; data:'122213' ),
  ( a:''''; b:''''; c:'07'; data:'122312' ),
  ( a:'('; b:'('; c:'08'; data:'132212' ),
  ( a:')'; b:')'; c:'09'; data:'221213' ),
  ( a:'*'; b:'*'; c:'10'; data:'221312' ),
  ( a:'+'; b:'+'; c:'11'; data:'231212' ),
  ( a:','; b:','; c:'12'; data:'112232' ), {23.10.2001 Stefano Torricella}
  ( a:'-'; b:'-'; c:'13'; data:'122132' ),
  ( a:'.'; b:'.'; c:'14'; data:'122231' ),