home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MFM_119C.ZIP / SCREEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-03  |  4.6 KB  |  159 lines
  1. Unit Screen;
  2. {========================================================================}
  3. Interface
  4.   Uses
  5.     Crt, Dos;
  6.   Type
  7.     ReDirectToType = (Console,ComPort1,ComPort2,StandardIO);
  8.   Var
  9.     ReDirectTo : RedirectToType;
  10.   Function GetInput : Byte;
  11.   Procedure NewTextColor(NewColor : byte);
  12.   Procedure NewTextBackground(NewColor : Byte);
  13.   Procedure AnsiClearScreen;
  14.   Procedure AnsiClearToEOL;
  15.   Procedure AnsiGotoXY(X, Y : Byte);
  16.   Procedure AnsiGotoXYNew(Col,Row : Byte);
  17. {========================================================================}
  18. Implementation
  19. {========================================================================}
  20. Function GetInput : Byte;
  21.   Var
  22.     Msr : Registers;
  23.     NoInputPending : Boolean;
  24.   Begin
  25.     If ReDirectTo In [Console,StandardIO] Then
  26.     Begin
  27.       Msr.ah := $07;
  28.       MsDos(Msr);
  29.       GetInput := Msr.al;
  30.     End
  31.     Else
  32.     Begin
  33.       NoInputPending := True;
  34.       While NoInputPending Do
  35.       Begin
  36.         Msr.ax := $0300;
  37.         If RedirectTo = ComPort1 Then Msr.dx := 0 Else Msr.dx := 1;
  38.         Intr($14,Msr);
  39.         If (Msr.ax And $0080) <> $0080 Then Halt(255);
  40.         If (Msr.ax And $0100) = $0100 Then NoInputPending := False;
  41.       End;
  42.       Msr.ax := $0200;
  43.       If RedirectTo = ComPort1 Then Msr.dx := 0 Else Msr.dx := 1;
  44.       Intr($14,Msr);
  45.       GetInput := Msr.al;
  46.     End;
  47.   End;
  48. {========================================================================}
  49. Procedure NewTextColor(NewColor : byte);
  50.   Var
  51.     NewColorAnsi : String[6];
  52.     Flash : Boolean;
  53.   Begin
  54.     If ReDirectTo = Console Then
  55.     Begin
  56.       TextColor(NewColor);
  57.     End
  58.     Else
  59.     Begin
  60.       If NewColor > 128 Then
  61.       Begin
  62.         NewColor := NewColor - 128;
  63.         Flash := True;
  64.       End
  65.       Else
  66.       Begin
  67.         Flash := False;
  68.       End;
  69.       Case NewColor of
  70.         0 : NewColorAnsi := '30'; {BLACK}
  71.         1 : NewColorAnsi := '34'; {BLUE}
  72.         2 : NewColorAnsi := '32'; {GREEN}
  73.         3 : NewColorAnsi := '36'; {CYAN}
  74.         4 : NewColorAnsi := '31'; {RED}
  75.         5 : NewColorAnsi := '35'; {MAGENTA}
  76.         6 : NewColorAnsi := '33'; {BROWN}
  77.         7 : NewColorAnsi := '37'; {LIGHTGRAY}
  78.         8 : NewColorAnsi := '1;30'; {BLACK}
  79.         9 : NewColorAnsi := '1;34'; {BLUE}
  80.         10: NewColorAnsi := '1;32'; {GREEN}
  81.         11: NewColorAnsi := '1;36'; {CYAN}
  82.         12: NewColorAnsi := '1;31'; {RED}
  83.         13: NewColorAnsi := '1;35'; {MAGENTA}
  84.         14: NewColorAnsi := '1;33'; {BROWN}
  85.         15: NewColorAnsi := '1;37'; {LIGHTGRAY}
  86.       End;
  87.       If Flash Then NewColorAnsi := '5;'+NewColorAnsi Else NewColorAnsi := '0;'+NewColorAnsi;
  88.       Write(^[+'['+NewColorAnsi+'m');
  89.     End;
  90.   End;
  91. {========================================================================}
  92. Procedure NewTextBackground(NewColor : Byte);
  93.   Var
  94.     NewColorAnsi : String[6];
  95.   Begin
  96.     If ReDirectTo = Console Then
  97.     Begin
  98.       TextBackground(NewColor);
  99.     End
  100.     Else
  101.     Begin
  102.       Case NewColor of
  103.         0 : NewColorAnsi := '40'; {BLACK}
  104.         1 : NewColorAnsi := '44'; {BLUE}
  105.         2 : NewColorAnsi := '42'; {GREEN}
  106.         3 : NewColorAnsi := '46'; {CYAN}
  107.         4 : NewColorAnsi := '41'; {RED}
  108.         5 : NewColorAnsi := '45'; {MAGENTA}
  109.         6 : NewColorAnsi := '43'; {BROWN}
  110.         7 : NewColorAnsi := '47'; {LIGHTGRAY}
  111.       End;
  112.       Write(^[+'['+NewColorAnsi+'m');
  113.     End;
  114.   End;
  115. {========================================================================}
  116. Procedure AnsiClearScreen;
  117.   Begin
  118.     If ReDirectTo = Console Then ClrScr Else Write(^[+'[2J');
  119.   End;
  120. {========================================================================}
  121. Procedure AnsiClearToEOL;
  122.   Begin
  123.     If ReDirectTo = Console Then ClrEol Else Write(^[+'[K');
  124.   End;
  125. {========================================================================}
  126. Procedure AnsiGotoXY(X, Y : Byte);
  127.   Var
  128.     Xpos, Ypos : String[2];
  129.   Begin
  130.     If ReDirectTo = Console Then
  131.     Begin
  132.       GotoXY(Y,X);
  133.     End
  134.     Else
  135.     Begin
  136.       Str(X,Xpos); Str(Y,Ypos);
  137.       Write(^[+'['+Xpos+';'+Ypos+'H');
  138.     End;
  139.   End;
  140. {========================================================================}
  141. Procedure AnsiGotoXYNew(Col,Row : Byte);
  142.   Var
  143.     Xpos, Ypos : String[2];
  144.   Begin
  145.     If ReDirectTo = Console Then
  146.     Begin
  147.       GotoXY(Col,Row);
  148.     End
  149.     Else
  150.     Begin
  151.       Str(Col,Xpos); Str(Row,Ypos);
  152.       Write(^[+'['+Ypos+';'+Xpos+'H');
  153.     End;
  154.   End;
  155. {========================================================================}
  156. Begin
  157. End.
  158. {========================================================================}
  159.