rm_barcode.pas

进销存·完整的·有数据库的·非常完整·只得参考

    'D': begin width := modules[3]; lt := black_half; end;
  else
    begin
   {something went wrong  :-(  }
   {mistyped pattern table}
      raise Exception.CreateFmt('%s: internal Error', [self.ClassName]);
    end;
  end;
end;


function TRMBarcode.MakeData: string;
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 TRMBarcode.GetWidth: integer;
var
  data: string;
  i: integer;
  w: integer;
  lt: TRMBarLineType;
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;

procedure TRMBarcode.SetWidth(Value: integer);
var
  data: string;
  i: integer;
  w, wtotal: integer;
  lt: TRMBarLineType;
begin
  wtotal := 0;

  {get barcode pattern}
  data := MakeData;

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


  {
  wtotal:  current width of barcode
  Value :  new width of barcode



  }

  if wtotal > 0 then { don't divide by 0 ! }
    SetModul((FModul * Value) div wtotal);
end;



function TRMBarcode.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 TRMBarcode.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 TRMBarcode.Code_EAN13: string;
var
  i, LK: integer;
  tmp: string;
begin
  if FCheckSum then
  begin
    tmp := SetLen(12);
    tmp := DoCheckSumming(tmp);
  end
  else
    tmp := SetLen(13);

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

  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 TRMBarcode.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 TRMBarcode.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 TRMBarcode.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 TRMBarcode.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 TRMBarcode.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 TRMBarcode.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: '