home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / database / designer / windows.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-05-13  |  4.3 KB  |  184 lines
  1. unit windows;
  2. interface
  3. Uses
  4.    Dos,
  5.    Crt;
  6.  
  7. procedure boxwin(x1,y1,x2,y2,t,b:integer;Border:Boolean);
  8. procedure Init_Windows;
  9. procedure Make_Window(x1,y1,x2,y2,t,b:integer;Border:Boolean);
  10. procedure Remove_Window;
  11. procedure Remove_Windows;
  12.  
  13. implementation
  14. Const
  15.    FastVideo : Boolean = False;
  16.  
  17. type
  18.    string10 = string[10];
  19.    string80 = string[80];
  20.    imagetype  = array [1..4096] of char;
  21.      windimtype = record
  22.                     x1,y1,x2,y2: integer
  23.                   end;
  24.  
  25. const maxwin = 5;  { maximum number of windows open at once }
  26.  
  27.  
  28. var
  29.       a: integer;
  30.   win: { Global variable package }
  31.     record
  32.       dim:    windimtype;  { Current window dimensions }
  33.       depth:  integer;
  34.       WinStack:  array[1..maxwin] of
  35.                 record
  36.                   image: imagetype;  { Saved screen image }
  37.                   dim:   windimtype; { Saved window dimensions }
  38.                   x,y:   integer     { Saved cursor position }
  39.                 end
  40.     end;
  41.  
  42.   crtmode:      byte      absolute $0040:$0049;
  43.   crtwidth:     byte      absolute $0040:$004A;
  44.   monobuffer:   imagetype absolute $B000:$0000;
  45.   colorbuffer:  imagetype absolute $B800:$0000;
  46.  
  47.  
  48.  
  49. { ----------------------------------------------------- }
  50. { Call Init_Windows before calling Make_Window or Remove_Window. }
  51.  
  52.  
  53. procedure Init_Windows;
  54.   { Records initial window dimensions }
  55. begin
  56.   with win.dim do
  57.     begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
  58.   win.depth:=0
  59. end;
  60.  
  61. procedure boxwin(x1,y1,x2,y2,t,b:integer;Border:Boolean);
  62.   { Draws a box, fills it with blanks, and makes it the current }
  63.   { window.  Dimensions given are for the box; actual window is }
  64.   { one unit smaller in each direction.                         }
  65.   { This routine can be used separately from the rest of the    }
  66.   { removable window package.                                   }
  67. var x,y: integer;
  68. begin
  69.   textbackground(b);
  70.   window(1,1,80,25);
  71.   If Border Then
  72.   Begin
  73.      { Top }
  74.      TextColor(t);
  75.      TextBackground(B);
  76.      GoToXY(x1,y1);
  77.      Write(#213);
  78.      for x:=x1+1 to x2-1 do
  79.      Begin
  80.         GoToXY(x,y);
  81.         Write(#205);
  82.      End;
  83.      GoToXY(x2,y1);
  84.      Write(#184);
  85.  
  86.      { Sides }
  87.      for y:=y1+1 to y2-1 do
  88.      Begin
  89.         GoToXY(x1,y);
  90.         Write(#179);
  91.         GoToXY(x2,y);
  92.         Write(#179);
  93.      End;
  94.      { Bottom }
  95.      GoToXY(x1,y2);
  96.      Write(#212);
  97.  
  98.      for x:=x1+1 to x2-1 do
  99.      Begin
  100.         GoToXY(x,y2);
  101.         Write(#205);
  102.      End;
  103.      Write(#190);
  104.   End;
  105.   { Make it the current window }
  106.   If Border Then
  107.   window(x1+1,y1+1,x2-1,y2-1) Else
  108.   Window(x1,y1,x2,y2);
  109.   clrscr;
  110.   gotoxy(1,1)
  111. end;
  112.  
  113. procedure Make_Window;
  114.   { Create a removable window }
  115.  
  116. begin
  117.   { Increment WinStack pointer }
  118.   with win do
  119.   If depth < MaxWin Then
  120.   depth:=depth+1;
  121.   if win.depth>maxwin then
  122.     begin
  123.       win.depth := MaxWin;
  124.       writeln(' Window nesting error. ');
  125.       exit
  126.     end;
  127.  
  128.   { Save contents of screen }
  129.   if crtmode = 7 then
  130.     win.WinStack[win.depth].image := monobuffer
  131.   else
  132.     win.WinStack[win.depth].image := colorbuffer;
  133.  
  134.   win.WinStack[win.depth].dim := win.dim;
  135.   win.WinStack[win.depth].x   := wherex;
  136.   win.WinStack[win.depth].y   := wherey;
  137.  
  138.   { Create the window }
  139.   If Border Then
  140.   Begin
  141.      boxwin(x1,y1,x2,y2,t,b,Border);
  142.      win.dim.x1 := x1+1;
  143.      win.dim.y1 := y1+1;    { Allow for margins }
  144.      win.dim.x2 := x2-1;
  145.      win.dim.y2 := y2-1;
  146.   End Else
  147.   Begin
  148.      BoxWin(X1,Y1,X2,Y2,t,b,Border);
  149.      win.dim.x1 := x1;
  150.      win.dim.y1 := y1;    { Allow for margins }
  151.      win.dim.x2 := x2;
  152.      win.dim.y2 := y2;
  153.   End;
  154. end;
  155.  
  156. procedure Remove_Window;
  157.   { Remove the most recently created removable window }
  158.   { Restore screen contents, window dimensions, and   }
  159.   { position of cursor.  }
  160. begin
  161.   if win.depth < 1 then exit;
  162.   if crtmode = 7 then
  163.     monobuffer := win.WinStack[win.depth].image
  164.   else
  165.     colorbuffer := win.WinStack[win.depth].image;
  166.   with win do
  167.     begin
  168.       dim := WinStack[depth].dim;
  169.       window(dim.x1,dim.y1,dim.x2,dim.y2);
  170.       gotoxy(WinStack[depth].x,WinStack[depth].y);
  171.       depth := depth - 1
  172.     end
  173. end;
  174.  
  175. Procedure Remove_Windows;
  176. Var
  177.    i : integer;
  178.  
  179. begin
  180.    for i := 1 to 5 do Remove_Window;
  181. end;
  182.  
  183. end.
  184.