home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
utils
/
miscutil.zip
/
TBWINDOW.ZIP
/
TBWINDO.INC
< prev
Wrap
Text File
|
1987-06-06
|
5KB
|
151 lines
sub MakeWindow(Row%,Col%,Rows%,Cols%,Attr%,BrdrSel%,Shadow%,Zoom%) static
shared wrow%,wrows%,wcol%,wcols%,wattr%,snochk%
local r1%,r2%,c1%,c2%,colratio%
wrow%=row%:wrows%=rows%:wcol%=col%:wcols%=cols%:wattr%=Attr%
select case shadow%
case = 1 'left
c1%=col%-2 : c2%=cols%+2 : r2%=rows%+1
case = 2 'right
c1%=col% : c2%=cols%+2 : r2%=rows%+1
case else
c1%=col% : c2%=cols% : r2%=rows%
end select
if zoom% = 1 then
r1% = row% + (rows%\2)
r2% = row% + rows%-(rows%\2)
c1% = col% + (cols%\2)
c2% = col% + cols%-(cols%\2)
colratio% = (cols% \ rows%)+1
if colratio% > 4 then colratio%=4
do
if r1%>row% then r1%=r1%-1
if r2%<(row%+rows%) then r2%=r2%+1
if c1%>col% then c1%=c1%-colratio%
if c1%<col% then c1%=col%
if c2%<(col%+cols%) then c2%=c2%+colratio%
if c2%>(col%+cols%) then c2%=col%+cols%
call Qbox(r1%,c1%,r2%-r1%,c2%-c1%,attr%,brdrsel%)
loop until c1%=col% and c2%=col%+cols% and r1%=row% and r2%=row%+rows%
else
call Qbox(row%,col%,rows%,cols%,attr%,brdrsel%)
end if
select case shadow%
case = 1 'left
call qfill(row%+1 ,col%-2 ,rows%-1,2 ,asc(" "),snochk%,0)
call qfill(row%+rows%,col%-2 ,1 ,cols%,asc(" "),snochk%,0)
case = 2 'right
call qfill(row%+1 ,col%+cols%,rows%-1,2 ,asc(" "),snochk%,0)
call qfill(row%+rows%,col%+2 ,1 ,cols%,asc(" "),snochk%,0)
case else
end select
end sub
sub TitleWindow(dir%,title$) static
shared wrow%,wcol%,wrows%,wcols%,wattr%,snochk%
select case dir%
case = 1 'UpperLeft
call qprint(wrow%,wcol%+2,title$,snochk%,wattr%)
case = 2 'UpperCenter
call qprintc(wrow%,wcol%,wcol%+wcols%-1,title$,snochk%,wattr%)
case = 3 'UpperRight
call qprint(wrow%,wcol%+wcols%-len(title$)-2,title$,snochk%,wattr%)
case = 4 'LowerLeft
call qprint(wrow%+wrows%,wcol%+2,title$,snochk%,wattr%)
case = 5 'LowerCenter
call qprintc(wrow%+wrows%,wcol%,wcol%+wcols%-1,title$,snochk%,wattr%)
case = 6 'LowerRight
call qprint(wrow%+wrows%,wcol%+wcols%-len(title$)-2,title$,snochk%,wattr%)
case else
end select
end sub
sub Qbox(Row%,Col%,Rows%,Cols%,attr%,BrdrSel%) static
shared snochk%
if rows%>2 and cols%>2 then
if brdrsel% <> 0 then
on brdrsel% gosub single,double,mixed12,mixed21
call qprint(row% ,col% ,tl$ ,snochk%,attr%)
call qfill (row% ,col%+1 ,1 ,cols%-2,asc(th$),snochk%,attr%)
call qprint(row% ,col%+cols%-1,tr$ ,snochk%,attr%)
call qfill (row%+1 ,col% ,rows%-2,1 ,asc(lv$),snochk%,attr%)
call qfill (row%+1 ,col%+cols%-1,rows%-2,1 ,asc(rv$),snochk%,attr%)
call qprint(row%+rows%-1,Col% ,bl$ ,snochk%,attr%)
call qfill (row%+rows%-1,Col%+1 ,1 ,cols%-2,asc(bh$),snochk%,attr%)
call qprint(row%+rows%-1,col%+cols%-1,br$ ,snochk%,attr%)
call qfill (row%+1 ,col%+1 ,rows%-2 ,cols%-2,asc(" "),snochk%,attr%)
else
call qfill (row%,col%,rows%,cols%,asc(" "),snochk%,attr%)
end if
end if
exit sub
Single:
TL$=CHR$(218):TH$=CHR$(196):TR$=CHR$(191)
LV$=CHR$(179):RV$=CHR$(179)
BL$=CHR$(192):BH$=CHR$(196):BR$=CHR$(217)
Return
Double:
TL$=CHR$(201):TH$=CHR$(205):TR$=CHR$(187)
LV$=CHR$(186):RV$=CHR$(186)
BL$=CHR$(200):BH$=CHR$(205):BR$=CHR$(188)
Return
Mixed12:
TL$=CHR$(214):TH$=CHR$(196):TR$=CHR$(183)
LV$=CHR$(186):RV$=CHR$(186)
BL$=CHR$(211):BH$=CHR$(196):BR$=CHR$(189)
Return
Mixed21:
TL$=CHR$(213):TH$=CHR$(205):TR$=CHR$(184)
LV$=CHR$(179):RV$=CHR$(179)
BL$=CHR$(212):BH$=CHR$(205):BR$=CHR$(190)
Return
end sub
def fnattr%(fore%,back%)
local temp%
temp%=(back%*16)+fore%
if fore%>15 then temp% = temp% + 112
fnattr% = temp%
end def
' SNOCHK% = 0 = SNOW CHECKING PERFORMED
' SNOCHK% = 1 = NO SNOW CHECKING (routines much faster)
SUB QPRINT INLINE 'CALL QPRINT(ROW%,COL%,STR$,SNOCHK%,ATTR%)
$INLINE "QPRINT.BIN"
END SUB
SUB QPRINTC INLINE 'CALL QPRINTC(ROW%,COLL%,COLR%,STRDAT$,SNOCHK%,ATTR%)
$INLINE "QPRINTC.BIN"
END SUB
SUB QFILL INLINE 'CALL QFILL(ROW%,COL%,ROWS%,COLS%,CHAR%,SNOCHK%,ATTR%)
$INLINE "QFILL.BIN"
END SUB
SUB QATTR INLINE 'CALL QATTR(ROW%,COL%,ROWS%,COLS%,SNOCHK%,ATTR%)
$INLINE "QATTR.BIN"
END SUB
SUB SAVESCRN INLINE 'CALL SAVESCRN(SNOCHK%,VARPTR(SCRN%(??)))
$INLINE "SAVESCRN.BIN"
END SUB
SUB RESTSCRN INLINE 'CALL RESTSCRN(SNOCHK%,VARPTR(SCRN%(??)))
$INLINE "RESTSCRN.BIN"
END SUB
SUB SCROLL INLINE 'CALL SCROLL(ULR%,ULC%,LRR%,LRC%,LINES%,DIR%)
$INLINE "SCROLL.BIN" ' DIR% = 6 = UP
END SUB ' DIR% = 7 = DOWN
SUB RECOLOR INLINE 'CALL RECOLOR(OLDATTR%,NEWATTR%,SNOCHK%)
$INLINE "RECOLOR.BIN"
END SUB
SUB CALCATTR INLINE 'CALL CALCATTR(FORE%,BACK%,ATTR%)
$INLINE "CALCATTR.BIN"
END SUB