home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
PRINTPAS
/
PRINTER.PAS
Wrap
Pascal/Delphi Source File
|
1992-05-05
|
8KB
|
218 lines
UNIT MyPrint;
(*************************************************************************
* Deze unit bevat een printerdriver voor paralelle printers. *
* Toegestaan zijn printer nummers 1 t/m 3, LPT1, LPT2 en LPT3 *
* *
* Geschreven door : B.B.Bloksma (2:283/3.8@fidonet.org) *
* *
* CopyRight (c) 1988 *
* Last Update : 27 November 1988 *
* Posted in PASCAL.028 echo on 23 April 1992 *
* *
*************************************************************************)
{------------------ I N T E R F A C E -------------------------------------}
INTERFACE
USES Crt,Dos;
CONST CopyRight : String[40] = 'CopyRight (c) 1988 B.B.Bloksma';
VAR lst : TEXT;
PROCEDURE AssignLpt(VAR F : TEXT; Nr : BYTE; Scan : BOOLEAN);
PROCEDURE CheckPrinter(VAR F : TEXT);
FUNCTION PrinterSelected(VAR F : TEXT) : BOOLEAN;
{------------------ I M P L E M E N T A T I O N ---------------------------}
IMPLEMENTATION
CONST MaxTry = 3; { Maximaal aantal time out errors in OutLpt }
TYPE LptRec = RECORD
Nr : BYTE;
KbdScan,
Selected : BOOLEAN;
UnUsed : ARRAY [1..13] OF BYTE;
END;
ScreenLine = ARRAY [1..80] OF WORD;
Screen = ARRAY [1..25] OF ScreenLine;
ScreenBuf = ARRAY [1..2] OF ScreenLine;
VAR ScrnBuf : ScreenBuf; { Om regel 23 en 25 in op te kunnen slaan }
ScreenBase : ^Screen; { Begin van regel 1 in het geheugen }
Regs : Registers; { Nodig voor initialisatie ScreenBase }
{------------------ S T A T U S L P T -------------------------------------}
FUNCTION StatusLpt(Nr : INTEGER) : BYTE;
Inline( $5A/ { POP DX Printer nummer }
$B4/$02/ { MOV AH,02 Get status }
$CD/$17/ { INT 17 Call Bios }
$88/$E0); { MOV AL,AH Laad resultaat in AL }
{------------------ O U T C H A R L P T -----------------------------------}
FUNCTION OutCharLpt(Nr : WORD; ch : CHAR) : BYTE;
Inline( $58/ { POP AX ch in AL }
$5A/ { POP DX Printer nummer }
$B4/$00/ { MOV AH,00 Print karakter }
$CD/$17/ { INT 17h Call Bios }
$88/$E0); { MOV AL,AH Laad resultaat in AL }
{------------- P R I N T E R S E L E C T E D ------------------------------}
FUNCTION PrinterSelected(VAR F : TEXT) : BOOLEAN;
BEGIN
PrinterSelected := LptRec(TextRec(F).UserData).Selected;
END;
{------------- C H E C K _ P R I N T E R ----------------------------------}
PROCEDURE CheckPrinter(VAR F : TEXT);
VAR einde : BOOLEAN;
ch : CHAR;
st : String[2];
stat : BYTE;
try : INTEGER;
BEGIN
WITH TextRec(F) DO WITH LptRec(UserData) DO BEGIN
Selected := mode = FmOutput;
IF NOT Selected THEN Exit;
try := 0;
REPEAT { wacht tot printer ready of Maxint aantal keer geprobeerd }
stat := StatusLpt(Nr);
Inc(try);
UNTIL (stat AND $80 = $80) OR (try = Maxint);
REPEAT
einde:=true;
IF stat AND $B9 <> $90
THEN BEGIN
Move(ScreenBase^[23],ScrnBuf[1],160);
Move(ScreenBase^[25],ScrnBuf[2],160);
Str(Succ(Nr):1,st);
Highvideo; GotoXY(1,23);
Write('Printer nummer '+st+' niet O.K. !!! '+^G+' Verbeter dit.');
ClrEol; GotoXY(1,25);
Write('Return=Verbeterd Esc=Afbreken':79);
ClrEol; LowVideo;
REPEAT
ch := ReadKey;
UNTIL ch IN [#13,#27];
Selected := ch = #13;
einde := NOT Selected;
IF Selected THEN stat := StatusLpt(Nr);
Move(ScrnBuf[1],ScreenBase^[23],160);
Move(ScrnBuf[2],ScreenBase^[25],160);
END;
UNTIL einde;
END; { with }
END;
{------------- P A U Z E --------------------------------------------------}
PROCEDURE Pauze(VAR F : TEXT);
VAR ch : CHAR;
BEGIN
WHILE KeyPressed DO
ch := ReadKey;
Move(ScreenBase^[23],ScrnBuf[1],160);
Move(ScreenBase^[25],ScrnBuf[2],160);
HighVideo; GotoXY(1,23);
Write('Printer pauze ...',^g);
ClrEol; GotoXY(1,25);
Write('Spatie = doorgaan esc = afbreken':79);
ClrEol; LowVideo;
REPEAT
ch := ReadKey;
UNTIL ch IN [' ',#27];
LptRec(TextRec(F).UserData).Selected := ch = ' ';
Move(ScrnBuf[1],ScreenBase^[23],160);
Move(ScrnBuf[2],ScreenBase^[25],160);
END;
{------------- O U T L P T ------------------------------------------------}
{$F+} FUNCTION OutLpt(VAR F : TEXT) : INTEGER; {$F-}
VAR p : WORD;
try,
stat : BYTE;
BEGIN
p := 0;
WITH TextRec(F),LptRec(UserData) DO BEGIN
IF Mode = FmClosed THEN BEGIN
OutLpt := 160; Exit;
END; { if }
WHILE (p < BufPos) AND Selected DO BEGIN
try := 0;
REPEAT
REPEAT
IF KeyPressed AND KbdScan THEN BEGIN
Pauze(F);
IF NOT Selected THEN BEGIN
BufPos := 0; OutLpt := 0;
Exit;
END; { if }
END; { if }
stat := StatusLpt(Nr);
UNTIL stat AND $80 = $80; { ready bit }
stat := OutCharLpt(Nr,BufPtr^[p]);
Inc(try);
UNTIL (stat AND $01 = $00) OR (try = MaxTry);
IF stat AND $01 = $01 THEN CheckPrinter(F) { Nog steeds Time-Out bit }
ELSE Inc(p);
END; { while }
BufPos := 0;
END; { with }
OutLpt := 0;
END;
{------------- I G N O R E L P T ------------------------------------------}
{$F+} FUNCTION IgnoreLpt(VAR F : TEXT) : INTEGER; {$F-}
BEGIN
IgnoreLpt := 0
END;
{------------- O P E N L P T ----------------------------------------------}
{$F+} FUNCTION OpenLpt(VAR F : TEXT) : INTEGER; {$F-}
BEGIN
OpenLpt := 0;
WITH TextRec(F),LptRec(UserData) DO BEGIN
IF mode <> FmOutput THEN BEGIN
mode := FmClosed; Exit;
END;
IF Nr IN [0..2] THEN BEGIN
InOutFunc := @OutLpt;
FlushFunc := @OutLpt;
CloseFunc := @IgnoreLpt;
Selected := true;
END
ELSE BEGIN
Mode := FmClosed; { Printer kan niet aangestuurd worden }
END; { if }
END; { with }
END;
{------------- A S S I G N L P T ------------------------------------------}
PROCEDURE AssignLpt(VAR F : TEXT; Nr : BYTE; Scan : BOOLEAN);
(*** Printer besturing voor LPT1, LPT2 en LPT3. ***)
BEGIN
WITH TextRec(F) DO BEGIN
Name[0] := #0; { geen naam }
Mode := FmClosed;
BufSize := SizeOf(Buffer);
BufPtr := @Buffer;
OpenFunc := @OpenLpt;
LptRec(UserData).Nr := Pred(Nr); { Pred(Nr) omdat lpt1 is Nr 0 etc. }
LptRec(UserData).KbdScan := Scan;
END; { with }
END;
{------------- M A I N ----------------------------------------------------}
BEGIN { main }
Intr($11,Regs);
IF Regs.AL AND $30 = $30
THEN ScreenBase := Ptr($B000,$000) { Monochrome MDA of Hercules }
ELSE ScreenBase := Ptr($B800,$000); { Colorgraphics CGA of EGA }
AssignLpt(lst,1,true);
Rewrite(lst);
END.