home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / WINDOW.ZIP / WINDOW.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  3.5 KB  |  127 lines
  1.  
  2. { Turbo Pascal removable window system } 
  3. { Copyright 1984 Michael A. Covington  } 
  4.  
  5. { For further documentation see PC Tech Journal, February 1985. } 
  6.  
  7. { Requirements: IBM PC or close compatible.   } 
  8. { Screen must be in text mode, on page 1,     } 
  9. { either mono or color card.                  } 
  10.  
  11. { Call INITWIN before calling MKWIN or RMWIN. } 
  12.  
  13. const maxwin = 5;  { maximum number of windows open at once } 
  14.  
  15. type imagetype  = array [1..4096] of char; 
  16.      windimtype = record 
  17.                     x1,y1,x2,y2: integer 
  18.                   end; 
  19. var 
  20.   win: { Global variable package } 
  21.     record 
  22.       dim:    windimtype;  { Current window dimensions } 
  23.       depth:  integer; 
  24.       stack:  array[1..maxwin] of 
  25.                 record 
  26.                   image: imagetype;  { Saved screen image } 
  27.                   dim:   windimtype; { Saved window dimensions } 
  28.                   x,y:   integer     { Saved cursor position } 
  29.                 end 
  30.     end; 
  31.  
  32.   crtmode:      byte      absolute $0040:$0049; 
  33.   crtwidth:     byte      absolute $0040:$004A; 
  34.   monobuffer:   imagetype absolute $B000:$0000; 
  35.   colorbuffer:  imagetype absolute $B800:$0000; 
  36.  
  37. procedure initwin; 
  38.   { Records initial window dimensions } 
  39. begin 
  40.   with win.dim do 
  41.     begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end; 
  42.   win.depth:=0 
  43. end; 
  44.  
  45. procedure boxwin(x1,y1,x2,y2:integer); 
  46.   { Draws a box, fills it with blanks, and makes it the current } 
  47.   { window.  Dimensions given are for the box; actual window is } 
  48.   { one unit smaller in each direction.                         } 
  49.   { This routine can be used separately from the rest of the    } 
  50.   { removable window package.                                   } 
  51. var x,y: integer; 
  52. begin 
  53.   window(1,1,80,25); 
  54.  
  55.   { Top } 
  56.   gotoxy(x1,y1); 
  57.   write(chr(213)); 
  58.   for x:=x1+1 to x2-1 do write(chr(205)); 
  59.   write(chr(184)); 
  60.  
  61.   { Sides } 
  62.   for y:=y1+1 to y2-1 do 
  63.     begin 
  64.       gotoxy(x1,y); 
  65.       write(chr(179), ' ':x2-x1-1, chr(179)) 
  66.     end; 
  67.  
  68.   { Bottom } 
  69.   gotoxy(x1,y2); 
  70.   write(chr(212)); 
  71.   for x:=x1+1 to x2-1 do write(chr(205)); 
  72.   write(chr(190)); 
  73.  
  74.   { Make it the current window } 
  75.   window(x1+1,y1+1,x2-1,y2-1); 
  76.   gotoxy(1,1) 
  77. end; 
  78.  
  79. procedure mkwin(x1,y1,x2,y2:integer); 
  80.   { Create a removable window } 
  81.  
  82. begin 
  83.   { Increment stack pointer } 
  84.   with win do depth:=depth+1; 
  85.   if win.depth>maxwin then 
  86.     begin 
  87.       writeln(^G,' Windows nested too deep '); 
  88.       halt 
  89.     end; 
  90.  
  91.   { Save contents of screen } 
  92.   if crtmode = 7 then 
  93.     win.stack[win.depth].image := monobuffer 
  94.   else 
  95.     win.stack[win.depth].image := colorbuffer; 
  96.  
  97.   win.stack[win.depth].dim := win.dim; 
  98.   win.stack[win.depth].x   := wherex; 
  99.   win.stack[win.depth].y   := wherey; 
  100.  
  101.   { Create the window } 
  102.   boxwin(x1,y1,x2,y2); 
  103.   win.dim.x1 := x1+1; 
  104.   win.dim.y1 := y1+1;    { Allow for margins } 
  105.   win.dim.x2 := x2-1; 
  106.   win.dim.y2 := y2-1; 
  107.  
  108. end; 
  109.  
  110. procedure rmwin; 
  111.   { Remove the most recently created removable window } 
  112.   { Restore screen contents, window dimensions, and   } 
  113.   { position of cursor.  } 
  114. begin 
  115.   if crtmode = 7 then 
  116.     monobuffer := win.stack[win.depth].image 
  117.   else 
  118.     colorbuffer := win.stack[win.depth].image; 
  119.   with win do 
  120.     begin 
  121.       dim := stack[depth].dim; 
  122.       window(dim.x1,dim.y1,dim.x2,dim.y2); 
  123.       gotoxy(stack[depth].x,stack[depth].y);
  124.       depth := depth - 1
  125.     end
  126. end;
  127.