vpdfbarcode.pas

生成PDF文档的控件

  data := MakeData;
  for I := 1 to Length(data) do
  begin
    OneBarProps(data[I], w, lt);
    Inc(Result, w);
  end;
end;

procedure TVPDFBarcode.SetWidth(Value: integer);
var
  data: AnsiString;
  I: integer;
  w, wtotal: integer;
  lt: TVPDFBarLineType;
begin
  wtotal := 0;
  data := MakeData;
  for I := 1 to Length(data) do
  begin
    OneBarProps(data[I], w, lt);
    Inc(wtotal, w);
  end;
  if wtotal > 0 then
    SetModul((FModul * Value) div wtotal);
end;

function TVPDFBarcode.DoCheckSumming(const data: AnsiString): AnsiString;
begin
  case FCheckSumMethod of
    csmNone:
      Result := data;
    csmModulo10:
      Result := CheckSumModulo10(data);
  end;
end;

const
  tabelle_EAN_A: array['0'..'9'] of AnsiString =
  (
    ('2605'),
    ('1615'),
    ('1516'),
    ('0805'),
    ('0526'),
    ('0625'),
    ('0508'),
    ('0706'),
    ('0607'),
    ('2506')
    );

const
  tabelle_EAN_C: array['0'..'9'] of AnsiString =
  (
    ('7150'),
    ('6160'),
    ('6061'),
    ('5350'),
    ('5071'),
    ('5170'),
    ('5053'),
    ('5251'),
    ('5152'),
    ('7051')
    );

function TVPDFBarcode.Code_EAN8: AnsiString;
var
  I: integer;
  tmp: AnsiString;
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';
  for I := 1 to 4 do
    Result := Result + tabelle_EAN_A[tmp[I]];
  Result := Result + '05050';
  for I := 5 to 8 do
    Result := Result + tabelle_EAN_C[tmp[I]];
  Result := Result + '505';
end;

const
  tabelle_EAN_B: array['0'..'9'] of AnsiString =
  (
    ('0517'),
    ('0616'),
    ('1606'),
    ('0535'),
    ('1705'),
    ('0715'),
    ('3505'),
    ('1525'),
    ('2515'),
    ('1507')
    );

const
  tabelle_ParityEAN13: array[0..9, 1..6] of AnsiChar =
  (
    ('A', 'A', 'A', 'A', 'A', 'A'),
    ('A', 'A', 'B', 'A', 'B', 'B'),
    ('A', 'A', 'B', 'B', 'A', 'B'),
    ('A', 'A', 'B', 'B', 'B', 'A'),
    ('A', 'B', 'A', 'A', 'B', 'B'),
    ('A', 'B', 'B', 'A', 'A', 'B'),
    ('A', 'B', 'B', 'B', 'A', 'A'),
    ('A', 'B', 'A', 'B', 'A', 'B'),
    ('A', 'B', 'A', 'B', 'B', 'A'),
    ('A', 'B', 'B', 'A', 'B', 'A')
    );

function TVPDFBarcode.Code_EAN13: AnsiString;
var
  I, LK: integer;
  tmp: AnsiString;
begin
  if FCheckSum then
  begin
    tmp := SetLen(12);
    tmp := DoCheckSumming(tmp);
  end
  else
    tmp := SetLen(13);
  Assert(Length(tmp) = 13, 'Invalid Text len (EAN13)');
  LK := StrToInt(String(AnsiChar(tmp[1])));
  tmp := copy(tmp, 2, 12);
  Result := '505';
  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';
  for I := 7 to 12 do
    Result := Result + tabelle_EAN_C[tmp[I]];
  Result := Result + '505';
end;

const
  tabelle_2_5: array['0'..'9', 1..5] of AnsiChar =
  (
    ('0', '0', '1', '1', '0'),
    ('1', '0', '0', '0', '1'),
    ('0', '1', '0', '0', '1'),
    ('1', '1', '0', '0', '0'),
    ('0', '0', '1', '0', '1'),
    ('1', '0', '1', '0', '0'),
    ('0', '1', '1', '0', '0'),
    ('0', '0', '0', '1', '1'),
    ('1', '0', '0', '1', '0'),
    ('0', '1', '0', '1', '0')
    );

function TVPDFBarcode.Code_2_5_interleaved: AnsiString;
var
  I, j: integer;
  c: AnsiChar;

begin
  Result := '5050';
  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';
end;

function TVPDFBarcode.Code_2_5_industrial: AnsiString;
var
  I, j: integer;
begin
  Result := '606050';
  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';
end;

function TVPDFBarcode.Code_2_5_matrix: AnsiString;
var
  I, j: integer;
  c: AnsiChar;
begin
  Result := '705050';
  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';
      if odd(j) then
        c := AnsiChar(chr(ord(c) + 5));
      Result := Result + c;
    end;
    Result := Result + '0';
  end;
  Result := Result + '70505';
end;

function TVPDFBarcode.Code_39: AnsiString;
type
  TCode39 =
    record
    c: AnsiChar;
    data: array[0..9] of AnsiChar;
    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: AnsiChar): 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;
  Result := tabelle_39[FindIdx('*')].data + '0';
  for I := 1 to Length(FText) do
  begin
    idx := FindIdx(AnsiChar(FText[I]));
    if idx < 0 then
      continue;
    Result := Result + tabelle_39[idx].data + '0';
    Inc(checksum, tabelle_39[idx].chk);
  end;
  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;
  Result := Result + tabelle_39[FindIdx('*')].data;
end;

function TVPDFBarcode.Code_39Extended: AnsiString;

const
  code39x: array[0..127] of AnsiString =
  (
    ('%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: AnsiString;
  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;

function TVPDFBarcode.Code_128: AnsiString;
type
  TCode128 =
    record
    a, b: AnsiChar;
    c: AnsiString;
    data: AnsiString;
  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'),
    (a: '-'; b: '-'; c: '13'; data: '122132'),
    (a: '.'; b: '.'; c: '14'; data: '122231'),
    (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'),