{
This will create a bar code of whatever TYPE you need but I admit it could be programmed better but at the moment I
don't know how to DO it any better.
}
UNIT BarCodes;
INTERFACE
USES
MacTypes, Quickdraw,
{ for the val function which returns an integer value for a digit }
NumberFormatting;
const
{ errors }
NoStringToBarCode = -1;
NoBarCodingErrorDetected = 0;
UnimplementedBarCode = 1;
ParametersDontMatchBarCodeType = 2;
InvalidUPCCountryCode = 3;
InvalidCode39Character = 4;
HumanReadableTextTooSmall = 5;
IllegalCharactersInString = 6;
TYPE
BarCodeTypes = (NoBarCode, Codebar, Code11, Code128, Code39, Code93, UPC, ExtendedCode39, CodeI25, Postnet,
UPCPlus);
VAR
BarPixelsWide : INTEGER;
BarPixelsHigh : INTEGER;
HumanReadableTextSize : INTEGER;
DotsPerInch : integer;
PROCEDURE DrawBarCode(at : point; BarCodeText : str255; BarCodeKind : BarCodeTypes; DrawCheckCharacter : BOOLEAN);
PROCEDURE InitBarCodes;
FUNCTION BarCodeError : INTEGER;
function BarCodeWidth(at : point; BarCodeText : str255; BarCodeKind : BarCodeTypes; DrawCheckCharacter : BOOLEAN): longint;
{
Error definition
number
0 no error resulted
1 unknown bar code TYPE
2 unknown UPC bar code TYPE
3 undefined EAN country code (this shouldn't be returned unless the character is a non numeric value)
4 illegal code 39 character
5 illegal human readable text size
}
IMPLEMENTATION
TYPE
{ Error checking TYPE }
StringType = (None,Numeric,NumericWithDash,Alpha);
{ Binary array. 1=bar, 0=space }
BinaryCodes = packed array[0.. 31] of BOOLEAN;
{ Code 128 }
Code128Type = (CodeUndefined,CodeA,CodeB,CodeC);
Code128BinaryRecord = record
BinaryCode : BinaryCodes;
CodeACharacter : CHAR;
CodeBCharacter : CHAR;
CodeCCharacter : CHAR;
END;
Code128BinaryArray = array[0..106] of Code128BinaryRecord;
{ Extended code 39 }
string2 = STRING[2];
xCode39Record = record
TheString : string2;
END; { record }
xCode39Array = array[0..127] of xCode39Record;
{ UPC/EAN }
UPCBinaryRecord = record
LeftABinaryCode : BinaryCodes;
LeftBBinaryCode : BinaryCodes;
RightBinaryCode : BinaryCodes;
END;
UPCBinaryArray = array[0.. 9] of UPCBinaryRecord;
{ Code 39, Interlieved code 2 of 5, Postnet, Code 11, Code 93 }
Code39BinaryArray = array[0.. 43] of BinaryCodes;
CodeI25Array = array[0.. 9] of BinaryCodes;
PostnetArray = array[0.. 9] of BinaryCodes;
Code11Array = array[0.. 11] of BinaryCodes;
Code93Array = array[0.. 48] of BinaryCodes;
VAR
Location : point; { location of the bar code upper left }
BarCodeString : str255; { STRING to bar code }
CheckCharacterOption : BOOLEAN; { calculate AND print a check character }
UPCGuard : BOOLEAN; { Draw extra height IF UPC guard is on }
TempDrawString : str255; { temporary STRING for drawing bar codes }
gBarCodeError : INTEGER; { Error returned by the bar coder }
gCurrentCode128Set : Code128Type; { What section of code 128 are we in? a,b,c }
Code39Check : INTEGER;
xCode39Codes : xCode39Array;
UPCBinaryCodes : UPCBinaryArray;
Code39BinaryCodes : Code39BinaryArray;
Code128BinaryCodes : Code128BinaryArray;
CodeI25BinaryCodes : CodeI25Array;
PostnetBinaryCodes : PostnetArray;
Code93BinaryCodes : Code93Array;
Code11BinaryCodes : Code11Array;
IsCheckingWidth : boolean;
TheBarCodeWidth : longint;
RealHumanReadableTextSize : integer;
{ build the Code 128 array, one element at a time }
PROCEDURE StuffCode128(s:str255; CodeADigit,CodeBDigit,CodeCDigit : CHAR; index : INTEGER);
VAR
count : INTEGER;
count2 : INTEGER;
TempString : str255;
TempBinaryCode : BinaryCodes;
BEGIN
TempString := s;
for count := 0 to 31 DO
TempBinaryCode[count] := false;
count2 := 1;
for count := 1 to ord(TempString[1])-ord('0') DO
BEGIN
TempBinaryCode[count2] := true;
count2 := count2+1;
END;
for count := 1 to ord(TempString[2])-ord('0') DO
count2 := count2+1;
for count := 1 to ord(TempString[3])-ord('0') DO
BEGIN
TempBinaryCode[count2] := true;
count2 := count2+1;
END;
for count := 1 to ord(TempString[4])-ord('0') DO
count2 := count2+1;
for count := 1 to ord(TempString[5])-ord('0') DO
BEGIN
TempBinaryCode[count2] := true;
count2 := count2+1;
END;
for count := 1 to ord(TempString[6])-ord('0') DO
count2 := count2+1;
IF length(TempString)=7 THEN
for count := 1 to ord(TempString[7])-ord('0') DO
BEGIN
TempBinaryCode[count2] := true;
count2 := count2+1;
END;
WITH Code128BinaryCodes[index] DO
BEGIN
CodeACharacter := CodeADigit;
CodeBCharacter := CodeBDigit;
CodeCCharacter := CodeCDigit;
BinaryCode := TempBinaryCode;
END;
END;
{ build the UPC/EAN array, one element at a time }
PROCEDURE StuffUPC(s:str255; UPCDigit,UPCType:INTEGER);
VAR
count : INTEGER;
TempBinaryCode : BinaryCodes;
BEGIN
for count := 0 to 31 DO
TempBinaryCode[count] := false;
for count := 1 to 7 DO
IF s[count] = '1' THEN
TempBinaryCode[count] := true;
IF UPCType = 1 THEN { Left A binary code }
UPCBinaryCodes[UPCDigit].LeftABinaryCode := TempBinaryCode
ELSE
IF UPCType = 2 THEN { Left B binary code }
UPCBinaryCodes[UPCDigit].LeftBBinaryCode := TempBinaryCode
ELSE
IF UPCType = 3 THEN { Right binary code }
UPCBinaryCodes[UPCDigit].RightBinaryCode := TempBinaryCode;
END;
{ build the Code 39 array, one element at a time }
PROCEDURE StuffCode39(s:STRING; Code39Digit:INTEGER);
VAR
count : INTEGER;
TempBinaryCode : BinaryCodes;
BEGIN
for count := 0 to 31 DO
TempBinaryCode[count] := false;
for count := 1 to 9 DO
IF s[count] = '1' THEN
TempBinaryCode[count] := true;
Code39BinaryCodes[Code39Digit] := TempBinaryCode;
END;
{ build the Code 93 array, one element at a time }
PROCEDURE StuffCode93(s:STRING; Code93Digit:INTEGER);
VAR
count : INTEGER;
TempBinaryCode : BinaryCodes;
BEGIN
for count := 0 to 31 DO
TempBinaryCode[count] := false;
for count := 1 to length(s) DO
IF s[count] = '1' THEN
TempBinaryCode[count] := true;
Code93BinaryCodes[Code93Digit] := TempBinaryCode;
END;
{ build the Code 11 array, one element at a time }
PROCEDURE StuffCode11(s:STRING; Code11Digit:INTEGER);
VAR
count : INTEGER;
TempBinaryCode : BinaryCodes;
BEGIN
for count := 0 to 31 DO
TempBinaryCode[count] := false;
for count := 1 to 5 DO
IF s[count] = '1' THEN
TempBinaryCode[count] := true;
Code11BinaryCodes[Code11Digit] := TempBinaryCode;
END;
{ build the Interlieved code 2 of 5 array, one element at a time }
PROCEDURE StuffCodeI25(s:STRING; CodeI25Digit:INTEGER);
VAR
count : INTEGER;
TempBinaryCode : BinaryCodes;
BEGIN
for count := 0 to 31 DO
TempBinaryCode[count] := false;
for count := 1 to 5 DO
IF s[count] = '1' THEN
TempBinaryCode[count] := true;
CodeI25BinaryCodes[CodeI25Digit] := TempBinaryCode;
END;
{ build the Postnet array, one element at a time }
PROCEDURE StuffPostnet(s:STRING; PostnetDigit:INTEGER);
VAR
count : INTEGER;
TempBinaryCode : BinaryCodes;
BEGIN
for count := 0 to 31 DO
TempBinaryCode[count] := false;
for count := 1 to 5 DO
IF s[count] = '1' THEN
TempBinaryCode[count] := true;
PostnetBinaryCodes[PostnetDigit] := TempBinaryCode;
END;
PROCEDURE InitBarCodes;
BEGIN
{ UPC/EAN left A }
StuffUPC('0001101',0,1);
StuffUPC('0011001',1,1);
StuffUPC('0010011',2,1);
StuffUPC('0111101',3,1);
StuffUPC('0100011',4,1);
StuffUPC('0110001',5,1);
StuffUPC('0101111',6,1);
StuffUPC('0111011',7,1);
StuffUPC('0110111',8,1);
StuffUPC('0001011',9,1);
{ EAN left B }
StuffUPC('0100111',0,2);
StuffUPC('0110011',1,2);
StuffUPC('0011011',2,2);
StuffUPC('0100001',3,2);
StuffUPC('0011101',4,2);
StuffUPC('0111001',5,2);
StuffUPC('0000101',6,2);
StuffUPC('0010001',7,2);
StuffUPC('0001001',8,2);
StuffUPC('0010111',9,2);
{ UPC/EAN right }
StuffUPC('1110010',0,3);
StuffUPC('1100110',1,3);
StuffUPC('1101100',2,3);
StuffUPC('1000010',3,3);
StuffUPC('1011100',4,3);
StuffUPC('1001110',5,3);
StuffUPC('1010000',6,3);
StuffUPC('1000100',7,3);
StuffUPC('1001000',8,3);
StuffUPC('1110100',9,3);
{ code 39 }
StuffCode39('000110100',0);
StuffCode39('100100001',1);
StuffCode39('001100001',2);
StuffCode39('101100000',3);
StuffCode39('000110001',4);
StuffCode39('100110000',5);
StuffCode39('001110000',6);
StuffCode39('000100101',7);
StuffCode39('100100100',8);
StuffCode39('001100100',9);
StuffCode39('100001001',10);
StuffCode39('001001001',11);
StuffCode39('101001000',12);
StuffCode39('000011001',13);
StuffCode39('100011000',14);
StuffCode39('001011000',15);
StuffCode39('000001101',16);
StuffCode39('100001100',17);
StuffCode39('001001100',18);
StuffCode39('000011100',19);
StuffCode39('100000011',20);
StuffCode39('001000011',21);
StuffCode39('101000010',22);
StuffCode39('000010011',23);
StuffCode39('100010010',24);
StuffCode39('001010010',25);
StuffCode39('000000111',26);
StuffCode39('100000110',27);
StuffCode39('001000110',28);
StuffCode39('000010110',29);
StuffCode39('110000001',30);
StuffCode39('011000001',31);
StuffCode39('111000000',32);
StuffCode39('010010001',33);
StuffCode39('110010000',34);
StuffCode39('011010000',35);
StuffCode39('010000101',36);
StuffCode39('110000100',37);
StuffCode39('011000100',38);
StuffCode39('010101000',39);
StuffCode39('010100010',40);
StuffCode39('010001010',41);
StuffCode39('000101010',42);
StuffCode39('010010100',43);
{ extended code 39 codes }
xCode39Codes[ 0].TheString := '%U';
xCode39Codes[ 1].TheString := '$A';
xCode39Codes[ 2].TheString := '$B';
xCode39Codes[ 3].TheString := '$C';
xCode39Codes[ 4].TheString := '$D';
xCode39Codes[ 5].TheString := '$E';
xCode39Codes[ 6].TheString := '$F';
xCode39Codes[ 7].TheString := '$G';
xCode39Codes[ 8].TheString := '$H';
xCode39Codes[ 9].TheString := '$I';
xCode39Codes[ 10].TheString := '$J';
xCode39Codes[ 11].TheString := '$K';
xCode39Codes[ 12].TheString := '$L';
xCode39Codes[ 13].TheString := '$M';
xCode39Codes[ 14].TheString := '$N';
xCode39Codes[ 15].TheString := '$O';
xCode39Codes[ 16].TheString := '$P';
xCode39Codes[ 17].TheString := '$Q';
xCode39Codes[ 18].TheString := '$R';
xCode39Codes[ 19].TheString := '$S';
xCode39Codes[ 20].TheString := '$T';
xCode39Codes[ 21].TheString := '$U';
xCode39Codes[ 22].TheString := '$V';
xCode39Codes[ 23].TheString := '$W';
xCode39Codes[ 24].TheString := '$X';
xCode39Codes[ 25].TheString := '$Y';
xCode39Codes[ 26].TheString := '$Z';
xCode39Codes[ 27].TheString := '%A';
xCode39Codes[ 28].TheString := '%B';
xCode39Codes[ 29].TheString := '%C';
xCode39Codes[ 30].TheString := '%D';
xCode39Codes[ 31].TheString := '%E';
xCode39Codes[ 32].TheString := ' ';
xCode39Codes[ 33].TheString := '/A';
xCode39Codes[ 34].TheString := '/B';
xCode39Codes[ 35].TheString := '/C';
xCode39Codes[ 36].TheString := '/D';
xCode39Codes[ 37].TheString := '/E';
xCode39Codes[ 38].TheString := '/F';
xCode39Codes[ 39].TheString := '/G';
xCode39Codes[ 40].TheString := '/H';
xCode39Codes[ 41].TheString := '/I';
xCode39Codes[ 42].TheString := '/J';
xCode39Codes[ 43].TheString := '/K';
xCode39Codes[ 44].TheString := '/L';
xCode39Codes[ 45].TheString := '/M';
xCode39Codes[ 46].TheString := '.N';
xCode39Codes[ 47].TheString := '/O';
xCode39Codes[ 48].TheString := '0';
xCode39Codes[ 49].TheString := '1';
xCode39Codes[ 50].TheString := '2';
xCode39Codes[ 51].TheString := '3';
xCode39Codes[ 52].TheString := '4';
xCode39Codes[ 53].TheString := '5';
xCode39Codes[ 54].TheString := '6';
xCode39Codes[ 55].TheString := '7';
xCode39Codes[ 56].TheString := '8';
xCode39Codes[ 57].TheString := '9';
xCode39Codes[ 58].TheString := '/Z';
xCode39Codes[ 59].TheString := '%F';
xCode39Codes[ 60].TheString := '%G';
xCode39Codes[ 61].TheString := '%H';
xCode39Codes[ 62].TheString := '%I';
xCode39Codes[ 63].TheString := '%J';
xCode39Codes[ 64].TheString := '%V';
xCode39Codes[ 65].TheString := 'A';
xCode39Codes[ 66].TheString := 'B';
xCode39Codes[ 67].TheString := 'C';
xCode39Codes[ 68].TheString := 'D';
xCode39Codes[ 69].TheString := 'E';
xCode39Codes[ 70].TheString := 'F';
xCode39Codes[ 71].TheString := 'G';
xCode39Codes[ 72].TheString := 'H';
xCode39Codes[ 73].TheString := 'I';
xCode39Codes[ 74].TheString := 'J';
xCode39Codes[ 75].TheString := 'K';
xCode39Codes[ 76].TheString := 'L';
xCode39Codes[ 77].TheString := 'M';
xCode39Codes[ 78].TheString := 'N';
xCode39Codes[ 79].TheString := 'O';
xCode39Codes[ 80].TheString := 'P';
xCode39Codes[ 81].TheString := 'Q';
xCode39Codes[ 82].TheString := 'R';
xCode39Codes[ 83].TheString := 'S';
xCode39Codes[ 84].TheString := 'T';
xCode39Codes[ 85].TheString := 'U';
xCode39Codes[ 86].TheString := 'V';
xCode39Codes[ 87].TheString := 'W';
xCode39Codes[ 88].TheString := 'X';
xCode39Codes[ 89].TheString := 'Y';
xCode39Codes[ 90].TheString := 'Z';
xCode39Codes[ 91].TheString := '%K';
xCode39Codes[ 92].TheString := '%L';
xCode39Codes[ 93].TheString := '%M';
xCode39Codes[ 94].TheString := '%N';
xCode39Codes[ 95].TheString := '%O';
xCode39Codes[ 96].TheString := '%W';
xCode39Codes[ 97].TheString := '+A';
xCode39Codes[ 98].TheString := '+B';
xCode39Codes[ 99].TheString := '+C';
xCode39Codes[100].TheString := '+D';
xCode39Codes[101].TheString := '+E';
xCode39Codes[102].TheString := '+F';
xCode39Codes[103].TheString := '+G';
xCode39Codes[104].TheString := '+H';
xCode39Codes[105].TheString := '+I';
xCode39Codes[106].TheString := '+J';
xCode39Codes[107].TheString := '+K';
xCode39Codes[108].TheString := '+L';
xCode39Codes[109].TheString := '+M';
xCode39Codes[110].TheString := '+N';
xCode39Codes[111].TheString := '+O';
xCode39Codes[112].TheString := '+P';
xCode39Codes[113].TheString := '+Q';
xCode39Codes[114].TheString := '+R';
xCode39Codes[115].TheString := '+S';
xCode39Codes[116].TheString := '+T';
xCode39Codes[117].TheString := '+U';
xCode39Codes[118].TheString := '+V';
xCode39Codes[119].TheString := '+W';
xCode39Codes[120].TheString := '+X';
xCode39Codes[121].TheString := '+Y';
xCode39Codes[122].TheString := '+Z';
xCode39Codes[123].TheString := '%P';
xCode39Codes[124].TheString := '%Q';
xCode39Codes[125].TheString := '%R';
xCode39Codes[126].TheString := '%S';
xCode39Codes[127].TheString := '%T';
{ Code 128 }
StuffCode128('212222',' ',' ',chr(00),0);
StuffCode128('222122','!','!',chr(01),1);
StuffCode128('222221','"','"',chr(02),2);
StuffCode128('121223','#','#',chr(03),3);
StuffCode128('121322','$','$',chr(04),4);
StuffCode128('131222','%','%',chr(05),5);
StuffCode128('122213','&','&',chr(06),6);
StuffCode128('122312','''','''',chr(07),7);
StuffCode128('132212','(','(',chr(08),8);
StuffCode128('221213',')',')',chr(09),9);
StuffCode128('221312','*','*',chr(10),10);
StuffCode128('231212','+','+',chr(11),11);
StuffCode128('112232',',',',',chr(12),12);
StuffCode128('122132','-','-',chr(13),13);
StuffCode128('122231','.','.',chr(14),14);
StuffCode128('113222','/','/',chr(15),15);
StuffCode128('123122','0','0',chr(16),16);
StuffCode128('123221','1','1',chr(17),17);
StuffCode128('223211','2','2',chr(18),18);
StuffCode128('221132','3','3',chr(19),19);
StuffCode128('221231','4','4',chr(20),20);
StuffCode128('213212','5','5',chr(21),21);
StuffCode128('223112','6','6',chr(22),22);
StuffCode128('312131','7','7',chr(23),23);
StuffCode128('311222','8','8',chr(24),24);
StuffCode128('321122','9','9',chr(25),25);
StuffCode128('321221',':',':',chr(26),26);
StuffCode128('312212',';',';',chr(27),27);
StuffCode128('322112','<','<',chr(28),28);
StuffCode128('322211','=','=',chr(29),29);
StuffCode128('212123','>','>',chr(30),30);
StuffCode128('212321','?','?',chr(31),31);
StuffCode128('232121','@','@',chr(32),32);
StuffCode128('111323','A','A',chr(33),33);
StuffCode128('131123','B','B',chr(34),34);
StuffCode128('131321','C','C',chr(35),35);
StuffCode128('112313','D','D',chr(36),36);
StuffCode128('132113','E','E',chr(37),37);
StuffCode128('132311','F','F',chr(38),38);
StuffCode128('211313','G','G',chr(39),39);
StuffCode128('231113','H','H',chr(40),40);
StuffCode128('231311','I','I',chr(41),41);
StuffCode128('112133','J','J',chr(42),42);
StuffCode128('112331','K','K',chr(43),43);
StuffCode128('132131','L','L',chr(44),44);
StuffCode128('113123','M','M',chr(45),45);
StuffCode128('113321','N','N',chr(46),46);
StuffCode128('133121','O','O',chr(47),47);
StuffCode128('313121','P','P',chr(48),48);
StuffCode128('211331','Q','Q',chr(49),49);
StuffCode128('231131','R','R',chr(50),50);
StuffCode128('213113','S','S',chr(51),51);
StuffCode128('213311','T','T',chr(52),52);
StuffCode128('213131','U','U',chr(53),53);
StuffCode128('311123','V','V',chr(54),54);
StuffCode128('311321','W','W',chr(55),55);
StuffCode128('331121','X','X',chr(56),56);
StuffCode128('312113','Y','Y',chr(57),57);
StuffCode128('312311','Z','Z',chr(58),58);
StuffCode128('332111','[','[',chr(59),59);
StuffCode128('314111','\','\',chr(60),60);
StuffCode128('221411',']',']',chr(61),61);
StuffCode128('431111','^','^',chr(62),62);
StuffCode128('111224','_','_',chr(63),63);
StuffCode128('111422',chr(0),'`',chr(64),64);
StuffCode128('121124',chr(1),'a',chr(65),65);
StuffCode128('121421',chr(2),'b',chr(66),66);
StuffCode128('141122',chr(3),'c',chr(67),67);
StuffCode128('141221',chr(4),'d',chr(68),68);
StuffCode128('112214',chr(5),'e',chr(69),69);
StuffCode128('112412',chr(6),'f',chr(70),70);
StuffCode128('122114',chr(7),'g',chr(71),71);
StuffCode128('122411',chr(8),'h',chr(72),72);
StuffCode128('142112',chr(9),'i',chr(73),73);
StuffCode128('142211',chr(10),'j',chr(74),74);
StuffCode128('241211',chr(11),'k',chr(75),75);
StuffCode128('221114',chr(12),'l',chr(76),76);
StuffCode128('413111',chr(13),'m',chr(77),77);
StuffCode128('241112',chr(14),'n',chr(78),78);
StuffCode128('134111',chr(15),'o',chr(79),79);
StuffCode128('111242',chr(16),'p',chr(80),80);
StuffCode128('121142',chr(17),'q',chr(81),81);
StuffCode128('121241',chr(18),'r',chr(82),82);
StuffCode128('114212',chr(19),'s',chr(83),83);
StuffCode128('124112',chr(20),'t',chr(84),84);
StuffCode128('124211',chr(21),'u',chr(85),85);
StuffCode128('411212',chr(22),'v',chr(86),86);
StuffCode128('421112',chr(23),'w',chr(87),87);
StuffCode128('421211',chr(24),'x',chr(88),88);
StuffCode128('212141',chr(25),'y',chr(89),89);
StuffCode128('214121',chr(26),'z',chr(90),90);
StuffCode128('412121',chr(27),'{',chr(91),91);
StuffCode128('111143',chr(28),' ',chr(92),92);
StuffCode128('111341',chr(29),'}',chr(93),93);
StuffCode128('131141',chr(30),'~',chr(94),94);
StuffCode128('114113',chr(31),chr(127),chr(95),95);
StuffCode128('114311','','',chr(96),96);
StuffCode128('411113','','',chr(97),97);
StuffCode128('411311','','',chr(98),98);
StuffCode128('113141','','',chr(99),99);
StuffCode128('114131','','','',100);
StuffCode128('311141','','','',101);
StuffCode128('411131','','','',102);
StuffCode128('211412','','','',103); { start code a }
StuffCode128('211214','','','',104); { start code b }
StuffCode128('211232','','','',105); { start code c }
StuffCode128('2331112','','','',106);{ stop code }
{ Interlieved 2 of 5 code }
StuffCodeI25('10001',1);
StuffCodeI25('01001',2);
StuffCodeI25('11000',3);
StuffCodeI25('00101',4);
StuffCodeI25('10100',5);
StuffCodeI25('01100',6);
StuffCodeI25('00011',7);
StuffCodeI25('10010',8);
StuffCodeI25('01010',9);
StuffCodeI25('00110',0);
{ Postnet code }
StuffPostnet('00011',1);
StuffPostnet('00101',2);
StuffPostnet('00110',3);
StuffPostnet('01001',4);
StuffPostnet('01010',5);
StuffPostnet('01100',6);
StuffPostnet('10001',7);
StuffPostnet('10010',8);
StuffPostnet('10100',9);
StuffPostnet('11000',0);
{ Code 11 }
StuffCode11('00001',0);
StuffCode11('10001',1);
StuffCode11('01001',2);
StuffCode11('11000',3);
StuffCode11('00101',4);
StuffCode11('10100',5);
StuffCode11('01100',6);
StuffCode11('00011',7);
StuffCode11('10010',8);
StuffCode11('10000',9);
StuffCode11('00100',10);
StuffCode11('00110',11);
{ Code 93 }
StuffCode93('100010100', 0);
StuffCode93('101001000', 1);
StuffCode93('101000100', 2);
StuffCode93('101000010', 3);
StuffCode93('100101000', 4);
StuffCode93('100100100', 5);
StuffCode93('100100010', 6);
StuffCode93('101010000', 7);
StuffCode93('100010010', 8);
StuffCode93('100001010', 9);
StuffCode93('110101000',10);
StuffCode93('110100100',11);
StuffCode93('110100010',12);
StuffCode93('110010100',13);
StuffCode93('110010010',14);
StuffCode93('110001010',15);
StuffCode93('101101000',16);
StuffCode93('101100100',17);
StuffCode93('101100010',18);
StuffCode93('100110100',19);
StuffCode93('100011010',20);
StuffCode93('101011000',21);
StuffCode93('101001100',22);
StuffCode93('101000110',23);
StuffCode93('100101100',24);
StuffCode93('100010110',25);
StuffCode93('110110100',26);
StuffCode93('110110010',27);
StuffCode93('110101100',28);
StuffCode93('110100110',29);
StuffCode93('110010110',30);
StuffCode93('110011010',31);
StuffCode93('101101100',32);
StuffCode93('101100110',33);
StuffCode93('100110110',34);
StuffCode93('100111010',35);
StuffCode93('100101110',36);
StuffCode93('111010100',37);
StuffCode93('111010010',38);
StuffCode93('111001010',39);
StuffCode93('101101110',40);
StuffCode93('101110110',41);
StuffCode93('110101110',42);
StuffCode93('100100110',43);
StuffCode93('111011010',44);
StuffCode93('111010110',45);
StuffCode93('100110010',46);
StuffCode93('101011110',47);
StuffCode93('1010111101',48);
{ generic specifications }
BarPixelsWide := 1;
BarPixelsHigh := 16;
HumanReadableTextSize := 8;
gBarCodeError := NoBarCodingErrorDetected;
gCurrentCode128Set := CodeUndefined;
DotsPerInch := 72;
END;
{-------- Utility routines ---------}
FUNCTION BarCodeError{:INTEGER};
BEGIN
BarCodeError := gBarCodeError;
END;
FUNCTION val(ch:CHAR):INTEGER;
BEGIN
val := ord(ch)-ord('0');
END;
FUNCTION CheckString(TheString : str255):StringType;
VAR
count : INTEGER;
result : StringType;
TheChar : CHAR;
BEGIN
result := None;
for count := 1 to length(TheString) DO
BEGIN
TheChar := TheString[count];
IF TheChar in ['0'..'9'] THEN
BEGIN
IF result = None THEN
result := Numeric;
END;
IF TheChar in ['0'..'9','-'] THEN
BEGIN
IF (result = None) OR (result = Numeric) THEN
result := NumericWithDash;
END;
IF TheChar in [chr(0)..chr(127)] THEN
BEGIN
result := Alpha;
END;
IF TheChar >chr(127) THEN
BEGIN
result := None;
count := length(TheString);
END;
END;
CheckString := result;
END;
{-------- Draw bar code parts ---------}
PROCEDURE DrawOneMark; { a binary system consists of a mark (logical one OR bar)
AND a space (logical zero OR white)}
VAR
count : INTEGER;
BEGIN
for count := 1 to BarPixelsWide DO
BEGIN
if IsCheckingWidth then
TheBarCodeWidth := TheBarCodeWidth+1
else
IF UPCGuard THEN
begin
moveto(Location.h,Location.v);
lineto(Location.h,Location.v+BarPixelsHigh{+(RealHumanReadableTextSize div 2)+1});
end
ELSE
begin
moveto(Location.h,Location.v);
lineto(Location.h,Location.v+BarPixelsHigh-(RealHumanReadableTextSize div 2)+1);
end;
Location.h := Location.h+1;
END;
END;
PROCEDURE DrawOneSpace;
VAR
count : INTEGER;
BEGIN
for count := 1 to BarPixelsWide DO
begin
TheBarCodeWidth := TheBarCodeWidth+1;
Location.h := Location.h+1;
end;
END;
PROCEDURE DrawOneWideMark; { 3:1 }
BEGIN
DrawOneMark;
DrawOneMark;
DrawOneMark;
END;
PROCEDURE DrawOneNarrowMark; { 3:1 }
BEGIN
DrawOneMark;
END;
PROCEDURE DrawOneWideSpace; { 3:1 }
BEGIN
DrawOneSpace;
DrawOneSpace;
DrawOneSpace;
END;
PROCEDURE DrawOneNarrowSpace; { 3:1 }
BEGIN
DrawOneSpace;
END;
PROCEDURE DrawOnePostnetMark;
VAR
count : INTEGER;
BEGIN
for count := 1 to BarPixelsWide DO
BEGIN
if IsCheckingWidth then
TheBarCodeWidth := TheBarCodeWidth+1
else
begin
moveto(Location.h,Location.v);
lineto(Location.h,Location.v+BarPixelsHigh);
end;
Location.h := Location.h+1;
END;
for count := 1 to BarPixelsWide DO
BEGIN
TheBarCodeWidth := TheBarCodeWidth+1;
Location.h := Location.h+1;
END;
END;
PROCEDURE DrawOnePostnetSpace;
VAR
count : INTEGER;
BEGIN
for count := 1 to BarPixelsWide DO
BEGIN
if IsCheckingWidth then
TheBarCodeWidth := TheBarCodeWidth+1
else
begin
moveto(Location.h,Location.v+(BarPixelsHigh DIV 2));
lineto(Location.h,Location.v+BarPixelsHigh);
end;
Location.h := Location.h+1;
END;
for count := 1 to BarPixelsWide DO
BEGIN
TheBarCodeWidth := TheBarCodeWidth+1;
Location.h := Location.h+1;
END;
END;
{-------- Draw bar code digits ---------}
PROCEDURE DrawOnePostnetBarSet(TheDigit:BinaryCodes);
VAR
count : INTEGER;
BEGIN
for count := 1 to 5 DO
IF TheDigit[count] THEN
DrawOnePostnetMark
ELSE
DrawOnePostnetSpace;
END;
PROCEDURE DrawUPCBarSet(UPCDigit:BinaryCodes; i : INTEGER);
VAR
TheSet : BinaryCodes;
OriginalPoint : point;
count : INTEGER;
BEGIN
OriginalPoint := Location;
TheSet := UPCDigit;
for count := 1 to 7 DO
BEGIN
IF TheSet[count] THEN
DrawOneMark
ELSE
DrawOneSpace;
END;
IF i<0 THEN
ELSE
BEGIN
moveto(OriginalPoint.h+1,OriginalPoint.v+BarPixelsHigh+(RealHumanReadableTextSize div 2)+1);
NumToString(i,TempDrawString);
if not IsCheckingWidth then
drawstring(TempDrawString);
END;
END;
PROCEDURE DrawOneCode11BarSet(Code11Digit:BinaryCodes);
{
Code 11
Code 11 is a numeric, high density code WITH one special character - . Each character is
encoded WITH five elements, either two wide AND three narrow, OR one wide AND four
narrow. The wide elements are a binary one (1), AND the narrow elements are a binary
zero (0).
Code 11 Character Set
Character B S B S B
0 0 0 0 0 1
1 1 0 0 0 1
2 0 1 0 0 1
3 1 1 0 0 0
4 0 0 1 0 1
5 1 0 1 0 0
6 0 1 1 0 0
7 0 0 0 1 1
8 1 0 0 1 0
9 1 0 0 0 0
- 0 0 1 0 0
Start/Stop 0 0 1 1 0
Code 11 USES two check digits, C AND K. The first check digit C is the modulo 11 sum
of the weighted products WITH the weights changing from 1 to 10. The second check
digit K is also the modulo 11 sum of the weighted products WITH the weights changing
from 1 to 9. The character - is assigned the value of 10.
As a rule of thumb, when the message length is 10 digits OR less, usually only the C
check digit is used.
Check Digit Example
DATA = 1 2 - 1 2 3 4 C K
C Weights = 7 6 5 4 3 2 1
K Weights = 8 7 6 5 4 3 2 1
Calculate C (1 x 4) + (2 x 3) + (3 x 2) + (4 x 1) +
(5 x 10) + (6 x 2) + (7 x 1) = 86
86 / 11 = 7 remainder 9
C = 9
Calculate K (1 x 9) + (2 x 4) + (3 x 3) + (4 x 2) +
(5 x 1) + (6 x 10) + (7 x 2) + (8 x 1) = 121
121 / 11 = 11 remainder 0
K = 0
Tag to be encoded = 12-123490
}
VAR
TheSet : BinaryCodes;
count : INTEGER;
BEGIN
TheSet := Code11Digit;
IF TheSet[1] THEN
DrawOneWideMark
ELSE
DrawOneNarrowMark;
IF TheSet[2] THEN
DrawOneWideSpace
ELSE
DrawOneNarrowSpace;
IF TheSet[3] THEN
DrawOneWideMark
ELSE
DrawOneNarrowMark;
IF TheSet[4] THEN
DrawOneWideSpace
ELSE
DrawOneNarrowSpace;
IF TheSet[5] THEN
DrawOneWideMark
ELSE
DrawOneNarrowMark;
DrawOneNarrowSpace;
END;
PROCEDURE DrawOneCode39BarSet(Code39Digit:BinaryCodes; ch:CHAR);
{
Code 39
Code Construction
Code 39 is an alphanumeric bar code that can encode decimal numbers, the upper CASE alphabet, AND the following
special symbols:
_ . * $ / % +
Code 39 characters are constructed using nine elements, five bars AND four spaces. Of these nine elements, two of
the bars AND one of the spaces are wider than the rest. Wide elements represent binary ones (1), AND narrow elements
represent binary zeros (0). The character set table shows each of the available characters WITH their corresponding
check character values.
To enable a decoder to distinguish between the wide AND narrow elements a minimum wide to narrow ratio is
needed. Depending upon which resolution has been used for the printing of the bar code, the width of the wide
element should be at least two times greater than the narrow element. A ratio of three to one is better. All elements of
the same TYPE should be printed the same size. (The width of a narrow bar should be the same as a narrow space.)
Code 39 is a discrete bar code, WITH a space between characters which contains no information. The width of this
intercharacter gap should be approximately equal to the narrow element width. The structure of Code 39 makes it
self checking, but there is an optional message check character.
Code Structure
101011100010111
D
( 1 is a bar, 0 is a space )
Character Set
ASCII Binary Check Character
Character Word Bars Spaces Value
0 000110100 00110 0100 0
1 100100001 10001 0100 1
2 001100001 01001 0100 2
3 101100000 11000 0100 3
4 000110001 00101 0100 4
5 100110000 10100 0100 5
6 001110000 01100 0100 6
7 000100101 00011 0100 7
8 100100100 10010 0100 8
9 001100100 01010 0100 9
A 100001001 10001 0010 10
B 001001001 01001 0010 11
C 101001000 11000 0010 12
D 000011001 00101 0010 13
E 100011000 10100 0010 14
F 001011000 01100 0010 15
G 000001101 00011 0010 16
H 100001100 10010 0010 17
I 001001100 01010 0010 18
J 000011100 00110 0010 19
K 100000011 10001 0001 20
L 001000011 01001 0001 21
M 101000010 11000 0001 22
N 000010011 00101 0001 23
O 100010010 10100 0001 24
P 001010010 01100 0001 25
Q 000000111 00011 0001 26
R 100000110 10010 0001 27
S 001000110 01010 0001 28
T 000010110 00110 0001 29
U 110000001 10001 1000 30
V 011000001 01001 1000 31
W 111000000 11000 1000 32
X 010010001 00101 1000 33
Y 110010000 10100 1000 34
Z 011010000 01100 1000 35
- 010000101 00011 1000 36
. 110000100 10010 1000 37
SPACE 011000100 01010 1000 38
* 010010100 00110 1000 -
$ 010101000 00000 1110 39
/ 010100010 00000 1101 40
+ 010001010 00000 1011 41
% 000101010 00000 0111 42
Check Character
The Code 39 check character is a modulus 43 sum of all of the message character values AND is printed as the last
character in the message. The check character values are given in the above table. The check chararacter is computed
by adding up all of the values, dividing by 43, AND using the remainder as the value of the check character.
Example
Message: CODE 39
Characters: C O D E 3 9
Value: 12 24 13 14 38 3 9
Sum of values: 113
113 / 43 = 2 remainder 27
27 = R check character
Final message: CODE 39R
Label Length
The length of a printed Code 39 label can be determined from the following formula, once the "x" dimension is
known. The "x" dimension is the width of the narrowest bar OR space in the bar code, AND all bars AND spaces are a
multiple of this number. The following formula assumes a 3:1 wide to narrow ratio.
Label Length = n(16x) + 31x + (16x) + M1 + M2
Parameters:
M1, M2 - Margins. These should be 0.25 inches (6 mm) OR 10
times the narrow element width, whichever is greater.
N - The number of data characters.
16x - Width of the data characters, including the
intercharacter gap (assumes a 3:1 wide to narrow
ratio)
31x - Width of the start AND stop characters. Includes
the intercharacter gap between the start character
AND the first data chatacter.
(16x) - Width of the optional check character.
The formula for label length when the wide to narrow ratio is NOT 3:1 is as follows. The "R" in the formula is the
wide to narrow ratio.
Label Length = n(3Rx+7x)+6Rx+13x+(3Rx+7x)+M1+M2
}
VAR
TheSet : BinaryCodes;
OriginalPoint : point;
count : INTEGER;
BEGIN
TheSet := Code39Digit;
OriginalPoint := Location;
for count := 0 to 3 DO
BEGIN
IF TheSet[count*2+1] THEN
DrawOneWideMark
ELSE
DrawOneNarrowMark;
IF TheSet[count*2+2] THEN
DrawOneWideSpace
ELSE
DrawOneNarrowSpace;
END;
IF TheSet[9] THEN
DrawOneWideMark
ELSE
DrawOneNarrowMark;
DrawOneNarrowSpace;
TempDrawString := '.';
TempDrawString[1] := ch;
moveto(OriginalPoint.h,OriginalPoint.v+BarPixelsHigh+9);
IF ch <> ' ' THEN
if not IsCheckingWidth then
drawstring(TempDrawString);
END;
PROCEDURE DrawOneCode128BarSet(Code128Digit:BinaryCodes; ch:CHAR);
{
Code 128
CODE 128
Code 128 is a continuous, multilevel, full ASCII code. Each of the Code 128 characters
consists of three bars AND three spaces. The bars AND spaces may be one, two, three, OR
four modules wide. The total length of each code 128 character is eleven modules, WITH
the total length of the bar modules odd, AND the total length of the space modules even.
The character set consists of 103 different characters, three different start characters, AND
one unique stop character. WITH the three different start characters, there are three
different code subsets available. They are:
1.Using the ``A'' start character -- All upper CASE alphanumeric characters plus all
of the ASCII control characters.
2.Using the ``B'' start character -- All upper AND lower CASE alphanumeric
characters.
3.Using the ``C'' start character -- Double density numeric characters, all number
pairs from 00 to 99.
The stop character is different than the other characters because it consists of 4 bars AND
3 spaces.
The user can switch from Code A to Code B OR from Code B to Code A by using the
SHIFT character. This will switch the code character set for one character. IF the user
wants to change character sets for more than one character, the CODE A, CODE B, OR
CODE C characters must be used.
A check character is mandatory for Code 128. The check character is a modulus 103 sum
of the character values, weighted by position in the message. The check character is
calculated by summing the value for the start character WITH the products from the value
of the message characters times their position in the message, WITH the character that
follows the start character in the first position. The stop character is NOT included in the
calculation. The result is divided by 103, AND the character that corresponds to the
remainder is the check character.
Check Character Example
Message: CODE 128
Characters: Start A C O D E 1 2 8
Value: 103 35 47 36 37 0 17 18 24
Position: - 1 2 3 4 5 6 7 8
Calculate Total: 103 + (35 x 1) + (47 x 2) + (36 x 3) +
(37 x 4) + (0 x 5) + (17 x 6) +
(18 x 7) + (24 x 8) = 908
908 / 103 = 8 remainder 84
84 = DC4
Final message: (Start A)CODE 128(DC4)(STOP)
Code construction: The numbers under the B AND S dictates how wide that element is AND the total length of
all elements is 11 spaces (whatever the width of a single bar OR space is) wide.
Code 128 Character Set
BAR PATTERN
VALUE CODE A CODE B CODE C B S B S B S
0 SPACE SPACE 00 2 1 2 2 2 2
1 ! ! 01 2 2 2 1 2 2
2 " " 02 2 2 2 2 2 1
3 # # 03 1 2 1 2 2 3
4 $ $ 04 1 2 1 3 2 2
5 % % 05 1 3 1 2 2 2
6 & & 06 1 2 2 2 1 3
7 ' ' 07 1 2 2 3 1 2
8 ( ( 08 1 3 2 2 1 2
9 ) ) 09 2 2 1 2 1 3
10 * * 10 2 2 1 3 1 2
11 + + 11 2 3 1 2 1 2
12 , , 12 1 1 2 2 3 2
13 - - 13 1 2 2 1 3 2
14 . . 14 1 2 2 2 3 1
15 / / 15 1 1 3 2 2 2
16 0 0 16 1 2 3 1 2 2
17 1 1 17 1 2 3 2 2 1
18 2 2 18 2 2 3 2 1 1
19 3 3 19 2 2 1 1 3 2
20 4 4 20 2 2 1 2 3 1
21 5 5 21 2 1 3 2 1 2
22 6 6 22 2 2 3 1 1 2
23 7 7 23 3 1 2 1 3 1
24 8 8 24 3 1 1 2 2 2
25 9 9 25 3 2 1 1 2 2
26 : : 26 3 2 1 2 2 1
27 ; ; 27 3 1 2 2 1 2
28 < < 28 3 2 2 1 1 2
29 = = 29 3 2 2 2 1 1
30 > > 30 2 1 2 1 2 3
31 ? ? 31 2 1 2 3 2 1
32 @ @ 32 2 3 2 1 2 1
33 A A 33 1 1 1 3 2 3
34 B B 34 1 3 1 1 2 3
35 C C 35 1 3 1 3 2 1
36 D D 36 1 1 2 3 1 3
37 E E 37 1 3 2 1 1 3
38 F F 38 1 3 2 3 1 1
39 G G 39 2 1 1 3 1 3
40 H H 40 2 3 1 1 1 3
41 I I 41 2 3 1 3 1 1
42 J J 42 1 1 2 1 3 3
43 K K 43 1 1 2 3 3 1
44 L L 44 1 3 2 1 3 1
45 M M 45 1 1 3 1 2 3
46 N N 46 1 1 3 3 2 1
47 O O 47 1 3 3 1 2 1
48 P P 48 3 1 3 1 2 1
49 Q Q 49 2 1 1 3 3 1
50 R R 50 2 3 1 1 3 1
51 S S 51 2 1 3 1 1 3
52 T T 52 2 1 3 3 1 1
53 U U 53 2 1 3 1 3 1
54 V V 54 3 1 1 1 2 3
55 W W 55 3 1 1 3 2 1
56 X X 56 3 3 1 1 2 1
57 Y Y 57 3 1 2 1 1 3
58 Z Z 58 3 1 2 3 1 1
59 [ [ 59 3 3 2 1 1 1
60 \ \ 60 3 1 4 1 1 1
61 ] ] 61 2 2 1 4 1 1
62 ^ ^ 62 4 3 1 1 1 1
63 _ _ 63 1 1 1 2 2 4
64 NU ` 64 1 1 1 4 2 2
65 SH a 65 1 2 1 1 2 4
66 SX b 66 1 2 1 4 2 1
67 EX c 67 1 4 1 1 2 2
68 ET d 68 1 4 1 2 2 1
69 EQ e 69 1 1 2 2 1 4
70 AK f 70 1 1 2 4 1 2
71 BL g 71 1 2 2 1 1 4
72 BS h 72 1 2 2 4 1 1
73 HT i 73 1 4 2 1 1 2
74 LF j 74 1 4 2 2 1 1
75 VT k 75 2 4 1 2 1 1
76 FF l 76 2 2 1 1 1 4
77 CR m 77 4 1 3 1 1 1
78 SO n 78 2 4 1 1 1 2
79 SI o 79 1 3 4 1 1 1
80 DL p 80 1 1 1 2 4 2
81 D1 q 81 1 2 1 1 4 2
82 D2 r 82 1 2 1 2 4 1
83 D3 s 83 1 1 4 2 1 2
84 D4 t 84 1 2 4 1 1 2
85 NK u 85 1 2 4 2 1 1
86 SY v 86 4 1 1 2 1 2
87 EB w 87 4 2 1 1 1 2
88 CN x 88 4 2 1 2 1 1
89 EM y 89 2 1 2 1 4 1
90 SB z 90 2 1 4 1 2 1
91 EC } { 91 4 1 2 1 2 1 <--- added close brace to keep it within a Pascal comment
92 FS 92 1 1 1 1 4 3
93 GS } { 93 1 1 1 3 4 1 <--- added open brace to keep it within a Pascal comment
94 RS ~ 94 1 3 1 1 4 1
95 US DEL 95 1 1 4 1 1 3
96 FNC 3 FNC 3 96 1 1 4 3 1 1
97 FNC 2 FNC 2 97 4 1 1 1 1 3
98 SHIFT SHIFT 98 4 1 1 3 1 1
99 CODE C CODE C 99 1 1 3 1 4 1
100 CODE B FNC 4 CODE B 1 1 4 1 3 1
101 FNC 4 CODE A CODE A 3 1 1 1 4 1
102 FNC 1 FNC 1 FNC 1 4 1 1 1 3 1
Code 128 Start Characters
VALUE START B S B S B S
103 CODE A 2 1 1 4 1 2
104 CODE B 2 1 1 2 1 4
105 CODE C 2 1 1 2 3 2
Code 128 Stop Character
VALUE B S B S B S B
106 STOP 2 3 3 1 1 1 2
}
VAR
TheSet : BinaryCodes;
OriginalPoint : point;
count : INTEGER;
BEGIN
TheSet := Code128Digit;
OriginalPoint := Location;
for count := 1 to 11 DO
IF TheSet[count] THEN
DrawOneMark
ELSE
DrawOneSpace;
IF ch = 'ί' THEN
for count := 12 to 13 DO
IF TheSet[count] THEN
DrawOneMark
ELSE
DrawOneSpace;
IF (ch<>'') AND (ch<>'ί') THEN
BEGIN
TempDrawString := '.';
TempDrawString[1] := ch;
moveto(OriginalPoint.h,OriginalPoint.v+BarPixelsHigh+9);
if not IsCheckingWidth then
drawstring(TempDrawString);
END;
END;
PROCEDURE DrawOneCodeI25BarSpaceSet(Bar,Space:BinaryCodes);
{
Interleaved 2 of 5 code is a numeric only bar code. Each character of this code is
represented by five elements, two wide AND three narrow. Wide elements are decoded as
binary one (1), AND narrow elements are decoded as binary zero (0). The wide to narrow
element ratio should be between two AND three.
Whether OR NOT the elements used to encode a character are bars OR spaces depends upon
the location of the character within the message. The first character of the message is
encoded into the bars immediately following the start character. The second character of
the message is encoded into the spaces between the bars of the first character, thus
eliminating the intercharacter space. Because of this, Interleaved 2 of 5 is a continuous
bar code.
Due to the interleaving of the characters, the number of characters in an Interleaved 2 of
5 message must be even. The check character, IF used, must be included in the character
count. IF the message has an odd number of characters, add a leading zero (0) to the
message.
Interleaved 2 of 5 Character Set
ASCII Binary Check Character
Character Word Value
1 10001 1
2 01001 2
3 11000 3
4 00101 4
5 10100 5
6 01100 6
7 00011 7
8 10010 8
9 01010 9
0 00110 0
Start 0000 *
Stop 100 *
NOTE: * Alternate bars AND spaces, NOT interleaved
Check Character Generation
Interleaved 2 of 5 has an optional modulus 10 check character, which is printed at the
END of the message. The value of the check character is determined by the following six
step PROCEDURE.
1.Identify even AND odd positioned characters in the message WITH the rightmost
data character always defined as an even positioned character.
2.Sum the numeric values of the odd positioned characters.
3.Sum the numeric values of the even positioned characters AND multiply this total
by three.
4.Sum the odd AND even totals from steps two AND three.
5.Determine the smallest number which, when added to the sum in step four, will
result in a multiple of ten. This number is the value of the check character.
6.Determine IF the number of characters (message plus check character) is even OR
odd. IF it is odd, add a leading, nonsignificant zero to the message to produce an
even number of characters.
Check Character Example
Message: 2632534
Characters: 2 6 3 2 5 3 4
Position: E O E O E O E
Sum of odd : 6 + 2 + 3 = 11
Sum of even : 2 + 3 + 5 + 4 = 14
Sum of even x 3: 14 x 3 = 42
Sum of even AND odd: 11 + 42 = 53
Smallest number to
reach a multiple of 10: 7
Check character: 7
Tag to be encoded: 26325347
Number of characters: even, no leading zero needed
}
VAR
count : INTEGER;
BEGIN
for count := 1 to 5 DO
BEGIN
IF Bar[count] THEN
DrawOneWideMark
ELSE
DrawOneNarrowMark;
IF Space[count] THEN
DrawOneWideSpace
ELSE
DrawOneNarrowSpace;
END;
END;
procedure DrawOneCode93BarSpaceSet;
{
Application
Code 93 can be thought of as a high-density version of the Code 39 symbology. Both symbologies have strikingly similar character set and
features. Major difference lie in efficient definition of character pattern and inclusion of two check characters in the symbol in case of Code 93.
Character Set
Basic Code 93 character set has 47 characters (incl. a common 'Start' & 'Stop' character and 4 special characters called 'circle codes'). Click here
for details.
With the help of 4 'circle code' characters Code 93's character set is extended to cover all 128 ASCII character set, albeit at expense of data
density. Click here, to see Extended Code 93 Char. Set.
Unlike Code 39, due to use of unique 'circle codes' here, the full-ASCII extension is achieved unambiguously.
Data String Length
Variable length. Maximum length dictated by available space and scanner's scan width and/or decoding capabilities.
Check Character(s)
Mandatory. Two modulo 47 check characters, identified as 'C' and 'K' characters are used. 'Start' & 'Stop' Pattern
'' character is used both as a 'Start' and 'Stop' character. Additionally, a 'Termination bar' (1 module wide) is
used following the 'Stop' character pattern.
Barcode Structure
There are a total of 47 character patterns defined in Code 93. Each character pattern is 9 modules wide always starting with a bar and ending with a
space. Each character pattern is made up of 3 bars and 3 spaces.
Check Characters 'C' and 'K' are placed in positions just before the 'Stop' character, first 'C' and then 'K'. The check Character 'C' is first
calculated using the 'reverse position' (from right to left) weights. Check character 'K' is calculated next with 'C' character in the right most
position.
Neither of the check characters are transmitted to the host device by the scanner / decoder.
While using Code 93 symbology, it is possible to break up a large symbol in to multiple smaller barcodes using the concatenation feature of this
symbology. If a Barcode Symbol encoded in the Code 93 starts (left most character) with a space character, it is then possible to program the
scanner / decoder to store the decoded data read from the symbol in scanner's buffer. The scanner / decoder continues this process till such time
that a symbol is read which does not contain space character in first position the complete message is downloaded to the host. The sequence in
which the symbols are scanned here is important and has to be manually controlled.
Dimensions
Generally, a symbol height equal to 15% of symbol width or 0.25 inches, whichever is greater is recommended while using Code 93. A Quiet
Zone equal to 10X (Ten module width) is recommended on either side of the barcode.
Since each Code 93 symbol has 4 additional characters ('Start', 'Stop', Check Char.'C' & Check Char. 'K') and a 'Termination bar' of 1 module
width is used at the end of the symbol, the overall width of a Code 93 symbol can be calcuated as;
w = ((c + 4) + 1)*X
where;
w - Overall width of the barcode excluding the Quiet Zones
c - number of Code 93 characters.
X - X-dimension of the barcode (nominal width of the narrow element)
note: This formula works for Code 93 using basic character set.
©Thym Infoware, 1999-2000.
}
begin
end;
{-------- Draw entire bar codes ---------}
PROCEDURE DoCodeBar;
BEGIN
END;
PROCEDURE DoCode93;
BEGIN
END;
PROCEDURE DoCode128;
VAR
count : INTEGER;
CodeLength : INTEGER;
EncodedCharacter : INTEGER;
ch : CHAR;
Nextch : CHAR;
StartingPoint : point;
TempString : str255;
BEGIN
StartingPoint := Location;
gCurrentCode128Set := CodeUndefined;
TempString := BarCodeString;
CodeLength := length(TempString);
for count := 1 to CodeLength DO
BEGIN
ch := TempString[count];
IF count < CodeLength THEN
NextCh := TempString[count+1]
ELSE
NextCh := ' ';
IF (ch>=chr(0)) AND (ch<=chr(31)) THEN
BEGIN
IF gCurrentCode128Set = CodeUndefined THEN
BEGIN { send start code THEN the binary code }
gCurrentCode128Set := CodeA;
DrawOneCode128BarSet(Code128BinaryCodes[103].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)+64].BinaryCode,'');
END
ELSE
IF gCurrentCode128Set = CodeA THEN { send the binary code, we're already in the proper set }
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)+64].BinaryCode,'')
ELSE
BEGIN { switch sets THEN send the binary code }
gCurrentCode128Set := CodeA;
DrawOneCode128BarSet(Code128BinaryCodes[101].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)+64].BinaryCode,'');
END;
END
ELSE
IF (ch>='`') AND (ch<=chr(127)) THEN
BEGIN
IF gCurrentCode128Set = CodeUndefined THEN
BEGIN
gCurrentCode128Set := CodeB;
DrawOneCode128BarSet(Code128BinaryCodes[104].BinaryCode,'');
IF ch = chr(127) THEN
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,'')
ELSE
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch);
END
ELSE
IF gCurrentCode128Set = CodeB THEN
BEGIN
IF ch = chr(127) THEN
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,'')
ELSE
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch);
END
ELSE
BEGIN
gCurrentCode128Set := CodeB;
DrawOneCode128BarSet(Code128BinaryCodes[100].BinaryCode,'');
IF ch = chr(127) THEN
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,'')
ELSE
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch);
END
END
ELSE
IF (ch>='0') AND (ch<='9') AND (count='0') AND (Nextch<='9') THEN
BEGIN
count := count+1;
EncodedCharacter := (val(ch)*10)+val(Nextch);
ch := chr(EncodedCharacter);
IF gCurrentCode128Set = CodeUndefined THEN
BEGIN
gCurrentCode128Set := CodeC;
DrawOneCode128BarSet(Code128BinaryCodes[105].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[EncodedCharacter].BinaryCode,'');
END
ELSE
IF gCurrentCode128Set = CodeC THEN
DrawOneCode128BarSet(Code128BinaryCodes[EncodedCharacter].BinaryCode,'')
ELSE
BEGIN
gCurrentCode128Set := CodeC;
DrawOneCode128BarSet(Code128BinaryCodes[99].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[EncodedCharacter].BinaryCode,'');
END
END
ELSE
BEGIN
IF gCurrentCode128Set = CodeUndefined THEN
BEGIN
gCurrentCode128Set := CodeB;
DrawOneCode128BarSet(Code128BinaryCodes[104].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch);
END
ELSE
IF (gCurrentCode128Set = CodeB) OR (gCurrentCode128Set = CodeA) THEN
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch)
ELSE
BEGIN
gCurrentCode128Set := CodeA;
DrawOneCode128BarSet(Code128BinaryCodes[101].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch);
END
END;
END
ELSE
IF (ch>=chr(32)) AND (ch<=chr(95)) THEN
BEGIN
IF gCurrentCode128Set = CodeUndefined THEN
BEGIN
gCurrentCode128Set := CodeA;
DrawOneCode128BarSet(Code128BinaryCodes[103].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch);
END
ELSE
IF (gCurrentCode128Set = CodeB) OR (gCurrentCode128Set = CodeA) THEN
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch)
ELSE
BEGIN
gCurrentCode128Set := CodeA;
DrawOneCode128BarSet(Code128BinaryCodes[101].BinaryCode,'');
DrawOneCode128BarSet(Code128BinaryCodes[ord(ch)-32].BinaryCode,ch);
END
END;
END;
DrawOneCode128BarSet(Code128BinaryCodes[106].BinaryCode,'ί');
END;
PROCEDURE DoCode39;
VAR
count : INTEGER;
Code39ch : CHAR;
DecodedCharacter : INTEGER;
BEGIN
TextSize(RealHumanReadableTextSize);
Code39Check := 0;
DrawOneCode39BarSet(Code39BinaryCodes[43],' ');
for count := 1 to length(BarCodeString) DO
BEGIN
Code39ch := BarCodeString[count];
CASE Code39ch of
'0'..'9':
BEGIN
DecodedCharacter := val(Code39ch);
END;
'A'..'Z':
BEGIN
DecodedCharacter := ord(Code39ch)-ord('A')+10;
END;
'a'..'z':
BEGIN
DecodedCharacter := ord(Code39ch)-ord('a')+10;
END;
'-':
BEGIN
DecodedCharacter := 36;
END;
'.':
BEGIN
DecodedCharacter := 37;
END;
' ':
BEGIN
DecodedCharacter := 38;
END;
'$':
BEGIN
DecodedCharacter := 39;
END;
'/':
BEGIN
DecodedCharacter := 40;
END;
'+':
BEGIN
DecodedCharacter := 41;
END;
'%':
BEGIN
DecodedCharacter := 42;
END;
OTHERWISE
BEGIN
gBarCodeError := InvalidCode39Character;
exit(DoCode39);
END;
END; {CASE}
DrawOneCode39BarSet(Code39BinaryCodes[DecodedCharacter],Code39ch);
Code39Check := Code39Check+DecodedCharacter;
END;
Code39Check := Code39Check MOD 43;
IF CheckCharacterOption THEN
DrawOneCode39BarSet(Code39BinaryCodes[Code39Check],' ');
DrawOneCode39BarSet(Code39BinaryCodes[43],' ');
END;
PROCEDURE DoCode11;
VAR
TempString : str255;
TempString1 : str255;
CheckDigit : INTEGER;
StringLength : INTEGER;
StartingPoint : point;
Count : INTEGER;
BEGIN
TempString := BarCodeString;
TempString1 := BarCodeString;
StartingPoint := Location;
StringLength := length(TempString)+2;
CheckDigit := 0;
WHILE length(TempString1)>0 DO
BEGIN
CheckDigit := CheckDigit+(val(TempString1[1])*length(TempString1));
delete(TempString1,1,1)
END;
CheckDigit := (11-(CheckDigit MOD 11)) MOD 11;
TempString := concat(TempString,chr(ord('0')+CheckDigit));
TempString1 := TempString;
CheckDigit := 0;
WHILE length(TempString1)>0 DO
BEGIN
CheckDigit := CheckDigit+(val(TempString1[1])*length(TempString1));
delete(TempString1,1,1)
END;
CheckDigit := (11-(CheckDigit MOD 11)) MOD 11;
TempString := concat(TempString,chr(ord('0')+CheckDigit));
DrawOneCode11BarSet(Code11BinaryCodes[11]);
for count := 1 to StringLength DO
BEGIN
DrawOneCode11BarSet(Code11BinaryCodes[val(TempString[count])]);
END;
DrawOneCode11BarSet(Code11BinaryCodes[11]);
StringLength := stringwidth(BarCodeString);
count := (Location.h-StartingPoint.h-StringLength) DIV 2;
moveto(StartingPoint.h+count,StartingPoint.v+BarPixelsHigh+HumanReadableTextSize+3);
if not IsCheckingWidth then
DrawString(BarCodeString);
END;
PROCEDURE DoEAN13;
VAR
DecodedNumber : INTEGER;
CheckDigit : INTEGER;
StartingPoint : point;
WorkingBarCodeString : str255;
CountryCode : INTEGER;
count : INTEGER;
TempCH : CHAR;
BEGIN
textsize(RealHumanReadableTextSize);
Location.h := Location.h+(RealHumanReadableTextSize div 2)+2;
StartingPoint := Location;
BarPixelsHigh := BarPixelsHigh-HumanReadableTextSize+1;
WorkingBarCodeString := BarCodeString;
IF length(BarCodeString)=11 THEN
begin { insert a zero at the beginning so we can delete it later in case you typed a zero as the first number of a 12 digit bar code }
WorkingBarCodeString := concat('0',WorkingBarCodeString);
CountryCode := 0;
end
ELSE
BEGIN
TempCH := WorkingBarCodeString[1];
CountryCode := val(TempCH);
END;
moveto(StartingPoint.h-(RealHumanReadableTextSize div 2)-1,StartingPoint.v+BarPixelsHigh+(RealHumanReadableTextSize div 2)+1);
IF CountryCode = 0 THEN
begin
Location.h := Location.h+2+HumanReadableTextSize;
TempDrawString := '.'; { one character wide }
delete(WorkingBarCodeString,1,1);
end
ELSE
begin
Location.h := Location.h+2+HumanReadableTextSize+HumanReadableTextSize;
TempDrawString := '..' { two characters wide }
end;
TempDrawString[1] := WorkingBarCodeString[1];
TempDrawString[2] := WorkingBarCodeString[2];
if not IsCheckingWidth then
drawstring(TempDrawString);
IF length(BarCodeString)=12 THEN
delete(WorkingBarCodeString,1,1);
{ calculate check digit }
CheckDigit := (val(WorkingBarCodeString[1])+val(WorkingBarCodeString[3])+val(WorkingBarCodeString[5])+val(WorkingBarCodeString[7])+val(WorkingBarCodeString[9])+val(WorkingBarCodeString[11]))*3;
CheckDigit := CheckDigit+val(WorkingBarCodeString[2])+val(WorkingBarCodeString[4])+val(WorkingBarCodeString[6])+val(WorkingBarCodeString[8])+val(WorkingBarCodeString[10]);
CheckDigit := (10 - (CheckDigit MOD 10))MOD 10;
{ guard }
UPCGuard := true;
DrawOneMark;
DrawOneSpace;
DrawOneMark;
{ flag character }
DecodedNumber := val(WorkingBarCodeString[1]);
DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,-1);
UPCGuard := false;
{ manufacturer number }
for count := 2 to 6 DO
BEGIN
DecodedNumber := val(WorkingBarCodeString[count]);
CASE CountryCode of
0:
BEGIN
DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
END;
1:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
2:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
3:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
4:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
5:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
6:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
7:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
8:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
9:
BEGIN
CASE count of
2: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
3: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
4: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
5: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftBBinaryCode,DecodedNumber);
6: DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].LeftABinaryCode,DecodedNumber);
OTHERWISE
END; {CASE}
END;
OTHERWISE
gBarCodeError := InvalidUPCCountryCode;
END; {CASE}
END;
{ guard }
UPCGuard := true;
DrawOneSpace;
DrawOneMark;
DrawOneSpace;
DrawOneMark;
DrawOneSpace;
UPCGuard := false;
{ part number }
for count := 7 to 11 DO
BEGIN
DecodedNumber := val(WorkingBarCodeString[count]);
DrawUPCBarSet(UPCBinaryCodes[DecodedNumber].RightBinaryCode,DecodedNumber);
END;
{ check digit }
UPCGuard := true;
IF CheckCharacterOption OR true THEN { check character NOT optional in this bar code }
DrawUPCBarSet(UPCBinaryCodes[CheckDigit].RightBinaryCode,-1);
moveto(Location.h+HumanReadableTextSize+BarPixelsWide+BarPixelsWide,Location.v+BarPixelsHigh+(RealHumanReadableTextSize div 2)+1);
TempDrawString := '.';
TempDrawString[1] := chr(ord('0')+CheckDigit);
if not IsCheckingWidth then
drawstring(TempDrawString);
{ guard }
DrawOneMark;
DrawOneSpace;
DrawOneMark;
END;
PROCEDURE DoUPCA;
BEGIN
DoEAN13;
END;
PROCEDURE DoUPCE;
BEGIN
gBarCodeError := UnimplementedBarCode;
END;
PROCEDURE DoEAN8;
BEGIN
gBarCodeError := UnimplementedBarCode;
END;
PROCEDURE DoUPCA2;
BEGIN
gBarCodeError := UnimplementedBarCode;
END;
PROCEDURE DoUPCA5;
BEGIN
gBarCodeError := UnimplementedBarCode;
END;
PROCEDURE DoExtendedCode39;
VAR
count : INTEGER;
DestString : str255;
TheChar : CHAR;
BEGIN
DestString := '';
for count := 1 to length(BarCodeString) DO
BEGIN
TheChar := BarCodeString[count];
DestString := concat(DestString,xCode39Codes[ord(TheChar)].TheString);
END;
BarCodeString := DestString;
DoCode39;
END;
PROCEDURE DoCodeI25;
VAR
count : INTEGER;
CheckCode : INTEGER;
TempString : str255;
TheChar : CHAR;
StartingPoint : point;
BEGIN
StartingPoint := Location;
CheckCode := 0;
TempString := BarCodeString;
IF CheckCharacterOption THEN
BEGIN
for count := 1 to length(TempString) DO
BEGIN
TheChar := TempString[count];
IF odd(count) THEN
CheckCode := CheckCode+val(TheChar)
ELSE
CheckCode := CheckCode+(val(TheChar)*3);
CheckCode := (10-(CheckCode MOD 10)) MOD 10;
END;
TempString := concat(TempString,chr(ord('0')+CheckCode));
END;
IF odd(length(TempString)) THEN
TempString := concat('0',TempString);
{ start character }
DrawOneNarrowMark;
DrawOneNarrowSpace;
DrawOneNarrowMark;
DrawOneNarrowSpace;
{ data characters }
for count := 1 to (length(TempString) DIV 2) DO
BEGIN
{ since CheckCode is used above, we'll reuse the variable from here on down to keep memory usage to a minimum }
CheckCode := ((count-1)*2)+1;
DrawOneCodeI25BarSpaceSet(CodeI25BinaryCodes[val(TempString[CheckCode])],CodeI25BinaryCodes[val(TempString[CheckCode+1])]);
END;
{ stop character }
DrawOneWideMark;
DrawOneNarrowSpace;
DrawOneNarrowMark;
{ text part }
textsize(RealHumanReadableTextSize);
count := (Location.h-StartingPoint.h-stringwidth(BarCodeString)) DIV 2;
moveto(StartingPoint.h+count,StartingPoint.v+BarPixelsHigh+HumanReadableTextSize+3);
if not IsCheckingWidth then
DrawString(BarCodeString);
END;
PROCEDURE DoPostnet;
VAR
CheckCode : INTEGER;
count : INTEGER;
TempString : str255;
BEGIN
TempString := BarCodeString;
IF CheckCharacterOption OR true THEN { check character NOT optional }
BEGIN
CheckCode := 0;
for count := 1 to length(TempString) DO
CheckCode := CheckCode+val(TempString[count]);
CheckCode := (10-(CheckCode MOD 10)) MOD 10;
TempString := concat(TempString,chr(ord('0')+CheckCode));
END;
DrawOnePostnetMark;
for count := 1 to length(TempString) DO
DrawOnePostnetBarSet(PostnetBinaryCodes[val(TempString[count])]);
DrawOnePostnetMark;
END;
procedure StripOffAllButNumbers;
var
count : integer;
begin
count := 1;
while count <= length(BarCodeString) do
begin
while ((count <= length(BarCodeString)) and not( BarCodeString[count] in ['0'..'9'])) do
begin
delete(BarCodeString,count,1);
end;
count := count+1;
end;
end;
PROCEDURE DrawBarCode(at : point; BarCodeText : str255; BarCodeKind : BarCodeTypes; DrawCheckCharacter : BOOLEAN);
BEGIN
RealHumanReadableTextSize := trunc(HumanReadableTextSize*(DotsPerInch/72)); { calculate the new human readable text size }
UPCGuard := false;
IsCheckingWidth := false;
IF HumanReadableTextSize<4 THEN
gBarCodeError := HumanReadableTextTooSmall
else
gBarCodeError := NoBarCodingErrorDetected;
if gBarCodeError = NoBarCodingErrorDetected then
begin
Location := at;
UPCGuard := false;
BarCodeString := BarCodeText;
CheckCharacterOption := DrawCheckCharacter;
CASE BarCodeKind of
Codebar:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoCodeBar
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
Code11:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoCode11
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
Code128:
BEGIN
DoCode128;
END;
Code39:
BEGIN
Code39Check := 0;
DoCode39;
END;
Code93:
BEGIN
DoCode93;
END;
UPC:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
CASE length(BarCodeString) of
7 : DoUPCE;
8 : DoEAN8;
11: DoUPCA;
12: DoEAN13;
13: DoUPCA2;
16: DoUPCA5;
OTHERWISE
gBarCodeError := ParametersDontMatchBarCodeType;
END {CASE}
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
ExtendedCode39:
BEGIN
DoExtendedCode39;
END;
CodeI25:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoCodeI25
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
Postnet:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoPostnet
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
OTHERWISE
BEGIN
gBarCodeError := UnimplementedBarCode;
END;
END; { case }
end;
END;
function BarCodeWidth(at : point; BarCodeText : str255; BarCodeKind : BarCodeTypes; DrawCheckCharacter : BOOLEAN): longint;
BEGIN
UPCGuard := false;
IsCheckingWidth := true;
TheBarCodeWidth := 0;
IF HumanReadableTextSize<4 THEN
gBarCodeError := HumanReadableTextTooSmall
else
gBarCodeError := NoBarCodingErrorDetected;
if gBarCodeError = NoBarCodingErrorDetected then
begin
Location := at;
UPCGuard := false;
BarCodeString := BarCodeText;
CheckCharacterOption := DrawCheckCharacter;
CASE BarCodeKind of
Codebar:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoCodeBar
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
Code11:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoCode11
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
Code128:
BEGIN
DoCode128;
END;
Code39:
BEGIN
Code39Check := 0;
DoCode39;
END;
Code93:
BEGIN
DoCode93;
END;
UPC:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
CASE length(BarCodeString) of
7 : DoUPCE;
8 : DoEAN8;
11: DoUPCA;
12: DoEAN13;
13: DoUPCA2;
16: DoUPCA5;
OTHERWISE
gBarCodeError := ParametersDontMatchBarCodeType;
END {CASE}
else
begin
gBarCodeError := NoStringToBarCode;
end;
if gBarCodeError = NoBarCodingErrorDetected then
TheBarCodeWidth := TheBarCodeWidth+2+HumanReadableTextSize+HumanReadableTextSize;
END;
ExtendedCode39:
BEGIN
DoExtendedCode39;
END;
CodeI25:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoCodeI25
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
Postnet:
BEGIN
StripOffAllButNumbers;
if BarCodeString <> BarCodeText then
gBarCodeError := IllegalCharactersInString;
if length(BarCodeString)>0 then
DoPostnet
else
begin
gBarCodeError := NoStringToBarCode;
end;
END;
OTHERWISE
BEGIN
gBarCodeError := UnimplementedBarCode;
END;
END; { case }
end;
BarCodeWidth := TheBarCodeWidth;
END;
END.