home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / modem / suncom.zip / WINDOWS.PAS < prev   
Pascal/Delphi Source File  |  1990-01-19  |  6KB  |  218 lines
  1. { Windows -  A Turbo Pascal 5.0 Unit. - Written By Boyd Fletcher
  2.  
  3.   USE:  WindowIn  - To make a temporary window.
  4.         WindowOut - To remove the temporary window.
  5.   NOTE: Windows cannot be overlapped. That is you cannot use WindowIn twice
  6.         in a row without WindowOut being placed after the first WindowIn.
  7.  
  8.   USE:  MakeWindow - Places a permanent window on the screen. It can only be
  9.         removed by a WINDOW(1,1,80,25) and a CLRSCR command.
  10. }
  11.  
  12.  
  13. UNIT Windows;
  14.  
  15. INTERFACE
  16.  
  17. USES CRT,DOS;
  18.  
  19. VAR WindowPtr            : Pointer;
  20.     CursorCol, CursorRow : Integer;
  21.  
  22. PROCEDURE FrameTypes(Mode : Integer; VAR TL,TR,BL,BR,H,V : Char);
  23. PROCEDURE Frame(TopCol,TopRow,BotCol,BotRow,Mode : Integer);
  24. PROCEDURE WindowIn(ForeGround,BackGround,Mode,TopCol,TopRow,
  25.                    BotCol,BotRow : Integer;
  26.                    VAR CursorCol, CursorRow : Integer;
  27.                    VAR WindowPtr : Pointer);
  28. PROCEDURE WindowOut(CursorCol, CursorRow : Integer;
  29.                     VAR WindowPtr : Pointer);
  30. PROCEDURE MakeWindow(ForeGround,BackGround,Mode,NoClr,
  31.                      TopCol,TopRow,BotCol,BotRow : Integer);
  32. PROCEDURE SetScreen(ForeGround,BackGround,NoClr,TopCol,
  33.                     TopRow,BotCol,BotRow : Integer);
  34. PROCEDURE SizeCursor(Top, Bot : Byte);
  35. PROCEDURE OnCursor;
  36. PROCEDURE OffCursor;
  37. FUNCTION  Clr(Color,
  38.               Mode    : Integer) : Char;
  39.  
  40.  
  41. (*****************************************************************************)
  42.  
  43. IMPLEMENTATION
  44.  
  45.  
  46. PROCEDURE SizeCursor;
  47. VAR Reg : Registers;
  48. BEGIN {SizeCursor}
  49.        with Reg do
  50.        begin
  51.          ax := 1 shl 8;
  52.          cx := Top shl 8 + Bot;
  53.          INTR($10,Reg);
  54.        end
  55. END;  {SizeCursor}
  56.  
  57. (*****************************************************************************)
  58.  
  59. PROCEDURE OnCursor;
  60. BEGIN {OnCursor}
  61.      SizeCursor(6,7);
  62. END;  {OnCursor}
  63.  
  64. (*****************************************************************************)
  65.  
  66. PROCEDURE OffCursor;
  67. BEGIN {OffCursor}
  68.      Sizecursor(14,0);
  69. END;  {OffCursor}
  70.  
  71. (*****************************************************************************)
  72.  
  73. PROCEDURE FrameTypes;
  74. BEGIN {Frame Types}
  75.      case Mode of
  76.               1 : begin
  77.                      TL := #201; TR := #187;
  78.                      BL := #200; BR := #188;
  79.                      H  := #205; V  := #186;
  80.                   end;
  81.               2 : begin
  82.                      TL := #214; TR := #183;
  83.                      BL := #211; BR := #189;
  84.                      H  := #196; V  := #186;
  85.                   end;
  86.               3 : begin
  87.                      TL := #213; TR := #184;
  88.                      BL := #212; BR := #190;
  89.                      H  := #205; V  := #179;
  90.                   end;
  91.               4 : begin
  92.                      TL := #218; TR := #191;
  93.                      BL := #192; BR := #217;
  94.                      H  := #196; V  := #179;
  95.                   end;
  96.      end;
  97. END;  {Frame Types}
  98.  
  99. (*****************************************************************************)
  100.  
  101. PROCEDURE Frame;
  102. VAR x               : Integer;
  103.     TL,TR,BL,BR,H,V : Char;
  104.  
  105. BEGIN {Frame}
  106.       FrameTypes(Mode,TL,TR,BL,BR,H,V);
  107.       gotoXY(TopCol,BotRow);
  108.       write(BL);
  109.       gotoXY(BotCol,BotRow);
  110.       write(BR);
  111.       gotoXY(TopCol,TopRow);
  112.       write(TL);
  113.       gotoXY(BotCol,TopRow);
  114.       write(TR);
  115.       for x := TopRow+1 to BotRow-1 do
  116.           begin
  117.                gotoXY(TopCol,x);
  118.                write(v);
  119.                gotoXY(BotCol,x);
  120.                write(v);
  121.           end;
  122.           for x := TopCol+1 to BotCol-1 do
  123.           begin
  124.                gotoXY(x,TopRow);
  125.                write(h);
  126.                gotoXY(x,BotRow);
  127.                write(h);
  128.           end;
  129. END; {Frame}
  130.  
  131. (*****************************************************************************)
  132.  
  133. PROCEDURE WindowIn;
  134.  
  135. TYPE ScrnArray = Array[0..3999] of Byte;
  136.      ScreenPtr = ^ScrnArray;
  137.  
  138. VAR  ScreenAddress       : Word;
  139.      ScrnPtr             : ScreenPtr;
  140.  
  141. BEGIN {Window In}
  142.       if (mem[0000:1040] and 48) <> 48
  143.          then ScreenAddress := $B800
  144.          else ScreenAddress := $B000;
  145.       mark(WindowPtr);
  146.       new(ScrnPtr);
  147.       CursorCol := whereX;
  148.       CursorRow := whereY;
  149.       move(mem[ScreenAddress:0000],ScrnPtr^,4000);
  150.       textcolor(ForeGround);
  151.       textbackground(BackGround);
  152.       if Mode <> 0 then FRAME(TopCol,TopRow,BotCol,BotRow,Mode);
  153.       textcolor(ForeGround);
  154.       textbackground(BackGround);
  155.       window(TopCol+1,TopRow+1,BotCol-1,BotRow-1);
  156.       clrscr;
  157.       dispose(ScrnPtr);
  158. END;  {Window In}
  159.  
  160. (*****************************************************************************)
  161.  
  162. PROCEDURE WindowOut;
  163.  
  164. VAR ScreenAddress        : Word;
  165.  
  166. BEGIN {Window Out}
  167.       if (mem[0000:1040] and 48) <> 48
  168.          then ScreenAddress := $B800
  169.          else ScreenAddress := $B000;
  170.       move(WindowPtr^,mem[ScreenAddress:0000],4000);
  171.       if WindowPtr <> Nil then dispose(WindowPtr);
  172.       window(1,1,80,25);
  173.       gotoXY(CursorCol,CursorRow);
  174. END;  {Window Out}
  175.  
  176. (*****************************************************************************)
  177.  
  178. PROCEDURE MakeWindow;
  179.  
  180. BEGIN {Make Window}
  181.       window(1,1,80,25);
  182.       textcolor(ForeGround);
  183.       textbackground(BackGround);
  184.       if Mode <> 0 then FRAME(TopCol,TopRow,BotCol,BotRow,Mode);
  185.       textcolor(ForeGround);
  186.       textbackground(BackGround);
  187.       window(TopCol+1,TopRow+1,BotCol-1,BotRow-1);
  188.       if NoClr = 0 then clrscr;
  189. END; {Make Window}
  190.  
  191. (*****************************************************************************)
  192.  
  193. PROCEDURE SetScreen;
  194.  
  195. BEGIN {SetScreen}
  196.       window(TopCol,TopRow,BotCol,BotRow);
  197.       textcolor(ForeGround);
  198.       textbackground(BackGround);
  199.       if NoClr = 0 then clrscr;
  200. END; {SetScreen}
  201.  
  202. (*****************************************************************************)
  203.  
  204. FUNCTION Clr;
  205.  
  206. BEGIN {Clr}
  207.       if Mode = 0 then textcolor(Color);
  208.       if Mode = 1 then textbackground(Color);
  209.       Clr := #0;
  210. END; {Clr}
  211.  
  212. END. {UNIT - Windows}
  213.  
  214.  
  215.  
  216.  
  217.  
  218.