vpdfbarcode.pas

生成PDF文档的控件

    (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')
    );
  StartA = '211412';
  StartB = '211214';
  StartC = '211232';
  Stop = '2331112';

  function Find_Code128AB(c: AnsiChar): integer;
  var
    I: integer;
    v: AnsiChar;
  begin
    for I := 0 to High(tabelle_128) do
    begin
      if FTyp = 5 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;

  function Find_Code128C(c: AnsiString): 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: AnsiString;
  checksum: integer;
  codeword_pos: integer;

begin
  case FTyp of
    5, 20:
      begin
        checksum := 103;
        startcode := StartA;
      end;
    6, 21:
      begin
        checksum := 104;
        startcode := StartB;
      end;
    7, 22:
      begin
        checksum := 105;
        startcode := StartC;
      end;
  else
    raise Exception.CreateFmt('%s: wrong BarcodeType in Code_128',
      [self.ClassName]);
  end;
  Result := startcode;
  codeword_pos := 1;
  case FTyp of
    20, 21, 22:
      begin
        Result := Result + tabelle_128[102].data;
        Inc(checksum, 102 * codeword_pos);
        Inc(codeword_pos);
        if FCheckSum then
          FText := DoCheckSumming(FTEXT);
      end;
  end;
  if (FTyp = 7) or (FTyp = 22) 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;
  Result := Convert(Result);
end;

function TVPDFBarcode.Code_93: AnsiString;
type
  TCode93 =
    record
    c: AnsiChar;
    data: array[0..5] of AnsiChar;
  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'),
    (c: ']'; data: '312111'),
    (c: '{'; data: '311121'),
    (c: '}'; data: '122211')
    );

  function Find_Code93(c: AnsiChar): 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, weightC, weightK: integer;
begin
  Result := '111141';
  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';
  Result := Convert(Result);
end;

function TVPDFBarcode.Code_93Extended: AnsiString;
const
  code93x: 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 + code93x[ord(save[I])];
  end;
  Result := Code_93;
  FText := save;
end;

function TVPDFBarcode.Code_MSI: AnsiString;
const
  tabelle_MSI: array['0'..'9'] of AnsiString =
  (
    ('51515151'),
    ('51515160'),
    ('51516051'),
    ('51516060'),
    ('51605151'),
    ('51605160'),
    ('51606051'),
    ('51606060'),
    ('60515151'),
    ('60515160')
    );
var
  I: integer;
  check_even, check_odd, checksum: integer;
begin
  Result := '60';
  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';
end;

function TVPDFBarcode.Code_PostNet: AnsiString;
const
  tabelle_PostNet: array['0'..'9'] of AnsiString =
  (
    ('5151A1A1A1'),
    ('A1A1A15151'),
    ('A1A151A151'),
    ('A1A15151A1'),
    ('A151A1A151'),
    ('A151A151A1'),
    ('A15151A1A1'),
    ('51A1A1A151'),
    ('51A1A151A1'),
    ('51A151A1A1')
    );
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 TVPDFBarcode.Code_Codabar: AnsiString;
type
  TCodabar =
    record
    c: AnsiChar;
    data: array[0..6] of AnsiChar;
  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')
    );

  function Find_Codabar(c: AnsiChar): 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;
begin
  Result := tabelle_cb[Find_Codabar('A')].data + '0';
  for I := 1 to Length(FText) do
  begin
    idx := Find_Codabar(FText[I]);
    Result := Result + tabelle_cb[idx].data + '0';
  end;
  Result := Result + tabelle_cb[Find_Codabar('B')].data;
end;

function TVPDFBarcode.SetLen(pI: byte): AnsiString;
begin
  Result := StringOfChar(AnsiChar('0'), pI - Length(FText)) + FText;
end;

function TVPDFBarcode.Code_UPC_A: AnsiString;
var
  I: integer;
  tmp: AnsiString;
begin
  FText := SetLen(12);
  if FCheckSum then
    tmp := DoCheckSumming(copy(FText, 1, 11));
  if FCheckSum then
    FText := tmp
  else
    tmp := FText;
  Result := '505';
  for I := 1 to 6 do
    Result := Result + tabelle_EAN_A[tmp[I]];
  Result := Result + '05050';
  for I := 7 to 12 do
    Result := Result + tabelle_EAN_C[tmp[I]];
  Result := Result + '505';
end;

const
  tabelle_UPC_E0: array['0'..'9', 1..6] of AnsiChar =
  (
    ('E', 'E', 'E', 'o', 'o', 'o'),
    ('E', 'E', 'o', 'E', 'o', 'o'),
    ('E', 'E', 'o', 'o', 'E', 'o'),
    ('E', 'E', 'o', 'o', 'o', 'E'),
    ('E', 'o', 'E', 'E', 'o', 'o'),
    ('E', 'o', 'o', 'E', 'E', 'o'),
    ('E', 'o', 'o', 'o', 'E', 'E'),