[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]
{ The following example routines are public domain programs }
{ that have been uploaded to our Forum on CompuServe. As a }
{ courtesy to our users that do not have immediate access }
{ to CompuServe, Technical Support distributes these }
{ routines free of charge. }
{ }
{ However, because these routines are public domain programs,}
{ not developed by Borland International, we are unable to }
{ provide any Technical Support or assistance using these }
{ routines. If you need assistance using these routines, }
{ or are experiencing difficulties, we recommend that }
{ you log onto CompuServe and request assistance from the }
{ Forum members that developed the routines. }
Unit HpCopy;
{ This unit is designed to dump graphics images produced }
{ by Turbo Pascal 4.0's Graph Unit to a Hewlett-Packard }
{ LaserJet printer. }
{ }
{ You MUST set the Aspect Ratio to 4950 before drawing a }
{ circular object on the screen. The procedure to accomplish }
{ this is also contained in this handout. }
{ }
{ If the Aspect Ratio is NOT set, the image produced by this }
{ routine will appear ellipsoid. }
Interface
Uses Crt, Dos, Graph;
Var
LST : Text; { MUST Redefine because Turbo's Printer }
{ Unit does not open LST with the File }
{ Mode as BINARY. }
Procedure HPHardCopy;
{ Procedure to be called when the desired image is on the }
{ screen. }
Procedure SetAspectRatio( NewAspect : Word );
{ Procedure to be called to set the aspect ratio such that }
{ circular objects will appear correctly on the printout }
{ generated by HpHardCopy. NOTE that the image on the }
{ screen WILL appear ellipsoid. This is NORMAL! }
Function GetAspectX : Word;
{ This Function will return the currently set aspect ratio }
{ to allow the user to save the default ratio, set it to }
{ the ratio required by HpHardCopy (4950) and then restore }
{ it to the default value. }
Implementation
Var
Width, Height : Word; { Variables used to store settings }
Vport : ViewPortType; { Used in the call GetViewSettings }
{$F+}
Function LSTNoFunction ( Var F : TextRec ) : Integer;
{ This function performs a NUL operation for a Reset or }
{ Rewrite on LST. }
Begin
LSTNoFunction := 0;
End;
Function LSTOutPutToPrinter( Var F : TextRec ) : Integer;
{ LSTOutPutToPrinter sends the output to the Printer port }
{ number stored in the first byte of the UserData area of }
{ the Text Record. }
Var
Regs : Registers;
P : Word;
Begin
With F Do
Begin
P := 0;
Regs.AH := 16;
While( P < BufPos ) and ( ( Regs.AH And 16 ) = 16 ) Do
Begin
Regs.AL := Ord( BufPtr^[P] );
Regs.AH := 0;
Regs.DX := UserData[1];
Intr( $17, Regs );
Inc( P );
End;
BufPos := 0;
End;
If( ( Regs.AH And 16 ) = 16 ) Then
LstOutPutToPrinter := 0 { No Error }
Else
If( ( Regs.AH And 32 ) = 32 ) Then
LSTOutPutToPrinter := 159 { Out of Paper }
Else
LSTOutPutToPrinter := 160; { Device Write Fault }
End;
{$F-}
Procedure AssignLST( Port : Byte );
{ AssignLST both sets up the LST text file record as would }
{ ASSIGN, and initializes it as would a RESET. }
{ }
{ The parameter passed to this procedure corresponds to }
{ DOS's LPT number. It is set to 1 by default, but can }
{ easily be changed to any LPT number by changing the }
{ parameter passed to this procedure in this unit's }
{ initialization code. }
Begin
With TextRec( Lst ) Do
Begin
Handle := $FFF0;
Mode := fmOutput;
BufSize := SizeOf( Buffer );
BufPtr := @Buffer;
BufPos := 0;
OpenFunc := @LSTNoFunction;
InOutFunc := @LSTOutPutToPrinter;
FlushFunc := @LSTOutPutToPrinter;
CloseFunc := @LSTOutPutToPrinter;
UserData[1] := Port - 1;
End;
End;
Function GetAspectX : Word;
Begin
GetAspectX := Word( Ptr( Seg( GraphFreeMemPtr ),
Ofs( GraphFreeMemPtr ) + 277 ) ^ );
End;
Procedure SetAspectRatio{ NewAspect : Word };
Begin
Word( Ptr( Seg( GraphFreeMemPtr ),
Ofs( GraphFreeMemPtr ) + 277 ) ^ ) := NewAspect;
End;
Procedure HPHardCopy;
{ Produces hard copy of a graph on Hewlett-Packard Laserjet }
{ printer By Joseph J. Hansen 9-15-87 }
{ Modified Extensively for compatibility with Version 4.0's }
{ Graph Unit By Gary Stoker }
{ }
{ Unlike Graphix Toolbox procedure HardCopy, this procedure }
{ has no parameters, though it could easily be rewritten to }
{ include resolution in dots per inch, starting column, }
{ inverse image, etc. }
{ }
Const DotsPerInch = '100';
{ 100 dots per inch gives full-screen }
{ width of 7.2 inches for Hercules card }
{ graphs, 6.4 inches for IBM color card }
{ and 6.4 inches for EGA card. Other }
{ allowable values are 75, 150, and 300.}
{ 75 dots per inch will produce a }
{ larger full-screen graph which may be }
{ too large to fit on an 8 1/2 inch }
{ page; 150 and 300 dots per inch will }
{ produce smaller graphs }
CursorPosition = '5';
{ Column position of left side of graph }
Esc = #27;
{ Escape character }
Var LineHeader : String[6];
{ Line Header used for each line sent }
{ to the LaserJet printer. }
LineLength : String[2];
{ Length in bytes of the line to be }
{ sent to the LaserJet. }
Y : Integer;
{ Temporary loop Varible. }
Procedure DrawLine ( Y : Integer );
{ Draws a single line of dots. No of Bytes sent to printer }
{ is Width + 1. Argument of the procedure is the row no, Y }
Var GraphStr : String[255]; { String used for OutPut }
Base : Word; { Starting position of }
{ output byte. }
BitNo, { Bit Number worked on }
ByteNo, { Byte number worked on }
DataByte : Byte; { Data Byte being built }
Begin
FillChar( GraphStr, SizeOf( GraphStr ), #0 );
GraphStr := LineHeader;
For ByteNo := 0 to Width Do
Begin
DataByte := 0;
Base := 8 * ByteNo;
For BitNo := 0 to 7 Do
Begin
If GetPixel( BitNo+Base, Y ) > 0
Then
Begin
DataByte := DataByte + 128 Shr BitNo;
End;
End;
GraphStr := GraphStr + Chr (DataByte)
End;
Write (Lst, GraphStr)
End; {Of Drawline}
Begin {Main procedure HPCopy}
FillChar( LineLength, SizeOf( LineLength ), #0 );
FillChar( LineHeader, SizeOf( LineHeader ), #0 );
GetViewSettings( Vport );
Width := ( Vport.X2 + 1 ) - Vport.X1;
Width := ( ( Width - 7 ) Div 8 );
Height := Vport.Y2 - Vport.Y1;
Write (Lst, Esc + 'E'); { Reset Printer }
Write (Lst, Esc+'*t'+DotsPerInch+'R'); { Set density in }
{ dots per inch }
Write (Lst, Esc+'&a'+CursorPosition+'C');{ Move cursor to }
{ starting col }
Write (Lst, Esc + '*r1A'); { Begin raster graphics }
Str (Width + 1, LineLength);
LineHeader := Esc + '*b' + LineLength + 'W';
For Y := 0 To Height + 1 Do
Begin
DrawLine ( Y );
DrawLine ( Y );
End;
Write (Lst, Esc + '*rB'); { End Raster graphics }
Write (Lst, Esc + 'E'); { Reset printer and }
{ eject page }
End;
Begin
AssignLST( 1 ); { This is the parameter to change }
{ if you want the output to be }
{ directed to a different LST }
{ device. }
End.
Unit HpCopy;
{ This unit is designed to dump graphics images produced }
{ by Turbo Pascal 4.0's Graph Unit to a Hewlett-Packard }
{ LaserJet printer. }
{ }
{ You MUST set the Aspect Ratio to 4950 before drawing a }
{ circular object on the screen. The procedure to accomplish }
{ this is also contained in this handout. }
{ }
{ If the Aspect Ratio is NOT set, the image produced by this }
{ routine will appear ellipsoid. }
Interface
Uses Crt, Dos, Graph;
Var
LST : Text; { MUST Redefine because Turbo's Printer }
{ Unit does not open LST with the File }
{ Mode as BINARY. }
Procedure HPHardCopy;
{ Procedure to be called when the desired image is on the }
{ screen. }
Procedure SetAspectRatio( NewAspect : Word );
{ Procedure to be called to set the aspect ratio such that }
{ circular objects will appear correctly on the printout }
{ generated by HpHardCopy. NOTE that the image on the }
{ screen WILL appear ellipsoid. This is NORMAL! }
Function GetAspectX : Word;
{ This Function will return the currently set aspect ratio }
{ to allow the user to save the default ratio, set it to }
{ the ratio required by HpHardCopy (4950) and then restore }
{ it to the default value. }
Implementation
Var
Width, Height : Word; { Variables used to store settings }
Vport : ViewPortType; { Used in the call GetViewSettings }
{$F+}
Function LSTNoFunction ( Var F : TextRec ) : Integer;
{ This function performs a NUL operation for a Reset or }
{ Rewrite on LST. }
Begin
LSTNoFunction := 0;
End;
Function LSTOutPutToPrinter( Var F : TextRec ) : Integer;
{ LSTOutPutToPrinter sends the output to the Printer port }
{ number stored in the first byte of the UserData area of }
{ the Text Record. }
Var
Regs : Registers;
P : Word;
Begin
With F Do
Begin
P := 0;
Regs.AH := 16;
While( P < BufPos ) and ( ( Regs.AH And 16 ) = 16 ) Do
Begin
Regs.AL := Ord( BufPtr^[P] );
Regs.AH := 0;
Regs.DX := UserData[1];
Intr( $17, Regs );
Inc( P );
End;
BufPos := 0;
End;
If( ( Regs.AH And 16 ) = 16 ) Then
LstOutPutToPrinter := 0 { No Error }
Else
If( ( Regs.AH And 32 ) = 32 ) Then
LSTOutPutToPrinter := 159 { Out of Paper }
Else
LSTOutPutToPrinter := 160; { Device Write Fault }
End;
{$F-}
Procedure AssignLST( Port : Byte );
{ AssignLST both sets up the LST text file record as would }
{ ASSIGN, and initializes it as would a RESET. }
{ }
{ The parameter passed to this procedure corresponds to }
{ DOS's LPT number. It is set to 1 by default, but can }
{ easily be changed to any LPT number by changing the }
{ parameter passed to this procedure in this unit's }
{ initialization code. }
Begin
With TextRec( Lst ) Do
Begin
Handle := $FFF0;
Mode := fmOutput;
BufSize := SizeOf( Buffer );
BufPtr := @Buffer;
BufPos := 0;
OpenFunc := @LSTNoFunction;
InOutFunc := @LSTOutPutToPrinter;
FlushFunc := @LSTOutPutToPrinter;
CloseFunc := @LSTOutPutToPrinter;
UserData[1] := Port - 1;
End;
End;
Function GetAspectX : Word;
Begin
GetAspectX := Word( Ptr( Seg( GraphFreeMemPtr ),
Ofs( GraphFreeMemPtr ) + 277 ) ^ );
End;
Procedure SetAspectRatio{ NewAspect : Word };
Begin
Word( Ptr( Seg( GraphFreeMemPtr ),
Ofs( GraphFreeMemPtr ) + 277 ) ^ ) := NewAspect;
End;
Procedure HPHardCopy;
{ Produces hard copy of a graph on Hewlett-Packard Laserjet }
{ printer By Joseph J. Hansen 9-15-87 }
{ Modified Extensively for compatibility with Version 4.0's }
{ Graph Unit By Gary Stoker }
{ }
{ Unlike Graphix Toolbox procedure HardCopy, this procedure }
{ has no parameters, though it could easily be rewritten to }
{ include resolution in dots per inch, starting column, }
{ inverse image, etc. }
{ }
Const DotsPerInch = '100';
{ 100 dots per inch gives full-screen }
{ width of 7.2 inches for Hercules card }
{ graphs, 6.4 inches for IBM color card }
{ and 6.4 inches for EGA card. Other }
{ allowable values are 75, 150, and 300.}
{ 75 dots per inch will produce a }
{ larger full-screen graph which may be }
{ too large to fit on an 8 1/2 inch }
{ page; 150 and 300 dots per inch will }
{ produce smaller graphs }
CursorPosition = '5';
{ Column position of left side of graph }
Esc = #27;
{ Escape character }
Var LineHeader : String[6];
{ Line Header used for each line sent }
{ to the LaserJet printer. }
LineLength : String[2];
{ Length in bytes of the line to be }
{ sent to the LaserJet. }
Y : Integer;
{ Temporary loop Varible. }
Procedure DrawLine ( Y : Integer );
{ Draws a single line of dots. No of Bytes sent to printer }
{ is Width + 1. Argument of the procedure is the row no, Y }
Var GraphStr : String[255]; { String used for OutPut }
Base : Word; { Starting position of }
{ output byte. }
BitNo, { Bit Number worked on }
ByteNo, { Byte number worked on }
DataByte : Byte; { Data Byte being built }
Begin
FillChar( GraphStr, SizeOf( GraphStr ), #0 );
GraphStr := LineHeader;
For ByteNo := 0 to Width Do
Begin
DataByte := 0;
Base := 8 * ByteNo;
For BitNo := 0 to 7 Do
Begin
If GetPixel( BitNo+Base, Y ) > 0
Then
Begin
DataByte := DataByte + 128 Shr BitNo;
End;
End;
GraphStr := GraphStr + Chr (DataByte)
End;
Write (Lst, GraphStr)
End; {Of Drawline}
Begin {Main procedure HPCopy}
FillChar( LineLength, SizeOf( LineLength ), #0 );
FillChar( LineHeader, SizeOf( LineHeader ), #0 );
GetViewSettings( Vport );
Width := ( Vport.X2 + 1 ) - Vport.X1;
Width := ( ( Width - 7 ) Div 8 );
Height := Vport.Y2 - Vport.Y1;
Write (Lst, Esc + 'E'); { Reset Printer }
Write (Lst, Esc+'*t'+DotsPerInch+'R'); { Set density in }
{ dots per inch }
Write (Lst, Esc+'&a'+CursorPosition+'C');{ Move cursor to }
{ starting col }
Write (Lst, Esc + '*r1A'); { Begin raster graphics }
Str (Width + 1, LineLength);
LineHeader := Esc + '*b' + LineLength + 'W';
For Y := 0 To Height + 1 Do
Begin
DrawLine ( Y );
DrawLine ( Y );
End;
Write (Lst, Esc + '*rB'); { End Raster graphics }
Write (Lst, Esc + 'E'); { Reset printer and }
{ eject page }
End;
Begin
AssignLST( 1 ); { This is the parameter to change }
{ if you want the output to be }
{ directed to a different LST }
{ device. }
End.
[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]