rm_asbarcode.pas

这是一个功能强大

    ('%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 TAsBarcode.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'),
    (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: #0; b: '`'; c: '64'; data: '111422'),
    (a: #1; b: 'a'; c: '65'; data: '121124'),
    (a: #2; b: 'b'; c: '66'; data: '121421'),
    (a: #3; b: 'c'; c: '67'; data: '141122'),
    (a: #4; b: 'd'; c: '68'; data: '141221'),
    (a: #5; b: 'e'; c: '69'; data: '112214'),
    (a: #6; b: 'f'; c: '70'; data: '112412'),
    (a: #7; b: 'g'; c: '71'; data: '122114'),
    (a: #8; b: 'h'; c: '72'; data: '122411'),
    (a: #9; b: 'i'; c: '73'; data: '142112'),
    (a: #10; b: 'j'; c: '74'; data: '142211'),
    (a: #11; b: 'k'; c: '75'; data: '241211'),
    (a: #12; b: 'l'; c: '76'; data: '221114'),
    (a: #13; b: 'm'; c: '77'; data: '413111'),
    (a: #14; b: 'n'; c: '78'; data: '241112'),
    (a: #15; b: 'o'; c: '79'; data: '134111'),
    (a: #16; b: 'p'; c: '80'; data: '111242'),
    (a: #17; b: 'q'; c: '81'; data: '121142'),
    (a: #18; b: 'r'; c: '82'; data: '121241'),
    (a: #19; b: 's'; c: '83'; data: '114212'),
    (a: #20; b: 't'; c: '84'; data: '124112'),
    (a: #21; b: 'u'; c: '85'; data: '124211'),
    (a: #22; b: 'v'; c: '86'; data: '411212'),
    (a: #23; b: 'w'; c: '87'; data: '421112'),
    (a: #24; b: 'x'; c: '88'; data: '421211'),
    (a: #25; b: 'y'; c: '89'; data: '212141'),
    (a: #26; b: 'z'; c: '90'; data: '214121'),
    (a: #27; b: '{'; c: '91'; data: '412121'),
    (a: #28; b: '|'; c: '92'; data: '111143'),
    (a: #29; b: '}'; c: '93'; data: '111341'),
    (a: #30; b: '~'; c: '94'; data: '131141'),
    (a: #31; 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 TAsBarcode.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;
    if weightK > 15 then weightK := 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 TAsBarcode.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 TAsBarcode.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 TAsBarcode.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 TAsBarcode.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;
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;