home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
HPDUMP01.ZIP
/
EGAPRTSC.PAS
Wrap
Pascal/Delphi Source File
|
1992-06-10
|
5KB
|
148 lines
{---------------------------------------------------------------}
{ Turbo Pascal unit to dump a graphics screen to an HP Laserjet }
{ compatible printer. }
{ Written by Bob Beauchaine, May 1990 }
{ No user documentation necessary. Simply include a }
{ "Uses egaprtsc" clause in your main program. When you want a }
{ screen dump to the laser printer, make a call to dumpscreen. }
{ Printing can be aborted at any time by pressing the ESC key. }
{ Works with printers attached to the Comm ports if the }
{ appropriate MODE command has been issued at the dos prompt. }
{ Note that this is *not* a BGI driver. Output resolution is }
{ limited to that of the display adapter in use. }
{---------------------------------------------------------------}
unit egaprtsc;
interface
uses crt,printer,dos,graph;
var abort : boolean;
{ This is the procedure to call from your program when you want }
{ a hardcopy. }
procedure dumpscreen;
implementation
const ESC = #27;
one : word = 1;
var regs : registers;
start_from_left,move_vertically : string;
procedure sendstring(var s : string);
{ Procedure to dump the accumulated data string to the laserjet }
inline($5B/ { POP BX (GET STRING OFFSET) }
$5A/ { POP DX (GET STRING SEGMENT) }
$1E/ { PUSH DS (SAVE DS REGISTER) }
$8E/$DA/ { MOV DS,DX (ALLOW ACCESS TO STRING DATA) }
$8A/$0F/ { MOV CL,[BX] (GET S[0],LENGTH OF STRING) }
$30/$ED/ { XOR CH,CH }
$31/$D2/ { XOR DX,DX (SELECT LPT1) }
$43/ { INC BX (POINT TO NEXT COMPONENT OF S) }
$8A/$07/ { MOV AL,[BX] (PUT NEXT CHARACTER IN AL) }
$30/$E4/ { XOR AH,AH (SELECT FUNCTION 0) }
$CD/$17/ { INT $17 (BIOS PRINTER OUTPUT) }
$E2/$F7/ { LOOP -9 (GET NEXT CHARACTER) }
$1F); { POP DS (RESTORE DS REGISTER) }
procedure set_resolution(res : integer);
{ Sets 75,100,150, or 300 dpi resolution }
var s : string;
begin
s := ESC + '*t';
case res of
75 : s := s + '75';
100 : s := s + '100';
150 : s := s + '150';
300 : s := s + '300';
end;
s := s + 'R';
sendstring(s);
end;
procedure start_raster_graphics(number : integer);
{ Places the Laserjet into graphics mode, telling it how many bytes }
{ to expect and interpret as graphics }
var s,dummy : string;
begin
s := ESC + '*b';
str(number:0,dummy);
s := s + dummy + 'W';
sendstring(s);
end;
procedure end_raster_Graphics;
{ Print one line of graphics }
var s : string;
begin
s := ESC + '*rB';
sendstring(s);
end;
procedure dumpscreen;
{ Call this from main program. You *must* be in graphics mode (note
the BGI calls or the program will abort with the familiar "Error: BGI
not initialized. Use initgraph" message . }
const start_from_left : string = ESC + '*r0A';
move_vertically : string = ESC + '*p+2Y';
label 100;
var i,j,k : integer;
graphics : string;
sbyte : word;
temp : word;
view : viewporttype;
gdriver : string;
gmode : integer;
begin
abort := false; { Reset abort flag }
getviewsettings(view); { Save current view settings for later }
setviewport(0,0,getmaxx,getmaxy,clipon);
gdriver := GetDriverName; { Find graphics mode and driver }
gmode := getgraphmode;
{ Set the size depending of how many horizontal pixels are present }
if ((gdriver = 'EGAVGA') and (gmode = 2)) or (gdriver = 'HERC')
then set_resolution(150) else set_resolution(100);
for i := 0 to getmaxx do begin
graphics := ''; { Initialize graphics string }
for j := round(getmaxy / 8) downto 0 do begin
sbyte := 0;
for k := 7 downto 0 do begin
temp := getpixel(i,j shl 3 + k);
if temp <> 0 then begin
sbyte := sbyte + one shl (2 * k);
sbyte := sbyte + one shl (k * 2 + 1);
end;
end;
{ Check for the Escape key for abort signal }
if keypressed then if readkey = #27 then goto 100;
graphics := graphics + char(hi(sbyte));
graphics := graphics + char(lo(sbyte));
end;
{ Now pipe it out }
sendstring(start_from_left);
start_raster_graphics(length(graphics));
sendstring(graphics);
end_raster_graphics;
sendstring(move_vertically);
end;
100:
write(lst,#12);
with view do setviewport(x1,y1,x2,y2,clip);
end;
end.