[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]
{ PW> Does anyone have any code or info on how to Program Graphics on an HP
PW> Laserjet?
--------------<start here >------------
}
Unit LJGraph;
{$F+,O+}
Interface
Const
PorTRAIT =0;
LandSCAPE =1;
GRAYSCALE =2;
Var
SCRNIMAGE :Pointer;
NEGATIVE :Boolean;
PROMPTPOS :Integer;
GraphDRIVER,GraphMODE:Integer;
Procedure PRinTPAUSE(inVERT:Boolean);
Implementation
Uses Graph,Printer,Crt;
Procedure PROMPTLinE(MSG:String);
Var
CHRHT,
MAXX,
MAXY :Integer;
begin
MAXX:=GETMAXX;
MAXY:=GETMAXY;
SETCOLor(BLACK);
SETTextSTYLE(DEFAULTFONT,HorIZDIR,1);
SETTextJUSTifY(CENTERText,toPText);
CHRHT:=TextHEIGHT('H');
PROMPTPOS:=MAXY-(CHRHT+4);
GETMEM(SCRNIMAGE,IMAGESIZE(0,PROMPTPOS,MAXX,MAXY));
GETIMAGE(0,PROMPTPOS,MAXX,MAXY,SCRNIMAGE^);
BAR(0,PROMPTPOS,MAXX,MAXY);
RECTANGLE(0,PROMPTPOS,MAXX,MAXY);
OUTTextXY(MAXX div 2,MAXY-(CHRHT+2),MSG);
end;
Function FMT(MSGPOS:Real):Integer;
Var
WIDTH :Integer;
begin
WIDTH:=6;
if(MSGPOS<1000.0)then
DEC(WIDTH);
if(MSGPOS<100.0)then
DEC(WIDTH);
if(MSGPOS<10.0)then
DEC(WIDTH);
FMT:=WIDTH;
end;
Function SETGRAYSCALE(SCANLinE,GPIXEL:Integer):Integer;
Var
GRAY :Integer;
begin
GRAY:=0;
if(GraphDRIVER=CGA) and(GraphMODE<>CGAHI)then
begin
Case SCANLinE of
0:
begin
if GPIXEL and 1<>0 then
GRAY:=GRAY or 9;
if GPIXEL and 2<>0 then
GRAY:=GRAY or 6;
end;
1:
begin
if GPIXEL and 1<>0 then
GRAY:=GRAY or 4;
if GPIXEL and 2<>0 then
GRAY:=GRAY or 11;
end;
2:
begin
if GPIXEL and 1<>0 then
GRAY:=GRAY or 2;
if GPIXEL and 2<>0 then
GRAY:=GRAY or 13;
end;
3:
begin
if GPIXEL and 1<>0 then
GRAY:=GRAY or 9;
if GPIXEL and 2<>0 then
GRAY:=GRAY or 6;
end;
end;
end
else
begin
Case SCANLinE of
0:
begin
if GPIXEL and 4<>0 then
GRAY:=GRAY or 5;
if GPIXEL and 8<>0 then
GRAY:=GRAY or 10;
end;
1:
begin
if GPIXEL and 1<>0 then
GRAY:=GRAY or 2;
if GPIXEL and 2<>0 then
GRAY:=GRAY or 8;
if GPIXEL and 8<>0 then
GRAY:=GRAY or 5;
end;
2:
begin
if GPIXEL and 4<>0 then
GRAY:=GRAY or 5;
if GPIXEL and 8<>0 then
GRAY:=GRAY or 10;
end;
3:
begin
if GPIXEL and 2<>0 then
GRAY:=GRAY or 2;
if GPIXEL and 8<>0 then
GRAY:=GRAY or 5;
end;
end;
end;
if NEGATIVE then
GRAY:=GRAY xor $0F;
SETGRAYSCALE:=GRAY;
end;
Procedure LJGraphIC(MODE:Integer);
Const
ESC =#$1B;
GRendS =ESC+'*rB';
GRinIT =ESC+'E'+ESC+'&11H'+ESC+
'&10'+ESC+'*pOY'+ESC+'*t';
Var
I,
J,
K,
P,
Q,
M,
MAXX,
MAXY :Integer;
XASP,
YASP :Word;
XPRN,
YPRN,
PRSTEP,
ASPR :Real;
begin
PUTIMAGE(0,PROMPTPOS,SCRNIMAGE^,COPYPUT);
MAXX:=GETMAXX+1;
MAXY:=GETMAXY+1;
GETASPECTRATIO(XASP,YASP);
ASPR:=XASP/YASP;
SETVIEWPorT(0,0,MAXX,MAXY,False);
Case MODE of
PorTRAIT:
begin
XPRN:=690.0;
YPRN:=500.0;
PRSTEP:=7.2/ASPR;
Write(LST,GRinIT,'100R');
For J:=0 to MAXY do
begin
Write(LST,ESC,'&A',
XPRN:FMT(XPRN):1,'h',
YPRN:FMT(YPRN):1,'V');
YPRN:=YPRN+PRSTEP;
Write(LST,ESC,'*r1A',ESC,'*b',MAXX div 8,'W');
For I:=0 to MAXX div 8 do
begin
M:=0;
For K:=0 to 7 do
begin
M:=M SHL 1;
if GETPIXEL(I*8+K,J)<>0 then
inC(M);
end;
Write(LST,Char(M));
end;
Write(LST,GRendS);
end;
end;
LandSCAPE:
begin
XPRN:=1000.0;
YPRN:=1000.0;
PRSTEP:=9.6*ASPR;
Write(LST,GRinIT,'75R');
For J:=0 to MAXX-1 do
begin
Write(LST,ESC,'&a',
XPRN:FMT(XPRN):1,'h',
YPRN:FMT(YPRN):1,'V');
YPRN:=YPRN+PRSTEP;
Write(LST,ESC,'*r1A',ESC,'*b',MAXX div 8,'W');
For I:=0 to MAXY div 8 do
begin
M:=0;
For K:=0 to 7 do
begin
M:=M SHL 1;
if GETPIXEL(MAXX-J-1,I*8+K)<>0 then
inC(M);
end;
Write(LST,Char(M));
end;
Write(LST,GRendS);
end;
end;
GRAYSCALE:
begin
XPRN:=1000.0;
YPRN:=1000.0;
PRSTEP:=2.4*ASPR;
Write(LST,GRinIT,'300R');
For J:=0 to MAXX do
For P:=0 to 3 do
begin
Write(LST,ESC,'&a',
XPRN:FMT(XPRN):1,'h',
YPRN:FMT(YPRN):1,'V');
YPRN:=YPRN+PRSTEP;
Write(LST,ESC,'*r1A',ESC,'*b',MAXY div 2,'W');
For I:=0 to MAXY div 2 do
begin
M:=0;
For K:=0 to 1 do
begin
M:=M SHL 4;
M:=M or SETGRAYSCALE(P,GETPIXEL(MAXX-J,I*2+K));
end;
Write(LST,Char(M));
end;
Write(LST,GRendS);
end;
end;
end;
Write(LST,#$0C,ESC,'&10',ESC,'(8U',ESC,'(sp10h12vsb0T',ESC,'&11H');
end;
Procedure PRinTPAUSE(inVERT:Boolean);
Var
CH :Char;
doNE :Boolean;
begin
DETECTGraph(GraphDRIVER,GraphMODE);
doNE:=False;
NEGATIVE:=inVERT;
While not doNE do
begin
PROMPTLinE('PRESS THE <P> KEY to PRinT THIS Graph '+
'or ANY OTHER to Exit....');
While KeyPressed do
CH:=ReadKey;
CH:=ReadKey;
PUTIMAGE(0,PROMPTPOS,SCRNIMAGE,COPYPUT);
Case UPCase(CH)of
'P':
begin
LJGraphIC(GRAYSCALE);
doNE:=True;
end;
else
doNE:=True;
end;
DISPOSE(SCRNIMAGE);
end;
end;
end.
{
---------- stop here --------
So first you init the Graph driver. Next you draw the Graph you want. then
you use printpause afterwards you can close the Graphdriver.
}
[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]