home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 2 BBS / 02-BBS.zip / MFMP110A.ZIP / SCREEN.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-10  |  4KB  |  119 lines
  1. (*#module(turbo_comp=>off)*)
  2. Implementation Unit Screen;
  3.  
  4. IMPORT
  5.   PASDOS(rdkey),
  6.   TURBOCRT(textcolor,textbackground,clrscr,clreol,gotoxy),
  7.   TURBODOS(registers,msdos,intr),
  8.   TURBOSYS(ABORT,_STR_INT)
  9.   ;
  10.  
  11. {========================================================================}
  12. Function GetInput { : byte; };
  13.   Var
  14.     NoInputPending : Boolean;
  15.     tbyte : byte;
  16.     tchar : char;
  17.   Begin
  18.       tchar := rdkey;
  19.       tbyte := tchar::byte;
  20.       GetInput := tbyte;
  21.   End;
  22.  
  23. {========================================================================}
  24. Procedure NewTextColor { (NewColor : Byte); };
  25.   Var
  26.     NewColorAnsi : String[6];
  27.     Flash : Boolean;
  28.   Begin
  29.     If ReDirectTo = Console Then
  30.     Begin
  31.       TextColor(NewColor);
  32.     End
  33.     Else
  34.     Begin
  35.       If NewColor > 128 Then
  36.       Begin
  37.         NewColor := NewColor - 128;
  38.         Flash := True;
  39.       End
  40.       Else
  41.       Begin
  42.         Flash := False;
  43.       End;
  44.       Case NewColor of
  45.         0 : NewColorAnsi := '30'; {BLACK}
  46.         1 : NewColorAnsi := '34'; {BLUE}
  47.         2 : NewColorAnsi := '32'; {GREEN}
  48.         3 : NewColorAnsi := '36'; {CYAN}
  49.         4 : NewColorAnsi := '31'; {RED}
  50.         5 : NewColorAnsi := '35'; {MAGENTA}
  51.         6 : NewColorAnsi := '33'; {BROWN}
  52.         7 : NewColorAnsi := '37'; {LIGHTGRAY}
  53.         8 : NewColorAnsi := '1;30'; {BLACK}
  54.         9 : NewColorAnsi := '1;34'; {BLUE}
  55.         10: NewColorAnsi := '1;32'; {GREEN}
  56.         11: NewColorAnsi := '1;36'; {CYAN}
  57.         12: NewColorAnsi := '1;31'; {RED}
  58.         13: NewColorAnsi := '1;35'; {MAGENTA}
  59.         14: NewColorAnsi := '1;33'; {BROWN}
  60.         15: NewColorAnsi := '1;37';
  61.         Else                        {LIGHTGRAY}
  62.       End;
  63.       If Flash Then NewColorAnsi := '5;'+NewColorAnsi Else NewColorAnsi := '0;'+NewColorAnsi;
  64.       Write(chr(27)+'['+NewColorAnsi+'m');
  65.     End;
  66.   End;
  67. {========================================================================}
  68. Procedure NewTextBackground { (NewColor : Byte); };
  69.   Var
  70.     NewColorAnsi : String[6];
  71.   Begin
  72.     If ReDirectTo = Console Then
  73.     Begin
  74.       TextBackground(NewColor);
  75.     End
  76.     Else
  77.     Begin
  78.       Case NewColor of
  79.         0 : NewColorAnsi := '40'; {BLACK}
  80.         1 : NewColorAnsi := '44'; {BLUE}
  81.         2 : NewColorAnsi := '42'; {GREEN}
  82.         3 : NewColorAnsi := '46'; {CYAN}
  83.         4 : NewColorAnsi := '41'; {RED}
  84.         5 : NewColorAnsi := '45'; {MAGENTA}
  85.         6 : NewColorAnsi := '43'; {BROWN}
  86.         7 : NewColorAnsi := '47';
  87.         Else                      {LIGHTGRAY}
  88.       End;
  89.       Write(chr(27)+'['+NewColorAnsi+'m');
  90.     End;
  91.   End;
  92. {========================================================================}
  93. Procedure AnsiClearScreen;
  94.   Begin
  95.     If ReDirectTo = Console Then ClrScr Else Write(chr(27)+'[2J');
  96.   End;
  97. {========================================================================}
  98. Procedure AnsiClearToEOL;
  99.   Begin
  100.     If ReDirectTo = Console Then ClrEol Else Write(chr(27)+'[K');
  101.   End;
  102. {========================================================================}
  103. Procedure AnsiGotoXY { (X, Y : Byte); };
  104.   Var
  105.     Xpos, Ypos : String[2];
  106.   Begin
  107.     If ReDirectTo = Console Then
  108.     Begin
  109.       GotoXY(Y,X);
  110.     End
  111.     Else
  112.     Begin
  113.       _STR_INT(X, 0,Xpos); _STR_INT(Y, 0,Ypos);
  114.       Write(chr(27)+'['+Xpos+';'+Ypos+'H');
  115.     End;
  116.   End;
  117. {========================================================================}
  118. End.
  119.