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

program QLabel;
var
line : array [1..6] of string[50];
a,b,c,d,e,w,x,y,z : integer;
ch,size,more,sp,vf : char;
strvar : string[5];
exit,abort,doneprint : boolean;

procedure Format;
begin
textcolor(11);
gotoxy (1,2);
for x:=1 to 79 do begin
write ('_')
end;
gotoxy (1,4);
ClrEol;
gotoxy (1,5);
for x:=1 to 79 do begin
write ('_')
end;
end;

procedure Check;
begin
textcolor(14);write('Press [');
textcolor (11+blink);write ('Y');textcolor(14);write ('] or [');
textcolor (11+blink);write ('N');textcolor(14);write (']: ');
repeat
read (kbd,ch)
until upcase(ch) in ['Y','N'];
ch:=upcase(ch);
write (ch);
end;

procedure Welcome;
begin
clrscr;textcolor(10);
writeln ('Quick Label Printer / Andy Frish (c) 1986-91 / Version 2.0');
format;
writeln;
end;

procedure GetSize;
begin
format;exit:=false;textcolor(14);abort:=false;doneprint:=false;b:=0;
gotoxy (1,4);write ('Are you printing [');w:=0;c:=0;sp:=(' ');vf:=(' ');
textcolor(11+blink);write ('L');textcolor(14);write(']arge (1 7/16") or [');
textcolor(11+blink);write ('S');textcolor(14);write(']mall (15/16") labels? ');
repeat read (kbd,size) until upcase(size) in ['L','S'];size:=upcase(size);writeln(size);writeln;
if size=('L') then z:=6 else z:=4;
end;

procedure GetText;
begin
format;textcolor(14);
gotoxy(1,4);writeln ('Please enter label information below');
for y:=1 to z do
begin
gotoxy (1,(y+6));textcolor(14);
write ('Enter text for line ');write (y);write (': ');
textcolor(11);readln (line [y]);
end
end;

procedure Verify;
begin

format;textcolor(14);
gotoxy(1,4);
write ('Are all entries correct? ');
check;vf:=ch;
end;

procedure Correct;
begin
if ch=('N') then begin
format;y:=0;textcolor(14);
gotoxy(1,4);write ('Which line would you like to change? ');
readln(strvar);
val(strvar,y,x);
if (y>0) and (y<(z+1)) then
begin
format;
gotoxy(1,4);textcolor(14);
writeln ('Please enter label information below');
gotoxy (1,(y+6));ClrEol;textcolor(14);
write ('Enter text for line ');write (y);write (': ');
textcolor(11);
readln (line [y]);
end;
end;
end;

procedure StartPrint;
begin
format;textcolor(14);b:=0;
gotoxy (1,4);write ('How many labels would you like to print?');
textcolor(11);
gotoxy (49,4);write('[Enter "Q" to abort this label]');
gotoxy (42,4);
readln(strvar);
if strvar=('Q') then exit:=true;
if strvar=('q') then exit:=true;
val(strvar,b,x);
end;

procedure ReadyPrint;
begin
format;gotoxy(1,4);
textcolor (14);
write ('Ready to begin printing? ');
check;sp:=ch;
if sp=('Y') then doneprint:=false;
end;

procedure CheckPrint;
begin
for e:=1 to 2500 do begin
if KeyPressed then begin
read (kbd,ch);
if upcase(ch)=('S') then begin
gotoxy (39,4);ClrEol;
textcolor(14);write('Printing stopped! [');
textcolor (11+blink);write ('A');textcolor(14);
write (']bort or [');
textcolor (11+blink);write ('R');
textcolor(14);write (']esume? ');
repeat
read (kbd,ch);
until upcase(ch) in ['R','A'];
if upcase(ch)=('A') then abort:=true;
end;
gotoxy(39,4);ClrEol;gotoxy(60,4);
write('(Press [');textcolor(11+blink);
write('S');textcolor(14);write('] to stop)');
end;
end;
end;

procedure Print;
begin
format;gotoxy(1,4);textcolor(14);
write ('Printing label number [');
gotoxy(60,4);
write('(Press [');textcolor(11+blink);
write('S');textcolor(14);write('] to stop)');
for a:=1 to b do
begin
if not abort then begin
gotoxy(24,4);textcolor(11);
write (a,'] of [',b,']');
CheckPrint;
if not abort then
for y:=1 to z do begin
writeln (lst,line [y]);
end;
if size=('L') then writeln (lst);
writeln (lst);writeln (lst);
end;
end;
doneprint:=true
end;

procedure AnyMore;
begin
for x:=6 to (6+z) do
begin
gotoxy (1,x);
ClrEol;
end;
format;gotoxy (1,4);textcolor(14);
write ('Do you have more labels to print? ');
check;more:=ch;
if ch='N' then
begin
writeln;writeln;format;gotoxy(1,4);textcolor(14);
write ('Thanks for using Quick Label Printer');
textcolor(13+blink);writeln('!');textcolor(11);
gotoxy(1,7);writeln('Quick Label Printer (c) Andy Frish 1986-91.');
gotoxy(1,9);writeln('This program my be copied freely and distributed under the "Shareware"');
gotoxy(1,10);writeln('concept. No alterations may be made to this program without written');
gotoxy(1,11);writeln('permission from the author.');
gotoxy(1,13);writeln('Any suggestions or comments (or bug reports) would be appreciated.');
gotoxy(1,15);writeln('This program was written in a constructive attempt to learn Borland',chr(39),'s');
gotoxy(1,16);writeln('Turbo Pascal (tm). If you wish to reach the author, your best chance is to');
gotoxy(1,17);writeln('leave Email on "The Boss" BBS at (201) 568-7293. Of course if you find ');
gotoxy(1,18);writeln('this software helpful, donations will be gladly accepted. Contact me on');
gotoxy(1,19);writeln('"The Boss" for the address. Thank you and I hope you enjoy!');
writeln;
end;
end;

procedure Loop;
begin
while ((sp<>'Y') or (vf<>'Y')) and not exit do
begin
if not abort then while (b<1) and not exit do StartPrint;
if not exit then begin
ReadyPrint;
if sp='N' then vf:=(' ');
while (vf<>'Y') do
begin
Verify;
Correct;
end;
end;
end;
end;

procedure Loop2;
begin
while not doneprint do begin;
Print;
if abort then vf:=(' ');
while ((sp<>'Y') or (vf<>'Y')) do
begin
if sp='N' then vf:=(' ');
while (vf<>'Y') do
begin
Verify;
Correct;
end;
b:=0;
while (b<1) and not exit do StartPrint;
if not exit then ReadyPrint;
if sp=('Y')then abort:=false;
end;
end;
end;

begin {Main Program}
repeat
Welcome;
GetSize;
GetText;
repeat
Verify;
Correct;
until (vf='Y');
If not exit then Loop;
if exit=true then doneprint:=true;
If not exit then Loop2;
AnyMore;
until upcase(more) in ['N'];
end.