home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / turbobas / tbwind30.arc / TBWINDO.INC < prev   
Encoding:
Text File  |  1987-06-22  |  6.2 KB  |  203 lines
  1. mw% = 30
  2. ScrnArray = 8000
  3.  
  4. dim wrow%(mw%),wrows%(mw%),wcol%(mw%),wcols%(mw%),wattr%(mw%),wbrdr%(mw%)
  5. dim wshdw%(mw%),scrn%(ScrnArray),wptr(mw%)
  6.  
  7. sub MakeWindow(Row%,Col%,Rows%,Cols%,Attr%,BrdrSel%,Shadow%,Zoom%) static
  8.   shared wrow%(),wrows%(),wcol%(),wcols%(),wattr%(),wbrdr%(),wshdw%(),scrn%(),wptr(),LI
  9.   local r1%,r2%,c1%,c2%,colratio%,wsize
  10.   select case shadow%
  11.     Rem Left
  12.     case = 1
  13.       c1%=col%-2 : c2%=cols%+2 : r2%=rows%+1
  14.     Rem Right
  15.     case = 2
  16.       c1%=col%   : c2%=cols%+2 : r2%=rows%+1
  17.     case else
  18.       c1%=col%   : c2%=cols%   : r2%=rows%
  19.   end select
  20.   wsize = (r2% * c2%) * 2
  21.   LI = LI + 1
  22.   Wptr(LI+1) = Wptr(LI)+WSize+1
  23.   WRow%(LI)  = Row%
  24.   WCol%(LI)  = Col%
  25.   WRows%(LI) = Rows%
  26.   WCols%(LI) = Cols%
  27.   Wattr%(LI) = Attr%
  28.   WBrdr%(LI) = BrdrSel%
  29.   WShdw%(LI) = Shadow%
  30.   Call Qsave(Row%,c1%,r2%,c2%,scrn%(Wptr(LI)))
  31.   if zoom% = 1 then
  32.     r1% = row% +       (rows%\2)
  33.     r2% = row% + rows%-(rows%\2)
  34.     c1% = col% +       (cols%\2)
  35.     c2% = col% + cols%-(cols%\2)
  36.     colratio% = (cols% \ rows%)+1
  37.     if colratio% > 4 then colratio%=4
  38.     do
  39.       if r1%>row%         then r1%=r1%-1
  40.       if r2%<(row%+rows%) then r2%=r2%+1
  41.       if c1%>col%         then c1%=c1%-colratio%
  42.       if c1%<col%         then c1%=col%
  43.       if c2%<(col%+cols%) then c2%=c2%+colratio%
  44.       if c2%>(col%+cols%) then c2%=col%+cols%
  45.       call Qbox(r1%,c1%,r2%-r1%,c2%-c1%,attr%,brdrsel%)
  46.     loop until c1%=col% and c2%=col%+cols% and r1%=row% and r2%=row%+rows%
  47.   else
  48.     call Qbox(row%,col%,rows%,cols%,attr%,brdrsel%)
  49.   end if
  50.   select case shadow%
  51.     rem Left
  52.     case = 1
  53.       call qfill(row%+1    ,col%-2    ,rows%-1,2    ,asc(" "),0)
  54.       call qfill(row%+rows%,col%-2    ,1      ,cols%,asc(" "),0)
  55.     rem Right
  56.     case = 2
  57.       call qfill(row%+1    ,col%+cols%,rows%-1,2    ,asc(" "),0)
  58.       call qfill(row%+rows%,col%+2    ,1      ,cols%,asc(" "),0)
  59.     case else
  60.   end select
  61. end sub
  62.  
  63. sub TitleWindow(dir%,title$) static
  64. shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
  65.   select case dir%
  66.     rem UpperLeft
  67.     case = 1
  68.       call qprint(wrow%(LI),wcol%(LI)+2,title$,wattr%(LI))
  69.     rem UpperCenter
  70.     case = 2
  71.       call qprintc(wrow%(LI),wcol%(LI),wcol%(LI)+wcols%(LI)-1,title$,wattr%(LI))
  72.     rem UpperRight
  73.     case = 3
  74.       call qprint(wrow%(LI),wcol%(LI)+wcols%(LI)-len(title$)-2,title$,wattr%(LI))
  75.     rem LowerLeft
  76.     case = 4
  77.       call qprint(wrow%(LI)+wrows%(LI)-1,wcol%(LI)+2,title$,wattr%(LI))
  78.     rem LowerCenter
  79.     case = 5
  80.       call qprintc(wrow%(LI)+wrows%(LI)-1,wcol%(LI),wcol%(LI)+wcols%(LI)-1,title$,wattr%(LI))
  81.     rem LowerRight
  82.     case = 6
  83.       call qprint(wrow%(LI)+wrows%(LI)-1,wcol%(LI)+wcols%(LI)-len(title$)-2,title$,wattr%(LI))
  84.     case else
  85.   end select
  86. end sub
  87.  
  88. sub RemoveWindow static
  89. shared Wrow%(),WCol%(),WRows%(),Wcols%(),Wattr%(),WShdw%(),Scrn%(),Wptr(),LI
  90.   if LI = 0 then
  91.     print "NO WINDOW TO REMOVE"
  92.   else
  93.     select case WShdw%(LI)
  94.     case = 1
  95.       call qrest(Wrow%(LI),WCol%(LI)-2,WRows%(LI)+1,WCols%(LI)+2,Scrn%(Wptr(LI)))
  96.     case = 2
  97.       call qrest(WRow%(LI),WCol%(LI)  ,WRows%(LI)+1,WCols%(LI)+2,Scrn%(Wptr(LI)))
  98.     case else
  99.       call qrest(WRow%(LI),Wcol%(LI)  ,WRows%(LI)  ,WCols%(LI)  ,Scrn%(Wptr(LI)))
  100.     end select
  101.     LI = LI -1
  102.   end if
  103. end sub
  104.  
  105. sub Qbox(Row%,Col%,Rows%,Cols%,attr%,BrdrSel%) static
  106.   if rows%>2 and cols%>2 then
  107.     if brdrsel% > 0 and brdrsel% < 6 then
  108.       on brdrsel% gosub single,double,mixed12,mixed21,doubleleftarrow
  109.       call qprint(row%        ,col%        ,tl$                     ,attr%)
  110.       call qfill (row%        ,col%+1      ,1      ,cols%-2,asc(th$),attr%)
  111.       call qprint(row%        ,col%+cols%-1,tr$                     ,attr%)
  112.       call qfill (row%+1      ,col%        ,rows%-2,1      ,asc(lv$),attr%)
  113.       call qfill (row%+1      ,col%+cols%-1,rows%-2,1      ,asc(rv$),attr%)
  114.       call qprint(row%+rows%-1,Col%        ,bl$                     ,attr%)
  115.       call qfill (row%+rows%-1,Col%+1      ,1      ,cols%-2,asc(bh$),attr%)
  116.       call qprint(row%+rows%-1,col%+cols%-1,br$                     ,attr%)
  117.       call qfill (row%+1      ,col%+1      ,rows%-2 ,cols%-2,asc(" "),attr%)
  118.     else
  119.       call qfill (row%,col%,rows%,cols%,asc(" "),attr%)
  120.     end if
  121.   end if
  122.   exit sub
  123.  
  124. Single:
  125.   TL$=CHR$(218):TH$=CHR$(196):TR$=CHR$(191)
  126.   LV$=CHR$(179):RV$=CHR$(179)
  127.   BL$=CHR$(192):BH$=CHR$(196):BR$=CHR$(217)
  128.   Return
  129. Double:
  130.   TL$=CHR$(201):TH$=CHR$(205):TR$=CHR$(187)
  131.   LV$=CHR$(186):RV$=CHR$(186)
  132.   BL$=CHR$(200):BH$=CHR$(205):BR$=CHR$(188)
  133.   Return
  134. Mixed12:
  135.   TL$=CHR$(214):TH$=CHR$(196):TR$=CHR$(183)
  136.   LV$=CHR$(186):RV$=CHR$(186)
  137.   BL$=CHR$(211):BH$=CHR$(196):BR$=CHR$(189)
  138.   Return
  139. Mixed21:
  140.   TL$=CHR$(213):TH$=CHR$(205):TR$=CHR$(184)
  141.   LV$=CHR$(179):RV$=CHR$(179)
  142.   BL$=CHR$(212):BH$=CHR$(205):BR$=CHR$(190)
  143.   Return
  144. DoubleLeftArrow:
  145.   TL$=CHR$(17):TH$=CHR$(205):TR$=CHR$(187)
  146.   LV$=CHR$(186):RV$=CHR$(186)
  147.   BL$=CHR$(200):BH$=CHR$(205):BR$=CHR$(188)
  148.   Return
  149. end sub
  150.  
  151. sub ClearWindow static
  152. shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
  153.    call qfill (wrow%(LI)+1,wcol%(LI)+1,wrows%(LI)-2,wcols%(LI)-2,asc(" "),wattr%(LI))
  154. end sub
  155.  
  156. sub PrtWindow(row%,col%,StrDat$) static
  157. shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
  158.    call qprint(wrow%(LI)+row%,wcol%(LI)+col%,StrDat$,wattr%(LI))
  159. end sub
  160.  
  161. sub PrtCWindow(row%,StrDat$) static
  162. shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
  163.    call qprintc(wrow%(LI)+row%,wcol%(LI),wcol%(LI)+wcols%(LI),StrDat$,wattr%(LI))
  164. end sub
  165.  
  166. def fnattr%(fore%,back%)
  167.   local temp%
  168.   temp%=(back%*16)+fore%
  169.   if fore%>15 then temp% = temp% + 112
  170.   fnattr% = temp%
  171. end def
  172.  
  173. SUB QPRINT INLINE
  174.   $INLINE "QPRINT.BIN"
  175. END SUB
  176. rem CALL QPRINT(ROW%,COL%,STR$,ATTR%)
  177.  
  178. SUB QPRINTC INLINE
  179.   $INLINE "QPRINTC.BIN"
  180. END SUB
  181. rem CALL QPRINTC(ROW%,COLL%,COLR%,STRDAT$,ATTR%)
  182.  
  183. SUB QFILL INLINE
  184.   $INLINE "QFILL.BIN"
  185. END SUB
  186. rem CALL QFILL(ROW%,COL%,ROWS%,COLS%,CHAR%,ATTR%)
  187.  
  188. SUB QATTR INLINE
  189.   $INLINE "QATTR.BIN"
  190. END SUB
  191. rem CALL QATTR(ROW%,COL%,ROWS%,COLS%,ATTR%)
  192.  
  193. SUB QSAVE INLINE
  194.   $INLINE "QSAVE.BIN"
  195. END SUB
  196. rem CALL QSAVE(ROW%,COL%,ROWS%,COLS%,SCRN%(??))
  197.  
  198. SUB QREST INLINE
  199.   $INLINE "QREST.BIN"
  200. END SUB
  201. rem CALL QREST(ROW%,COL%,ROWS%,COLS%,SCRN%(??))
  202.  
  203.