[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]
{ This Unit is a replacement for the Printer unit that }
{ came with Turbo Pascal Version 4.0 and 5.0. Its purpose is }
{ fourfold. }
{ }
{ First: It will allow a user to change the printer port that }
{ the LST file is writing to on the fly. This takes the }
{ place of LstOutPtr and the routine on page 369 of the Turbo }
{ Pascal Version 3.0 manual. }
{ }
{ Second: This unit will free the programmer from the need to }
{ check to see if the printer is ready to accept characters. }
{ If the printer is not ready, the unit will place a line on }
{ the screen prompting the user to fix the printer and press }
{ a key. This process will continue until the printer is }
{ made ready or the user Aborts or Ignores the printing }
{ operation. NOTE: BIOS does not return correct error codes }
{ for Non-Existent printers or printer ports because the }
{ printer is not there to return any error codes at all. }
{ }
{ Third: This unit will also circumvent DOS's stripping of a }
{ Ctrl-Z ($1A, the End Of File character) when writing to the }
{ printer as an ASCII device. Ctrl-Z was usually sent as part }
{ of a graphics string to a printer. In version 3.0 of Turbo }
{ Pascal, an ASCII device was opened in binary mode. In }
{ version 4.0, an ASCII device is opened in ASCII mode and }
{ DOS thus strips a Ctrl-Z. }
{ }
{ Fourth: This also provides a good example of a Text file }
{ device driver. }
{ Warning: This Driver has not been tested on a non-buffered }
{ printer, as the smallest buffer I could find was 80 chars. }
{ Type this to a file called PRINTERR.PAS }
{$R-}
Unit PrintErr;
Interface
Uses DOS,CRT;
Var
LST : Text; { Public LST file variable }
Procedure SetPrinter( Port:Byte );
{ SetPrinter sets the printer number to Port where Port }
{ is 'n' in 'LPTn'. ie. To write to LPT1: SetPrinter(1), }
{ for LPT2: SetPrinter(2). SetPrinter changes the Port that }
{ subsequent Write operations will write to. This lets you }
{ change the printer that you are printing to on the fly. }
Implementation
Function PrinterCheck( PortNum, Error:Byte; Var Pos:Word):Boolean;
Var
Response : Char;
Regs : Registers;
OldTextAttr : Byte;
NewPos : Word;
Begin
Response := 'R'; { Assume Retry }
NewPos := Pos; { Assume no Error }
While ((Error and $29) <> 0) and (Response = 'R') do
Begin
NewPos := Pos - 1; { Decrement to reprint char }
OldTextAttr := TextAttr; { Save Old Attribute }
TextAttr := TextAttr or $80; { Turn on Blink Bit }
Write( #13'Printer Not Ready! ' ); { Write the user }
Write( 'A) Abort, R) Retry, I) Ignore '#13 ); { a message }
TextAttr := OldTextAttr; { Restore Old Attribute }
Response := Upcase( Readkey );{ Read Char and upcase it }
ClrEol; { Clear Line }
If Response = 'A' then { If Abort then exit }
halt( 160 ); { Note: Uses Exit Proc. }
If Response = 'R' then
Begin
Regs.AH := 2; { Code for Check Status }
Regs.DX := PortNum; { Printer port number -1 }
Intr($17,Regs); { Call printer service }
Error := Regs.AH; { save Printer Error Code }
{ 00000001 = Time Out }
{ 00000010 = Unused }
{ 00000100 = Unused }
{ 00001000 = I/O Error }
{ 00010000 = Selected }
{ 00100000 = Out of Paper }
{ 01000000 = Acknowledge }
{ 10000000 = Not busy }
End;
End;
PrinterCheck := Response = 'R';
Pos := NewPos;
End;
Function PrinterReady(PortNum:Byte):Boolean;
Var
Ready : Boolean;
Dummy : word;
Regs : Registers;
Begin
Regs.AH := 2; { Code for Check Status }
Regs.DX := PortNum; { Printer port number -1 }
Intr($17,Regs); { Call printer service }
PrinterReady := PrinterCheck( PortNum, Regs.AH, Dummy )
End;
{ The following routines MUST be FAR calls because they }
{ are called by the Read and Write routines. (They are not }
{ Public (in the implementation section) because they should }
{ only be accessed by the Read and Write routines.) }
{$F+}
{ LSTNoFunction performs a NUL operation for a Reset or }
{ Rewrite on LST (just in case). }
Function LSTNoFunction( Var F: TextRec ): integer;
Begin
LSTNoFunction := 0; { No error }
end;
{ LSTOutputToPrinter sends the output to the Printer }
{ port number stored in the first byte or the UserData area }
{ of the Text Record. }
Function LSTOutputToPrinter( Var F: TextRec ): integer;
var
Regs: Registers;
P : Word;
begin
With F do
Begin
P := 0;
If PrinterReady( F.UserData[1] ) Then
While (P < BufPos) do
Begin
Regs.AL := Ord(BufPtr^[P]);
Regs.AH := 0;
Regs.DX := UserData[1];
Intr($17,Regs);
Inc(P);
If Not PrinterCheck( F.UserData[1], Regs.AH, P ) then
P := BufPos;
End;
BufPos := 0;
End;
LSTOutputToPrinter := 0 { No error }
End;
{$F-}
{ AssignLST both sets up the LST text file record as }
{ would ASSIGN, and initializes it as would a RESET. It also }
{ stores the Port number in the first Byte of the UserData }
{ area. }
Procedure AssignLST( Port:Byte );
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; { We subtract one because }
end; { DOS Counts from zero. }
end;
Procedure SetPrinter( Port:Byte ); { Documented above }
Begin
With TextRec(LST) do
UserData[1] := Port - 1;{ We subtract one because DOS }
End; { Counts from zero. }
Begin { Initialization }
AssignLST( 1 ); { Call assignLST so it works }
end. { like Turbo's Printer unit }
---------------------------------------------------------------
************ Type this to a Second file ************
Program Test_PrintErr_Unit;
Uses PrintErr;
Begin
Writeln( 'Testing...Printer #1');
Writeln( LST,'Testing...Printer #1');
SetPrinter( 1 );
Writeln( 'Testing...Same Printer');
Writeln( LST,'Testing...Same Printer');
SetPrinter( 2 );
Writeln( 'Testing...Printer #2');
Writeln( LST,'Testing...Printer #2');
End.
[Back to PRINTING SWAG index] [Back to Main SWAG index] [Original]