home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / utils / miscutil.zip / TBWINDOW.ZIP / TBWINDO.INC < prev   
Text File  |  1987-06-06  |  5KB  |  151 lines

  1. sub MakeWindow(Row%,Col%,Rows%,Cols%,Attr%,BrdrSel%,Shadow%,Zoom%) static
  2.   shared wrow%,wrows%,wcol%,wcols%,wattr%,snochk%
  3.   local r1%,r2%,c1%,c2%,colratio%
  4.   wrow%=row%:wrows%=rows%:wcol%=col%:wcols%=cols%:wattr%=Attr%
  5.   select case shadow%
  6.     case = 1 'left
  7.       c1%=col%-2 : c2%=cols%+2 : r2%=rows%+1
  8.     case = 2 'right
  9.       c1%=col%   : c2%=cols%+2 : r2%=rows%+1
  10.     case else
  11.       c1%=col%   : c2%=cols%   : r2%=rows%
  12.   end select
  13.   if zoom% = 1 then
  14.     r1% = row% +       (rows%\2)
  15.     r2% = row% + rows%-(rows%\2)
  16.     c1% = col% +       (cols%\2)
  17.     c2% = col% + cols%-(cols%\2)
  18.     colratio% = (cols% \ rows%)+1
  19.     if colratio% > 4 then colratio%=4
  20.     do
  21.       if r1%>row%         then r1%=r1%-1
  22.       if r2%<(row%+rows%) then r2%=r2%+1
  23.       if c1%>col%         then c1%=c1%-colratio%
  24.       if c1%<col%         then c1%=col%
  25.       if c2%<(col%+cols%) then c2%=c2%+colratio%
  26.       if c2%>(col%+cols%) then c2%=col%+cols%
  27.       call Qbox(r1%,c1%,r2%-r1%,c2%-c1%,attr%,brdrsel%)
  28.     loop until c1%=col% and c2%=col%+cols% and r1%=row% and r2%=row%+rows%
  29.   else
  30.     call Qbox(row%,col%,rows%,cols%,attr%,brdrsel%)
  31.   end if
  32.   select case shadow%
  33.     case = 1 'left
  34.       call qfill(row%+1    ,col%-2    ,rows%-1,2    ,asc(" "),snochk%,0)
  35.       call qfill(row%+rows%,col%-2    ,1      ,cols%,asc(" "),snochk%,0)
  36.     case = 2 'right
  37.       call qfill(row%+1    ,col%+cols%,rows%-1,2    ,asc(" "),snochk%,0)
  38.       call qfill(row%+rows%,col%+2    ,1      ,cols%,asc(" "),snochk%,0)
  39.     case else
  40.   end select
  41. end sub
  42.  
  43. sub TitleWindow(dir%,title$) static
  44. shared wrow%,wcol%,wrows%,wcols%,wattr%,snochk%
  45.   select case dir%
  46.     case = 1 'UpperLeft
  47.       call qprint(wrow%,wcol%+2,title$,snochk%,wattr%)
  48.     case = 2 'UpperCenter
  49.       call qprintc(wrow%,wcol%,wcol%+wcols%-1,title$,snochk%,wattr%)
  50.     case = 3 'UpperRight
  51.       call qprint(wrow%,wcol%+wcols%-len(title$)-2,title$,snochk%,wattr%)
  52.     case = 4 'LowerLeft
  53.       call qprint(wrow%+wrows%,wcol%+2,title$,snochk%,wattr%)
  54.     case = 5 'LowerCenter
  55.       call qprintc(wrow%+wrows%,wcol%,wcol%+wcols%-1,title$,snochk%,wattr%)
  56.     case = 6 'LowerRight
  57.       call qprint(wrow%+wrows%,wcol%+wcols%-len(title$)-2,title$,snochk%,wattr%)
  58.     case else
  59.   end select
  60. end sub
  61.  
  62. sub Qbox(Row%,Col%,Rows%,Cols%,attr%,BrdrSel%) static
  63. shared snochk%
  64.   if rows%>2 and cols%>2 then
  65.     if brdrsel% <> 0 then
  66.       on brdrsel% gosub single,double,mixed12,mixed21
  67.       call qprint(row%        ,col%        ,tl$                     ,snochk%,attr%)
  68.       call qfill (row%        ,col%+1      ,1      ,cols%-2,asc(th$),snochk%,attr%)
  69.       call qprint(row%        ,col%+cols%-1,tr$                     ,snochk%,attr%)
  70.       call qfill (row%+1      ,col%        ,rows%-2,1      ,asc(lv$),snochk%,attr%)
  71.       call qfill (row%+1      ,col%+cols%-1,rows%-2,1      ,asc(rv$),snochk%,attr%)
  72.       call qprint(row%+rows%-1,Col%        ,bl$                     ,snochk%,attr%)
  73.       call qfill (row%+rows%-1,Col%+1      ,1      ,cols%-2,asc(bh$),snochk%,attr%)
  74.       call qprint(row%+rows%-1,col%+cols%-1,br$                     ,snochk%,attr%)
  75.       call qfill (row%+1      ,col%+1      ,rows%-2 ,cols%-2,asc(" "),snochk%,attr%)
  76.     else
  77.       call qfill (row%,col%,rows%,cols%,asc(" "),snochk%,attr%)
  78.     end if
  79.   end if
  80.   exit sub
  81.  
  82. Single:
  83.   TL$=CHR$(218):TH$=CHR$(196):TR$=CHR$(191)
  84.   LV$=CHR$(179):RV$=CHR$(179)
  85.   BL$=CHR$(192):BH$=CHR$(196):BR$=CHR$(217)
  86.   Return
  87. Double:
  88.   TL$=CHR$(201):TH$=CHR$(205):TR$=CHR$(187)
  89.   LV$=CHR$(186):RV$=CHR$(186)
  90.   BL$=CHR$(200):BH$=CHR$(205):BR$=CHR$(188)
  91.   Return
  92. Mixed12:
  93.   TL$=CHR$(214):TH$=CHR$(196):TR$=CHR$(183)
  94.   LV$=CHR$(186):RV$=CHR$(186)
  95.   BL$=CHR$(211):BH$=CHR$(196):BR$=CHR$(189)
  96.   Return
  97. Mixed21:
  98.   TL$=CHR$(213):TH$=CHR$(205):TR$=CHR$(184)
  99.   LV$=CHR$(179):RV$=CHR$(179)
  100.   BL$=CHR$(212):BH$=CHR$(205):BR$=CHR$(190)
  101.   Return
  102.  
  103. end sub
  104.  
  105. def fnattr%(fore%,back%)
  106.   local temp%
  107.   temp%=(back%*16)+fore%
  108.   if fore%>15 then temp% = temp% + 112
  109.   fnattr% = temp%
  110. end def
  111.  
  112. ' SNOCHK% = 0 = SNOW CHECKING PERFORMED
  113. ' SNOCHK% = 1 = NO SNOW CHECKING (routines much faster)
  114.  
  115. SUB QPRINT INLINE         'CALL QPRINT(ROW%,COL%,STR$,SNOCHK%,ATTR%)
  116.   $INLINE "QPRINT.BIN"
  117. END SUB
  118.  
  119. SUB QPRINTC INLINE        'CALL QPRINTC(ROW%,COLL%,COLR%,STRDAT$,SNOCHK%,ATTR%)
  120.   $INLINE "QPRINTC.BIN"
  121. END SUB
  122.  
  123. SUB QFILL INLINE          'CALL QFILL(ROW%,COL%,ROWS%,COLS%,CHAR%,SNOCHK%,ATTR%)
  124.   $INLINE "QFILL.BIN"
  125. END SUB
  126.  
  127. SUB QATTR INLINE          'CALL QATTR(ROW%,COL%,ROWS%,COLS%,SNOCHK%,ATTR%)
  128.   $INLINE "QATTR.BIN"
  129. END SUB
  130.  
  131. SUB SAVESCRN INLINE       'CALL SAVESCRN(SNOCHK%,VARPTR(SCRN%(??)))
  132.   $INLINE "SAVESCRN.BIN"
  133. END SUB
  134.  
  135. SUB RESTSCRN INLINE       'CALL RESTSCRN(SNOCHK%,VARPTR(SCRN%(??)))
  136.   $INLINE "RESTSCRN.BIN"
  137. END SUB
  138.  
  139. SUB SCROLL INLINE         'CALL SCROLL(ULR%,ULC%,LRR%,LRC%,LINES%,DIR%)
  140.   $INLINE "SCROLL.BIN"    '          DIR% = 6 = UP
  141. END SUB                   '          DIR% = 7 = DOWN
  142.  
  143. SUB RECOLOR INLINE         'CALL RECOLOR(OLDATTR%,NEWATTR%,SNOCHK%)
  144.   $INLINE "RECOLOR.BIN"
  145. END SUB
  146.  
  147. SUB CALCATTR INLINE       'CALL CALCATTR(FORE%,BACK%,ATTR%)
  148.   $INLINE "CALCATTR.BIN"
  149. END SUB
  150.  
  151.