home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 04 / diverse / backunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-10-19  |  2.5 KB  |  108 lines
  1. UNIT BackUnit;
  2. Interface
  3.   Uses Crt, Dos;
  4. PROCEDURE Backward_On;
  5. PROCEDURE Backward_Off;
  6. (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  7. Implementation
  8. VAR
  9.   SaveExit : Pointer;
  10.   HoldOutput, HoldFlush : pointer;
  11.  
  12.   PROCEDURE ConOut(C : Char);
  13.   CONST
  14.     CR = #$0D; {carriage return}
  15.     LF = #$0A; {line feed}
  16.     BEL = #7;  {bell character}
  17.     BKS = #8;  {backspace}
  18.   VAR
  19.     regs : Registers;
  20.     X,Y  : Byte;
  21.   BEGIN
  22.     WITH regs DO
  23.       BEGIN
  24.         CASE C OF
  25.           CR : GotoXY(80,WhereY);
  26.           LF : BEGIN
  27.                  Y := succ(WhereY);
  28.                  IF Y > 25 THEN
  29.                    BEGIN
  30.                      GotoXY(1,1);
  31.                      DelLine;
  32.                      Y := 25;
  33.                    END;
  34.                  GotoXY(WhereX,Y);
  35.                  END;
  36.           BEL: BEGIN Sound(750); Delay(300); NoSound; END;
  37.           BKS: BEGIN
  38.                  X := WhereX;
  39.                  IF X < 80 THEN
  40.                    GotoXY(succ(X),WhereY);
  41.                END;
  42.         ELSE                  {just write the character }
  43.           AH := 9;
  44.           AL := Ord(C);
  45.           BH := 0;
  46.           BL := TextAttr;
  47.           CX := 1;
  48.           Intr($10, regs);
  49.  
  50.           {now reposition the cursor}
  51.           X := WhereX; Y := WhereY;
  52.           IF X > 1 THEN Dec(X)
  53.           ELSE
  54.             BEGIN
  55.               X := 80;
  56.               Inc(Y);
  57.             END;
  58.           IF Y > 25 THEN
  59.             BEGIN
  60.               GotoXY(1,1);
  61.               DelLine;
  62.               Y := 25;
  63.               X := 80;
  64.             END;
  65.           GotoXY(X,Y);
  66.         END; {CASE}
  67.       END;
  68.   END;                        {PROCEDURE ConOut(C : Char);}
  69.  
  70.   {$F+} FUNCTION UsrOutput(VAR F : TextRec) : Integer;{$F-}
  71.   VAR N : Byte;
  72.   BEGIN
  73.     WITH F DO
  74.       BEGIN
  75.         FOR N := 0 TO Pred(BufPos) DO ConOut(BufPtr^[N]);
  76.         BufPos := 0;
  77.       END;
  78.     UsrOutput := 0;
  79.   END;
  80.  
  81.   PROCEDURE Backward_On;
  82.   BEGIN
  83.     TextRec(Output).InOutFunc := @UsrOutput;
  84.     TextRec(Output).FlushFunc := @UsrOutput;
  85.   END;
  86.  
  87.   PROCEDURE Backward_Off;
  88.   BEGIN
  89.     TextRec(Output).InOutFunc := HoldOutput;
  90.     TextRec(Output).FlushFunc := HoldFlush;
  91.   END;
  92.  
  93.  
  94.   {$F+}PROCEDURE MyExitProc;{$F-}
  95.   BEGIN
  96.     Backward_Off;
  97.     ExitProc := SaveExit;
  98.   END;
  99. (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  100. {Initialization section}
  101. BEGIN
  102.   SaveExit := ExitProc;
  103.   ExitProc := @MyExitProc;
  104.   HoldOutput := TextRec(Output).InOutFunc;
  105.   HoldFlush := TextRec(Output).FlushFunc;
  106. END.
  107. 
  108.