home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / LPT_PAS.ZIP / PRINT.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-11-07  |  2.3 KB  |  133 lines
  1. Unit Print;
  2. { Author   : Michael Warot
  3.   Date     : May,1988
  4.   Last     : November, 1988
  5.   Purpose  : Provide an easy to use print unit that WORKS!
  6.   Notes    : Turbo 5.0 (Should work with 4)
  7.              Uses PopUpConfirm - Replace with your own boolean function
  8.              Uses Unit Timer2  - Included for completeness
  9. }
  10. Interface
  11.  
  12. Uses
  13.   Crt,Dos,Misc;
  14.  
  15. Procedure AssignLpt(var F    : Text);
  16.  
  17. Implementation
  18. {***************** This is hidden from the users code *******************}
  19. {$F+} { If not already on }
  20.  
  21. Uses
  22.   Timer2,
  23.   EditPage; { PopUpConfirm }
  24. Var
  25.   AbortPrint : Boolean;
  26.  
  27. Procedure LptInit(Var F : TextRec);
  28. Begin
  29.   With F do
  30.   begin
  31.     BufPos := 0;
  32.   end;
  33. End;
  34.  
  35. Function LptInChar: Char;
  36. Begin
  37.   LptInChar := #0;
  38. End;
  39.  
  40. Procedure LptOutChar(Ch : Char);
  41. Var
  42.   R : Registers;
  43.   T : Longint;
  44. Begin
  45.   If Not AbortPrint then
  46.   begin
  47.     StartTime(T);
  48.     Repeat
  49.       R.AH := 0;
  50.       R.AL := Byte(Ch);
  51.       R.DX := 0;
  52.       Intr($17,R);
  53.       If DT(T) > 90 then
  54.         If PopUpConfirm('TIMEOUT, ABORT PRINT') then
  55.           AbortPrint := True;
  56.     Until (R.AH = $10) OR (AbortPrint);
  57.   end;
  58. End; { LptOutChar }
  59.  
  60. Function LptInReady: Boolean;
  61. Begin
  62.   LptInReady := True;
  63. End;
  64.  
  65. Function LptInput(var F: TextRec): Integer;
  66. begin
  67.   LptInput:=0;
  68. end;
  69.  
  70. Function LptOutPut(var F: TextRec): Integer;
  71. var
  72.   P: Word;
  73. begin
  74.   with F do
  75.   begin
  76.     P:=0;
  77.     while P<BufPos do
  78.     begin
  79.       LptOutChar(BufPtr^[P]); Inc(P);
  80.     end;
  81.     BufPos:=0;
  82.   end;
  83.   LptOutput := 0;
  84. end;
  85.  
  86. Function LptIgnore(var F: TextRec): Integer;
  87. begin
  88.   LptIgnore:=0;
  89. end;
  90.  
  91. Function LptClose(Var F: TextRec): Integer;
  92. Begin
  93.   LptClose := 0;
  94. End;
  95.  
  96. Function LptOpen(var F: TextRec): Integer;
  97. begin
  98.   with F do
  99.   begin
  100.     LptInit(F);
  101.     if Mode=fmInput then
  102.     begin
  103.       InOutFunc:=@LptInput;
  104.       FlushFunc:=@LptIgnore;
  105.     end else
  106.     begin
  107.       Mode:=fmOutput;
  108.       InOutFunc:=@LptOutput;
  109.       FlushFunc:=@LptOutput;
  110.     end;
  111.     CloseFunc:=@LptClose;
  112.   end;
  113.   AbortPrint := False;
  114.   LptOpen:=0;
  115. end;
  116.  
  117. procedure AssignLpt;
  118. begin
  119.   with TextRec(F) do
  120.   begin
  121.     Handle:=$FFFF;
  122.     Mode:=fmClosed;
  123.     BufSize:=SizeOf(Buffer);
  124.     BufPos := $00;
  125.     BufPtr:=@Buffer;
  126.     OpenFunc:=@LptOpen;
  127.     Name[0]:=#0;
  128.   end;
  129. end;
  130.  
  131. begin
  132. end.
  133.