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