barcode.pas

说明： 支持D3-D7 TBARCODE 条码控件

  {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 TBarcode.GetWidth:integer;
var
	data : string;
	i : integer;
	w : integer;
	lt : TBarLineType;
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 TBarcode.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 TBarcode.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 TBarcode.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)');

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