home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 270.img / FORUM25C.ZIP / WINDOWS.PAS < prev   
Pascal/Delphi Source File  |  1988-12-27  |  4KB  |  204 lines
  1. {$R-,S-,I-,V-,B-,N-,L- }
  2. {$O-}
  3.  
  4. unit windows;
  5.  
  6.  
  7. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  8.  
  9. interface
  10.  
  11. uses gentypes,crt,subs1,configrt;
  12.  
  13. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  14.  
  15.  
  16. VAR winds:array [0..2] of windowrec;
  17.     split,inuse:integer;
  18.  
  19. Procedure getcoor;
  20. Procedure usewind (n:byte);
  21. Procedure setwind (n:byte; nx1,ny1,nx2,ny2:byte);
  22. Procedure initwind (n,nx1,ny1,nx2,ny2,ncolor:byte);
  23. Procedure top;
  24. Procedure bottom;
  25. Procedure wholescreen;
  26. Procedure drawsplit;
  27. Procedure initwinds;
  28. Procedure unsplit;
  29. Procedure splitscreen (v:byte);
  30. Procedure setoutlock (b:boolean);
  31. Procedure bottomline;
  32.  
  33.  
  34. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  35.  
  36. implementation
  37.  
  38. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  39.  
  40.  
  41. Procedure getcoor;
  42. begin
  43.   with winds[inuse] do begin
  44.     cx:=wherex;
  45.     cy:=wherey;
  46.     if cy<1 then cy:=1;
  47.     if cy>(y2-y1)+1 then cy:=(y2-y1)+1
  48.   end
  49. end;
  50.  
  51. Procedure usewind (n:byte);
  52. begin
  53.   getcoor;
  54.   inuse:=n;
  55.   with winds[n] do begin
  56.     window (x1,y1,x2,y2);
  57.     gotoxy (cx,cy);
  58.     textcolor (color);
  59.     textbackground (0);
  60.     lasty:=y2-y1+1
  61.   end
  62. end;
  63.  
  64. Procedure setwind (n:byte; nx1,ny1,nx2,ny2:byte);
  65. VAR i:integer;
  66. begin
  67.   i:=inuse;
  68.   usewind(n);
  69.   with winds[n] do begin
  70.     x1:=nx1;
  71.     y1:=ny1;
  72.     x2:=nx2;
  73.     y2:=ny2
  74.   end;
  75.   usewind(n);
  76.   if n<>i then usewind(i)
  77. end;
  78.  
  79. Procedure initwind (n,nx1,ny1,nx2,ny2,ncolor:byte);
  80. begin
  81.   with winds[n] do begin
  82.     x1:=nx1;
  83.     y1:=ny1;
  84.     x2:=nx2;
  85.     y2:=ny2;
  86.     cx:=1;
  87.     cy:=1;
  88.     color:=ncolor
  89.   end
  90. end;
  91.  
  92. Procedure top;
  93. begin
  94.   usewind (1)
  95. end;
  96.  
  97. Procedure bottom;
  98. begin
  99.   usewind (2)
  100. end;
  101.  
  102. Procedure wholescreen;
  103. begin
  104.   usewind (0)
  105. end;
  106.  
  107. Procedure drawsplit;
  108. VAR cnt:integer;
  109. begin
  110.   usewind (0);
  111.   textcolor (splitcolor);
  112.   gotoxy (1,split);
  113.   for cnt:=0 to 79 do write (usr,chr(196));
  114.   bottom
  115. end;
  116.  
  117. Procedure initwinds;
  118. begin
  119.   splitmode:=false;
  120.   initwind (0,1,1,80,25,splitcolor);
  121.   initwind (2,1,1,80,24,normbotcolor);
  122.   split:=0;
  123.   inuse:=0;
  124.   bottom
  125. end;
  126.  
  127. Procedure unsplit;
  128. VAR y:integer;
  129. begin
  130.   if not splitmode then exit;
  131.   if inuse=2
  132.     then y:=wherey
  133.     else y:=winds[2].cy;
  134.   y:=y+split;
  135.   setwind (2,1,1,80,24);
  136.   setwind (1,1,1,80,split);
  137.   top;
  138.   clrscr;
  139.   splitmode:=false;
  140.   bottom;
  141.   gotoxy (wherex,y)
  142. end;
  143.  
  144. Procedure splitscreen (v:byte);
  145. VAR x,y:integer;
  146. begin
  147.   if splitmode then unsplit;
  148.   x:=wherex;
  149.   y:=wherey-v;
  150.   splitmode:=true;
  151.   split:=v;
  152.   drawsplit;
  153.   initwind (1,1,1,80,split-1,normtopcolor);
  154.   setwind (2,1,split+1,80,24);
  155.   top;
  156.   clrscr;
  157.   bottom;
  158.   gotoxy (x,y)
  159. end;
  160.  
  161. Procedure setoutlock (b:boolean);
  162. begin
  163.   modemoutlock:=b;
  164.   if b
  165.     then winds[2].color:=outlockcolor
  166.     else winds[2].color:=normbotcolor;
  167.   if inuse=2 then usewind (2)
  168. end;
  169.  
  170. Procedure bottomline;
  171. VAR o:integer;
  172.  
  173.   Procedure flash (q:mstr);
  174.   begin
  175.     textcolor (16);
  176.     write (usr,q);
  177.     textcolor (0)
  178.   end;
  179.  
  180. begin
  181.   if inuse=0 then exit;
  182.   o:=inuse;
  183.   wholescreen;
  184.   gotoxy (1,25);
  185.   textcolor (0);
  186.   textbackground (statlinecolor);
  187.   if timelock then settimeleft (lockedtime);
  188.   write (usr,unam,', Lvl ',ulvl,', ',timeleft,' left.');
  189.   if chatmode
  190.     then flash (' CHAT!')
  191.     else write (usr,' ',sysopavailstr);
  192.   if timelock then flash (' Timelock');
  193.   if modeminlock then flash (' InLock');
  194.   if modemoutlock then flash (' OutLock');
  195.   if tempsysop then flash (' *Sysop*');
  196.   if texttrap then flash (' Trap');
  197.   if printerecho then flash (' Print');
  198.   if sysnext then write (usr,' Sysop next');
  199.   clreol;
  200.   usewind (o);
  201. end;
  202.  
  203. end.
  204.