[Back to TEXTWNDW SWAG index]  [Back to Main SWAG index]  [Original]

{      This Unit is a replacement for the Write statment      }
{ came with Turbo Pascal Version 4.  It's purpose is to allow }
{ you to write to the screen without scrolling it.  Even      }
{ 25,80.  WARNING this routine will not scroll the screen!    }
{                                                             }
{      This also provides a good example of a Text file       }
{ device driver.                                              }
{                                                             }
{      Type this to a file called WriteNLF.PAS                }

Unit WriteNLF;

Interface

Uses DOS,Crt;

Var
  NLF : Text;                      { Public NLF file variable }

Implementation

{      The following routines MUST be FAR calls because they  }
{ are called by the Read and Write routines.  (They are not   }
{ Public (in the implementation section ) because they should }
{ only be accessed by the Read and Write routines.            }

{$F+}

{      NLFNoFunction performs a NUL operation for a Reset or  }
{ Rewrite on NLF (Just in case)                               }

Function NLFNoFunction( Var F: TextRec ): integer;
Begin
  NLFNoFunction := 0;                    { No error           }
end;

{      NLFOutputToPrinter sends a the output to the Printer   }
{ port number stored in the first byte or the UserData area   }
{ of the Text Record.                                         }

Function NLFOutputToPrinter( Var F: TextRec ): integer;
var
  Regs: Registers;
  P,                    { Buffer Pointer                     }
  Cursor,               { Current Cursor Position            }
  DisplayPage: word;    { Current Display Page               }

begin
  With F do
  Begin
    P := 0;

    Regs.AH := 15;                { Get Current Vidio State  }
    Intr($10,regs);
    DisplayPage := Regs.BH;       { Get Active Display Page  }

    Regs.AH := 3;                 { Get Cursor Position Code }
    Regs.BH := DisplayPage;       { Display Page             }
    Intr($10,Regs);
    Cursor := Regs.DX;            { Get Cursor Position      }

    While (P < BufPos) do
    Begin
      Regs.AH := 9;               { Display Char/Attr Code   }
      Regs.AL := Ord(BufPtr^[P]); { Character to Write       }
      Regs.BH := DisplayPage;     { Display Page             }
      Regs.CX := 1;               { # Characters to Write    }
      Regs.BL := TextAttr;        { Current Text Attribute   }
      Intr($10,Regs);
      Inc(P);
      if P < BufPos then
      Begin
        Regs.AH := 2;             { Set Cursor Position Code }
        Regs.BH := DisplayPage;   { Display Page             }
        Inc(Cursor);              { Move Cursor              }
        Regs.DX := Cursor;        { Set New Cursor Position  }
        Intr($10,Regs);
      end;
    end;
    BufPos := 0;
  End;
  NLFOutputToPrinter := 0;        { Device write Fault }
End;

{$F-}

{      AssignNLF both sets up the NLF text file record as     }
{ would ASSIGN, and initializes it as would a RESET.          }

Procedure AssignNLF;
Begin
  With TextRec(NLF) do
    begin
      Handle      := $FFF0;
      Mode        := fmOutput;
      BufSize     := SizeOf(Buffer);
      BufPtr      := @Buffer;
      BufPos      := 0;
      OpenFunc    := @NLFNoFunction;
      InOutFunc   := @NLFOutputToPrinter;
      FlushFunc   := @NLFOutputToPrinter;
      CloseFunc   := @NLFOutputToPrinter;
  end;
end;

Begin  { Initilization }
  AssignNLF;                { Call assignNLF so it works  }
end.                        { like Turbo's Printer unit   }


************ Type this to a Second file ************

Program Test_WriteNLF;

Uses WriteNLF,crt;

Begin
  clrscr;
  Writeln(     'Testing...');
  GotoXY( 1,25 );
  Write( NLF,'1234567890123456789012345678901234567890',
             '1234567890123456789012345678901234567890');
  readln;
End.

[Back to TEXTWNDW SWAG index]  [Back to Main SWAG index]  [Original]