home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / tricks / hardcopy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-06  |  3.0 KB  |  127 lines
  1. (* ------------------------------------------------- *)
  2. (*                HARDCOPY.PAS                       *)
  3. (*            HARDCOPY-Bibliothek                    *)
  4. (*  (C) 1989 by W. Amslinger, P. Kurzweil & TOOLBOX  *)
  5. (* ------------------------------------------------- *)
  6.  
  7. UNIT HardcopyBib;
  8.  
  9. INTERFACE
  10.  
  11. USES Dos, Crt, Printer, Graph;
  12.  
  13. TYPE
  14.   strg255 = STRING[255];
  15. VAR
  16.   Regs : Registers;
  17.  
  18. PROCEDURE HardCopyOn;
  19.                  { Methode1: Aktiviert [SHIFT PrtScr] }
  20. PROCEDURE HardCopyOff;
  21.                         { Desaktiviert [SHIFT PrtScr] }
  22. PROCEDURE TestHardCopy;
  23.                { Methode2: Hardcopy mit anderer Taste }
  24.  
  25. IMPLEMENTATION
  26.  
  27. CONST
  28.   LPT = 1;
  29.        { Schnittstelle 1 = LPT1:, 2 = LPT2:, 3 = LPT: }
  30. VAR
  31.   OldVec, NewVec : POINTER;
  32.   error, active  : BOOLEAN;
  33.  
  34.   PROCEDURE PrintByte(ch : CHAR);
  35.          { Zeichen auf Parallelschnittstelle ausgeben }
  36.   VAR
  37.     status : BYTE;
  38.          i : WORD;
  39.   BEGIN
  40.     error := FALSE; i := 0;
  41.     REPEAT
  42.       i := Succ(i);                  { Printer status }
  43.       Regs.ah := $02;
  44.       Regs.dx := LPT - 1;
  45.       Intr($17, Regs);
  46.       status := Regs.ah;
  47.       error := ((status AND $29) > 0);     { 00101001 }
  48.       IF i > 20000 THEN BEGIN
  49.         error := TRUE;
  50.         Exit;
  51.       END;                                  { Timeout }
  52.     UNTIL ((status AND $90) XOR $90) = 0;
  53.     Regs.ah := $00;
  54.     Regs.dx := LPT - 1;
  55.     Regs.al := Ord(ch);                 { Byte senden }
  56.     Intr($17, Regs);
  57.   END;
  58.  
  59.   PROCEDURE PrintString(s : strg255);
  60.           { String auf Parallelschnittstelle ausgeben }
  61.   VAR
  62.     i : INTEGER;
  63.   BEGIN
  64.     error := FALSE;
  65.     FOR i := 1 TO Length(s) DO BEGIN
  66.       PrintByte(s[i]);
  67.       IF error THEN Exit;
  68.     END;
  69.   END;
  70.  
  71. {$I HARDCOPY.INC }
  72.  
  73. {$F+}
  74.   PROCEDURE HardCopy; INTERRUPT;
  75.                          { Aufruf über [SHIFT PrtScr] }
  76.   BEGIN
  77.     IF NOT active THEN BEGIN
  78.       active := TRUE;
  79.       error := FALSE;
  80.         IBMHardCopy;
  81.       IF error THEN Write(#7#7#7);
  82.       active := FALSE;
  83.     END;
  84.   END;
  85. {$F-}
  86.  
  87.   PROCEDURE HardCopyOn;
  88.                      { Aktiviert [SHIFT PrtScr]-Taste }
  89.   BEGIN
  90.     NewVec := @HardCopy;
  91.               { Interrupt 5 startet Prozedur Hardcopy }
  92.     GetIntVec($5, OldVec);
  93.     SetIntVec($5, NewVec);
  94.     active := FALSE;
  95.   END;
  96.  
  97. {$F+}
  98.   PROCEDURE HardCopyOff;
  99.                    { Deaktiviert [SHIFT PrtScr]-Taste }
  100.   BEGIN
  101.     SetIntVec($5, OldVec);
  102.   END;
  103. {$F-}
  104.  
  105.   PROCEDURE TestHardCopy;
  106.                       { Löst Hardcopy mit *-Taste aus }
  107.   VAR
  108.     ch : CHAR;
  109.   BEGIN
  110.     REPEAT
  111.       ch := ReadKey;
  112.       IF ch = '*' THEN BEGIN
  113.         IF ((GetMaxX = 719) AND (GetMaxY = 347)) THEN
  114.           IBMhardcopy;
  115.         IF error THEN BEGIN
  116.           Write(#7#7#7);
  117.           Exit;
  118.         END;
  119.       END;
  120.     UNTIL ch IN ['*',#27,#13];
  121.                         { ESC oder RETURN -> Abbrechen }
  122.   END;
  123.  
  124. END.
  125. (* ------------------------------------------------------ *)
  126. (*                Ende von HARDCOPY.PAS                   *)
  127.