Category : Printer + Display Graphics
Archive : PMLABEL.ZIP
Filename : PSLABEL.PAS
Output of file : PSLABEL.PAS contained in archive : PMLABEL.ZIP
{ All commands are for an Epson FX-185 printer }
{ Copyright (c) 1986 Clint Hastings - Salt Lake City, Utah }
{ Permission granted for all use of a non-commercial nature. }
type CPUreg = record case boolean of
false: (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
true: (al,ah,bl,bh,cl,ch,dl,dh : byte)
end;
PSpic = array[0..51,0..10] of byte;
{ the lines can be spaced to suit your needs but they aren't full-height
lines, so don't use them all. These are the default lines - just hit
const LabelLine : array[0..17] of string[40] =
('',
'',
' Default Lines are in the',
'',
'',
'',
' program. Put your address',
'',
'',
'',
' there to avoid retyping.',
'',
'',
'',
'',
'',
'',
'');
var reg : CPUreg;
filename : string[80];
g, n, Graphic, NumLabels,
Col, Row, x, len1, len2 : integer;
pf : file of PSpic;
pic : PSpic;
FileDrive, sameG : string[1];
same : boolean;
procedure PrintPSGraphic(n : integer);
const BitMask : array[0..7] of byte =
($80, $40, $20, $10, 8, 4, 2, 1);
var TempY : array[0..3] of byte;
temp,b : byte;
buf : array[0..127] of byte;
BufPtr, step, y, x, p, i, j : integer;
ch : char;
begin
for y := 0 to 12 do BEGIN { 52 dots @ 4 dots per row = 13 rows }
if LabelLine[y] <> '' then
write(lst,LabelLine[y],#13);
write(lst,#27'L',chr(len1),chr(len2));
for x := 0 to 10 do BEGIN
for i := 0 to 3 do { get next line }
TempY[i] := pic[ y*4+i, x];
for j := 0 to 7 do BEGIN
temp := 0;
for i := 0 to 3 do
if (TempY[i] AND (1 shl (7-j)) ) <> 0 then
temp := temp + (1 shl (3-i));
write(lst,chr(temp))
END;
END;
writeln(lst)
END;
for y := 13 to 17 do BEGIN { spacing for next label }
if LabelLine[y] <> '' then
write(lst,LabelLine[y],#13);
writeln(lst)
END;
if not same then read(pf,pic); { if not all the same graphic, }
end; { then fetch the next one here }
procedure InfoScreen;
begin
gotoxy(3,1);
writeln('Copyright (c) 1986 - Clint Hastings - Salt Lake City, Utah');
gotoxy(5,3);
writeln('********** PRINTSHOP LABEL MAKER ****************');
writeln;
writeln(' This program lets you print mailing labels using');
writeln(' PrintShop graphics for decoration. You can print');
writeln(' as many labels as you want. The graphic can be the');
writeln(' same on each label, or can move sequentially through');
writeln(' the graphic file starting at a given graphic. It can');
writeln(' use the default graphic files - hit
writeln(' to graphic file?. You can use the library disk by typing');
writeln(' 1 or 2. Graphic file drive - type A,B,C, etc., but no');
writeln(' colon is necessary. Have fun!!!');
writeln('NOTE:');
writeln(' Printer codes are for Epson FX printers. Source code');
writeln(' in Turbo Pascal is provided for you to make necessary');
writeln(' changes for other printers.');
writeln;
writeln
end;
procedure Setup;
var line : string[40];
begin
write(lst,#27'A'#4); { 4 dots high - line spacing }
len1 := (11*8) mod 256; { calculate number of dots per line }
len2 := (11*8) div 256;
InfoScreen;
writeln(' PRINTSHOP LABEL MAKER');
write(#13#10' Number of Labels to print ? ');
readln(NumLabels);
write(#13#10' Starting graphic # to print ? ');
readln(Graphic);
Graphic := Graphic - 1;
write(#13#10' Graphic file (0,1,2) ? ');
readln(FileName);
write(#13#10' Graphic file drive ? ');
readln(FileDrive);
if FileName = '' then FileName := FileDrive + ':' + 'GrData.Dat'
else FileName := FileDrive + ':GrLib' + FileName + '.dat';
assign(pf,FileName);
{$I-} reset(pf); {$I+}
if IOresult <> 0 then HALT;
seek(pf,Graphic);
read(pf,pic);
writeln;
writeln('3 label lines :');
write(' ');
readln(line);
if line <> '' then BEGIN
LabelLine[2] := ' ' + line;
readln(line);
LabelLine[6] := ' ' + line;
readln(line);
LabelLine[10] := ' ' + line;
END;
write('All the same graphic (y/n) ? ');
readln(sameG);
same := (sameG <> 'n') and (sameG <> 'N');
end;
begin
ClrScr;
Setup;
for n := Graphic to Graphic-1+NumLabels do PrintPSGraphic(n);
close(pf);
write(lst,#27'2'); { restore regular line spacing }
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/