Category : Printer Utilities
Archive   : BARCODE.ZIP
Filename : BARCODE.PAS

PROGRAM PrintBarCodes;

{ Programmer: David Palm
17 January, 1987


This program will print out bar codes using the 3 of 9 coding method.
It runs on any IBM-PC compatible computer and prints the codes on any
Epson code compatible printer. The codes may be up to 21 characters
in length and may be any combination of numbers and letters, either
upper or lower case. You have the option of creating a disk text file
containing the codes to be printed or entering the codes directly from
the keyboard. You can use these with a TRS Model 100 or other bar
code reader. }


CONST
Character : ARRAY[1..43] of STRING[9] =
('ACADBCBCA','BCADACACB','ACBDACACB',
'BCBDACACA','ACADBCACB','BCADBCACA',
'ACBDBCACA','ACADACBCB','BCADACBCA',
'ACBDACBCA','AAAAAAAAA','AAAAAAAAA',
'AAAAAAAAA','AAAAAAAAA','AAAAAAAAA',
'AAAAAAAAA','AAAAAAAAA','BCACADACB',
'ACBCADACB','BCBCADACA','ACACBDACB',
'BCACBDACA','ACBCBDACA','ACACADBCB',
'BCACADBCA','ACBCADBCA','ACACBDBCA',
'BCACACADB','ACBCACADB','BCBCACADA',
'ACACBCADB','BCACBCADA','ACBCBCADA',
'ACACACBDB','BCACACBDA','ACBCACBDA',
'ACACBCBDA','BDACACACB','ADBCACACB',
'BDBCACACA','ADACBCACB','BDACBCACA',
'ADBCBCACA');

N1 : ARRAY[1..7] of BYTE =
(96,128,160,192,224,0,32);

N2 : ARRAY[1..7] of BYTE =
(0,0,0,0,0,1,1);

BackSpace = #8;
Escape = #27;
Line = #255;
Space = #0;
LF = #10;
CR = #13;


TYPE
STRING21 = STRING[21];
NAME = STRING[14];


VAR
InputFile : TEXT;
AsciiCode : BYTE;
InputRecord : STRING[21];
InputFileName : NAME;
CodeString : STRING[255];
InputChar, InChar : CHAR;
I, J, K, Columns, Number1, Number2 : INTEGER;



PROCEDURE SetPrinterLineSpacing;
Begin

WRITE(LST,Escape,'3',CHR(1));
End; { SetPrinterLineSpacing }


PROCEDURE SetPrinterTextMode;
Begin
WRITE(LST,Escape,'@');
End; { SetPrinterTextMode }


PROCEDURE SetPrinterGraphicsMode(N1, N2 : INTEGER);
Begin
WRITE(LST,Escape,'L',CHR(N1),CHR(N2));
End; { SetPrinterGraphicsMode }


PROCEDURE Print2Lines;
Begin
WRITE(LST,Line,Line);
End; { Print2Lines }


PROCEDURE Print6Lines;
Begin
WRITE(LST,Line,Line,Line,Line,Line,Line);
End; { Print6Lines }


PROCEDURE Print2Spaces;
Begin
WRITE(LST,Space,Space);
End; { Print2Spaces }


PROCEDURE Print6Spaces;
Begin
WRITE(LST,Space,Space,Space,Space,Space,Space);
End; { Print6Spaces }


PROCEDURE PrintBarCode(InString : STRING21);
Begin
IF InString <> '' THEN
Begin
CodeString := '';
SetPrinterLineSpacing;
CodeString := CodeString + 'CADACBCBCA';
WRITELN(InString);
FOR I := 1 TO 12 DO WRITELN(LST,LF);
FOR I := 1 TO LENGTH(InString) DO
Begin
InChar := COPY(InString,I,1);
InChar := UpCase(InChar);
AsciiCode := ORD(InChar);
IF (AsciiCode > 47) AND (AsciiCode < 91) THEN
Begin
AsciiCode := AsciiCode - 47;
CodeString := CodeString + 'C'+Character[AsciiCode];
End; { IF }
End; { FOR }
CodeString := CodeString + 'CADACBCBCA';

FOR I := 1 TO 4 DO
Begin
SetPrinterLineSpacing;
SetPrinterTextMode;
Columns := 64 + LENGTH(InString)*32;
Number2 := Columns DIV 256;
Number1 := Columns - (Number2 * 256);
SetPrinterGraphicsMode(Number1,Number2);
FOR J := 1 TO LENGTH(CodeString) DO
Begin
InputChar := COPY(CodeString,J,1);
CASE InputChar of
'A' : Print2Lines;
'B' : Print6Lines;
'C' : Print2Spaces;
'D' : Print6Spaces;
End; { CASE }
End; { FOR }
SetPrinterLineSpacing;
FOR J := 1 TO 23 DO WRITE(LST,LF);
End; { FOR }
SetPrinterTextMode;
SetPrinterLineSpacing;
FOR I := 1 TO 20 DO WRITE(LST,LF);
WRITELN(LST,'* ',InputRecord,' *');
FOR I := 1 TO 93 DO WRITELN(LST,LF);
End; { IF }
End; { PrintBarCode }


PROCEDURE RemoveSpaces(VAR InputString : STRING21);
Begin
FOR I := 1 TO LENGTH(InputString) DO
Begin
IF COPY(InputString,1,1) = ' ' THEN DELETE(InputString,1,1);
IF COPY(InputString,I,1) = ' ' THEN DELETE(InputString,I,1);
End; { FOR }
End; { RemoveSpaces }


FUNCTION FileExists(FileName : NAME) : BOOLEAN;
VAR
Fil : FILE;

Begin
ASSIGN(Fil,FileName);
{$I-}
RESET(Fil);
{$I+}
FileExists := (IOresult = 0);
End; { FileExists }




{ Main Program }

BEGIN
ClrScr;
InChar := ' ';
InputRecord := ' ';
WRITE('Input from Keyboard or Disk File? (K/D) ');
REPEAT
Begin
READ(InChar);
InChar := UpCase(InChar);
GOTOXY(41,1);
End; { REPEAT }
UNTIL (InChar = 'K') OR (InChar = 'D');
WRITELN(CR,LF,LF);

IF InChar = 'D' THEN
Begin
REPEAT
Begin
GOTOXY(1,4);
WRITE('Enter the input file name: ');
READLN(InputFileName);
IF NOT FileExists(InputFileName) THEN WRITELN(' File does not exist');
End; { REPEAT }
UNTIL FileExists(InputFileName);
ASSIGN(InputFile,InputFileName);
RESET(InputFile);
ClrEol;
WHILE NOT EOF(InputFile) AND NOT KeyPressed DO
Begin
READLN(InputFile,InputRecord);
RemoveSpaces(InputRecord);
PrintBarCode(InputRecord);
End; { WHILE }
CLOSE(InputFile);
End; { IF }

IF InChar = 'K' THEN
Begin
WHILE InputRecord <> '' DO
Begin
WRITE('Enter string: ');
READLN(InputRecord);
RemoveSpaces(InputRecord);
PrintBarCode(InputRecord);
End; { WHILE }
End; { IF }

END.