home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / tricks / devdemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-10-10  |  3.3 KB  |  99 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     DEVDEMO.PAS                        *)
  3. (* Dieses Programm definiert einen eigenen Druckertreiber *)
  4. (* und gibt einen Text auf dem Drucker aus.               *)
  5. (*              (c) 1989 H.Mende & TOOLBOX                *)
  6. (* ------------------------------------------------------ *)
  7. {$F+}
  8. PROGRAM DEVICES_DEMO;
  9.  
  10. USES Dos, Crt, Devices;
  11.  
  12. CONST
  13.   TimeOut  : INTEGER = 91;                { ca. 5 Sekunden }
  14.  
  15. var
  16.   Lpt      : TEXT;       { Druckertreiber als Ausgabedatei }
  17.   SysClock : LONGINT ABSOLUTE $0040:$006C;   { System-Zeit }
  18.  
  19.   { Druckerinitialsierungs-Routine }
  20.   FUNCTION CheckLPT(VAR f : TextRec) : INTEGER;
  21.   VAR
  22.     PortAdr : Word;
  23.     Regs    : Registers;
  24.   BEGIN
  25.     PortAdr := MemW[$40:8];
  26.                            { Abbruch, wenn nicht vorhanden }
  27.     IF (PortAdr = 0) THEN BEGIN
  28.       CheckLPT := 151;  Exit;
  29.     END;
  30.                               { Druckerport initialisieren }
  31.     WITH Regs DO BEGIN
  32.       ah := 1;
  33.       dx := 0;
  34.       Intr($17, Regs);          { Druckerstatus ermitteln  }
  35.       IF ((ah AND $20) <> 0) THEN
  36.         CheckLPT := 159         { IOResult für "PAPER OUT" }
  37.       ELSE
  38.         IF ((ah and $01) <> 0) THEN
  39.           CheckLPT := 160       { IOResult für "TIME OUT"  }
  40.         ELSE
  41.           CheckLPT := 0;        { alles O.K. }
  42.     END;
  43.   END;
  44.  
  45.   { Ausgaberoutine für Drucker }
  46.   FUNCTION PrintToLPT(VAR f : TextRec) : INTEGER;
  47.   VAR
  48.     Status    : BYTE;
  49.     p         : INTEGER;
  50.     TimeCount : LONGINT;
  51.     IOPort    : WORD;
  52.   BEGIN
  53.     IOPort := MemW[$40:8];
  54.     WITH f DO BEGIN
  55.       FOR p := 0 TO BufPos-1 DO BEGIN
  56.         TimeCount := SysClock;
  57.                                        { Warten auf "BUSY" }
  58.         REPEAT
  59.           Status := Port[IOPort+1];
  60.         UNTIL (Status >= $80) OR
  61.               (SysClock > TimeCount + TimeOut);
  62.                            { IOResult für "TIMEOUT" Fehler }
  63.         IF (Status < $80) THEN BEGIN
  64.           PrintToLPT := 160;  Exit;
  65.         END;
  66.                             { Papierendekennung überprüfen }
  67.         IF (Status AND $20) <> 0 THEN BEGIN
  68.           PrintToLPT := 159;  Exit;
  69.         END;
  70.                              { Zeichen an Drucker senden   }
  71.         Port[IOPort]   := Byte(BufPtr^[p]);
  72.                              { Zeichen ins Latch schreiben }
  73.         Port[IOPort+2] := $0D;
  74.                              { Zeichen an Drucker senden   }
  75.         Port[IOPort+2] := $0C;                    { Strobe }
  76.       END;
  77.       BufPos := 0;           { Buffer zurücksetzen (=leer) }
  78.     END;
  79.     PrintToLPT := 0;         { Alles O.K. }
  80.   END;
  81.  
  82. BEGIN
  83.                                  { Druckertreiber zuweisen }
  84.   AssignDevice(lpt, @CheckLPT,   @Ignore, @PrintToLPT,
  85.                     @PrintToLPT, @Ignore);
  86.   Rewrite(lpt);
  87.   WriteLn('Taste drücken wenn Drucker bereit...! ');
  88.   REPEAT UNTIL KeyPressed;
  89.  
  90.   WriteLn(lpt, 'DEVDEMO - Demonstration von DEVICES.TPU');
  91.   WriteLn(lpt);
  92.   WriteLn(lpt, 'Dieser Text wird über den mittels ',
  93.                'ASSIGNDEVICE zugewiesenen');
  94.   WriteLn(lpt, 'Druckertreiber ausgegeben.') ;
  95.   WriteLn(lpt, 'Ende der Demonstration ... ');
  96.   Close(lpt);
  97. END.
  98. (* ------------------------------------------------------ *)
  99. (*                 Ende von DEVDEMO.PAS                   *)