home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PRINTPAS / PRINTER.PAS
Pascal/Delphi Source File  |  1992-05-05  |  8KB  |  218 lines
  1. UNIT MyPrint;
  2.  
  3. (*************************************************************************
  4.  * Deze unit bevat een printerdriver voor paralelle printers.            *
  5.  * Toegestaan zijn printer nummers 1 t/m 3, LPT1, LPT2 en LPT3           *
  6.  *                                                                       *
  7.  * Geschreven door : B.B.Bloksma  (2:283/3.8@fidonet.org)                *
  8.  *                                                                       *
  9.  * CopyRight (c) 1988                                                    *
  10.  * Last Update : 27 November 1988                                        *
  11.  * Posted in PASCAL.028 echo on 23 April 1992                            *
  12.  *                                                                       *
  13.  *************************************************************************)
  14.  
  15. {------------------ I N T E R F A C E -------------------------------------}
  16. INTERFACE
  17.  
  18. USES Crt,Dos;
  19.  
  20. CONST CopyRight : String[40] = 'CopyRight (c) 1988 B.B.Bloksma';
  21.  
  22. VAR lst : TEXT;
  23.  
  24. PROCEDURE AssignLpt(VAR F : TEXT; Nr : BYTE; Scan : BOOLEAN);
  25.  
  26. PROCEDURE CheckPrinter(VAR F : TEXT);
  27.  
  28. FUNCTION PrinterSelected(VAR F : TEXT) : BOOLEAN;
  29.  
  30. {------------------ I M P L E M E N T A T I O N ---------------------------}
  31. IMPLEMENTATION
  32.  
  33. CONST MaxTry = 3;   { Maximaal aantal time out errors in OutLpt }
  34.  
  35. TYPE  LptRec = RECORD
  36.                  Nr : BYTE;
  37.                  KbdScan,
  38.                  Selected : BOOLEAN;
  39.                  UnUsed : ARRAY [1..13] OF BYTE;
  40.                END;
  41.       ScreenLine = ARRAY [1..80] OF WORD;
  42.       Screen     = ARRAY [1..25] OF ScreenLine;
  43.       ScreenBuf  = ARRAY [1..2] OF ScreenLine;
  44.  
  45. VAR ScrnBuf : ScreenBuf;       { Om regel 23 en 25 in op te kunnen slaan }
  46.     ScreenBase : ^Screen;      { Begin van regel 1 in het geheugen       }
  47.     Regs : Registers;          { Nodig voor initialisatie ScreenBase     }
  48.  
  49. {------------------ S T A T U S L P T -------------------------------------}
  50. FUNCTION StatusLpt(Nr : INTEGER) : BYTE;
  51. Inline( $5A/           { POP   DX     Printer nummer        }
  52.         $B4/$02/       { MOV   AH,02  Get status            }
  53.         $CD/$17/       { INT   17     Call Bios             }
  54.         $88/$E0);      { MOV   AL,AH  Laad resultaat in AL  }
  55.  
  56. {------------------ O U T C H A R L P T -----------------------------------}
  57. FUNCTION OutCharLpt(Nr : WORD; ch : CHAR) : BYTE;
  58. Inline( $58/           { POP   AX     ch in AL              }
  59.         $5A/           { POP   DX     Printer nummer        }
  60.         $B4/$00/       { MOV   AH,00  Print karakter        }
  61.         $CD/$17/       { INT   17h    Call Bios             }
  62.         $88/$E0);      { MOV   AL,AH  Laad resultaat in AL  }
  63.  
  64. {------------- P R I N T E R S E L E C T E D ------------------------------}
  65. FUNCTION PrinterSelected(VAR F : TEXT) : BOOLEAN;
  66. BEGIN
  67.   PrinterSelected := LptRec(TextRec(F).UserData).Selected;
  68. END;
  69.  
  70. {------------- C H E C K _ P R I N T E R ----------------------------------}
  71. PROCEDURE CheckPrinter(VAR F : TEXT);
  72. VAR einde : BOOLEAN;
  73.     ch    : CHAR;
  74.     st    : String[2];
  75.     stat  : BYTE;
  76.     try   : INTEGER;
  77. BEGIN
  78.   WITH TextRec(F) DO WITH LptRec(UserData) DO BEGIN
  79.     Selected := mode = FmOutput;
  80.     IF NOT Selected THEN Exit;
  81.     try := 0;
  82.     REPEAT    { wacht tot printer ready of Maxint aantal keer geprobeerd }
  83.       stat := StatusLpt(Nr);
  84.       Inc(try);
  85.     UNTIL (stat AND $80 = $80) OR (try = Maxint);
  86.     REPEAT
  87.       einde:=true;
  88.       IF stat AND $B9 <> $90
  89.       THEN BEGIN
  90.              Move(ScreenBase^[23],ScrnBuf[1],160);
  91.              Move(ScreenBase^[25],ScrnBuf[2],160);
  92.              Str(Succ(Nr):1,st);
  93.              Highvideo; GotoXY(1,23);
  94.              Write('Printer nummer '+st+' niet O.K. !!! '+^G+' Verbeter dit.');
  95.             ClrEol; GotoXY(1,25);
  96.              Write('Return=Verbeterd   Esc=Afbreken':79);
  97.              ClrEol; LowVideo;
  98.              REPEAT
  99.                ch := ReadKey;
  100.              UNTIL ch IN [#13,#27];
  101.              Selected := ch = #13;
  102.              einde := NOT Selected;
  103.              IF Selected THEN stat := StatusLpt(Nr);
  104.              Move(ScrnBuf[1],ScreenBase^[23],160);
  105.              Move(ScrnBuf[2],ScreenBase^[25],160);
  106.            END;
  107.     UNTIL einde;
  108.   END; { with }
  109. END;
  110.  
  111. {------------- P A U Z E --------------------------------------------------}
  112. PROCEDURE Pauze(VAR F : TEXT);
  113. VAR ch : CHAR;
  114. BEGIN
  115.   WHILE KeyPressed DO
  116.     ch := ReadKey;
  117.   Move(ScreenBase^[23],ScrnBuf[1],160);
  118.   Move(ScreenBase^[25],ScrnBuf[2],160);
  119.   HighVideo; GotoXY(1,23);
  120.   Write('Printer pauze ...',^g);
  121.   ClrEol; GotoXY(1,25);
  122.   Write('Spatie = doorgaan     esc = afbreken':79);
  123.   ClrEol; LowVideo;
  124.   REPEAT
  125.     ch := ReadKey;
  126.   UNTIL ch IN [' ',#27];
  127.   LptRec(TextRec(F).UserData).Selected := ch = ' ';
  128.   Move(ScrnBuf[1],ScreenBase^[23],160);
  129.   Move(ScrnBuf[2],ScreenBase^[25],160);
  130. END;
  131.  
  132. {------------- O U T L P T ------------------------------------------------}
  133. {$F+} FUNCTION OutLpt(VAR F : TEXT) : INTEGER; {$F-}
  134. VAR p : WORD;
  135.     try,
  136.     stat : BYTE;
  137. BEGIN
  138.   p := 0;
  139.   WITH TextRec(F),LptRec(UserData) DO BEGIN
  140.     IF Mode = FmClosed THEN BEGIN
  141.       OutLpt := 160; Exit;
  142.     END; { if }
  143.     WHILE (p < BufPos) AND Selected DO BEGIN
  144.       try := 0;
  145.       REPEAT
  146.         REPEAT
  147.           IF KeyPressed AND KbdScan THEN BEGIN
  148.             Pauze(F);
  149.             IF NOT Selected THEN BEGIN
  150.               BufPos := 0; OutLpt := 0;
  151.               Exit;
  152.             END; { if }
  153.           END; { if }
  154.           stat := StatusLpt(Nr);
  155.         UNTIL stat AND $80 = $80;  { ready bit }
  156.         stat := OutCharLpt(Nr,BufPtr^[p]);
  157.         Inc(try);
  158.       UNTIL (stat AND $01 = $00) OR (try = MaxTry);
  159.       IF stat AND $01 = $01 THEN CheckPrinter(F)   { Nog steeds Time-Out bit }
  160.                             ELSE Inc(p);
  161.     END; { while }
  162.     BufPos := 0;
  163.   END; { with }
  164.   OutLpt := 0;
  165. END;
  166.  
  167. {------------- I G N O R E L P T ------------------------------------------}
  168. {$F+} FUNCTION IgnoreLpt(VAR F : TEXT) : INTEGER; {$F-}
  169. BEGIN
  170.   IgnoreLpt := 0
  171. END;
  172.  
  173. {------------- O P E N L P T ----------------------------------------------}
  174. {$F+} FUNCTION OpenLpt(VAR F : TEXT) : INTEGER; {$F-}
  175. BEGIN
  176.   OpenLpt := 0;
  177.   WITH TextRec(F),LptRec(UserData) DO BEGIN
  178.     IF mode <> FmOutput THEN BEGIN
  179.       mode := FmClosed; Exit;
  180.     END;
  181.     IF Nr IN [0..2] THEN BEGIN
  182.       InOutFunc := @OutLpt;
  183.       FlushFunc := @OutLpt;
  184.       CloseFunc := @IgnoreLpt;
  185.       Selected  := true;
  186.     END
  187.     ELSE BEGIN
  188.       Mode := FmClosed;       { Printer kan niet aangestuurd worden }
  189.     END; { if }
  190.   END; { with }
  191. END;
  192.  
  193. {------------- A S S I G N L P T ------------------------------------------}
  194. PROCEDURE AssignLpt(VAR F : TEXT; Nr : BYTE; Scan : BOOLEAN);
  195. (*** Printer besturing voor LPT1, LPT2 en LPT3. ***)
  196. BEGIN
  197.   WITH TextRec(F) DO BEGIN
  198.     Name[0] := #0;      { geen naam }
  199.     Mode := FmClosed;
  200.     BufSize := SizeOf(Buffer);
  201.     BufPtr := @Buffer;
  202.     OpenFunc := @OpenLpt;
  203.     LptRec(UserData).Nr := Pred(Nr);    { Pred(Nr) omdat lpt1 is Nr 0 etc. }
  204.     LptRec(UserData).KbdScan := Scan;
  205.   END; { with }
  206. END;
  207.  
  208. {------------- M A I N ----------------------------------------------------}
  209. BEGIN { main }
  210.   Intr($11,Regs);
  211.   IF Regs.AL AND $30 = $30
  212.     THEN ScreenBase := Ptr($B000,$000)    { Monochrome MDA of Hercules   }
  213.     ELSE ScreenBase := Ptr($B800,$000);   { Colorgraphics CGA of EGA     }
  214.   AssignLpt(lst,1,true);
  215.   Rewrite(lst);
  216. END.
  217.  
  218.