'===========================================================================
' Subject: PB WINDOWS LIBRARY                Date: 08-02-96 (20:48)       
' Author:  Bradley Miller                    Code: PB                     
' Origin:  bgmiller@midwest.net            Packet: MENU.ABC
'===========================================================================
' These routines are aimed at hopefully helping those that are new to
' writing code in the PowerBASIC enviroment. (like me)
' There's not much here but if it can be of some help, I'm happy.
' If you don't need them because you are good at this kind of stuff,
' help someone who is striving to learn. (like me)
' Anyway, use 'em or lose 'em.
'
' If you have comments or suggestions please make contact...
'   Internet: bgmiller@midwest.net
' or
'   B. G. Miller
'   P. O. Box 184
'   Ullin, IL. 62992
'---------------------------------------------------------------------------

DECLARE SUB center(lcol%, rcol%, text$, row%)
DECLARE SUB cover(trow%, brow%, lcol%, rcol%, cnum%)
DECLARE SUB putwin(trow%, brow%, lcol%, rcol%, shad%, text$, fg%, bg%)
DECLARE SUB putbox(trow%, brow%, lcol%, rcol%, bord%, shad%, text$)
DECLARE SUB lilshad (trow%, brow%, lcol%, rcol%)
DECLARE SUB putscrn(scrn$)
DECLARE FUNCTION vidseg&()
DECLARE FUNCTION getscrn$()
DECLARE SUB hold()

DIM lastscrn$(4)             ' make array for screens

COLOR 9, 0
CLS
cover 2, 24, 1, 80, 176           ' cover background with chr$(176)
COLOR 0, 7
LOCATE 1, 1: PRINT STRING$(80, 0);
LOCATE 25, 1: PRINT STRING$(80, 0);
center 1, 80, "Press any key to continue...", 25
lastscrn$(0) = getscrn$
hold

COLOR 15, 7
 putbox 3, 9, 6, 38, 2, 1, ""
 lastscrn$(1) = getscrn$
 hold
COLOR 7, 1
 putbox 13, 19, 4, 72, 4, 1, " Description "
 lastscrn$(2) = getscrn$
 hold
COLOR 15, 5
 putbox 4, 21, 44, 75, 1, 2, " Description "
 lastscrn$(3) = getscrn$
 hold
COLOR 14, 6
 putbox 3, 21, 3, 77, 4, 2, ""
 cover 4, 20, 4, 76, 247       ' put some junk in box
 lastscrn$(4) = getscrn$
 hold
COLOR 11, 3
 putbox 6, 17, 12, 51, 5, 2, ""
 hold
 putscrn lastscrn$(4)
 hold
 putscrn lastscrn$(3)
 hold
 putscrn lastscrn$(2)
 hold
 putscrn lastscrn$(1)
 hold
 putscrn lastscrn$(0)
 hold
COLOR 0, 7
 putbox 3, 22, 3, 77, 6, 2, ""
 hold
COLOR 14, 3
 putbox 5, 12, 5, 21, 1, 0, ""
COLOR 0, 7
 lilshad 5, 12, 5, 21
 hold
COLOR 11, 1
 putbox 4, 13, 26, 66, 2, 0, ""
COLOR 0, 7
 lilshad 4, 13, 26, 66
 hold
COLOR 15, 4
LOCATE 21, 6: PRINT " Button 1 "
COLOR 14, 3
LOCATE 21, 21: PRINT " Button 2 "
COLOR 11, 1
LOCATE 21, 36: PRINT " Button 3 "
COLOR 14, 5
LOCATE 21, 51: PRINT " Button 4 "
COLOR 0, 7
 lilshad 21, 21, 6, 15
 lilshad 21, 21, 21, 30
COLOR 8, 7
 lilshad 21, 21, 36, 45
 lilshad 21, 21, 51, 60
hold
COLOR 15, 0
 putbox 16, 18, 4, 68, 2, 0, " Description "
COLOR 8, 7
 lilshad 16, 18, 4, 68
 hold
 putscrn lastscrn$(0)
 hold
COLOR 1, 7
 putwin 3, 22, 3, 77, 1, "This is the top text", 7, 1
COLOR 1, 7
 center 3, 77, " This is the bottom text...", 22
 hold
COLOR 15, 1
 cover 4, 21, 4, 76, 88    ' put some junk in box
 hold
COLOR 7, 4
 putwin 6, 18, 7, 60, 1, "", 4, 7
 hold
 putscrn lastscrn$(0)
 hold
COLOR 0, 7
 putwin 6, 18, 7, 70, 1, "", 7, 0
COLOR 15, 0
 center 7, 70, "That's all.......", 12
 hold
COLOR 7, 0
CLS
END

'---------------------------------------------------------------------------
SUB center (lcol%, rcol%, text$, row%)

cols% = (rcol% - lcol%) + 1     ' # of columns to center text in
cdif% = cols% - LEN(text$)      ' difference in text length and col%
mcol% = (cdif% \ 2) + lcol%     ' column to start at
LOCATE row%, mcol%
PRINT text$;

END SUB
'---------------------------------------------------------------------------
SUB cover(trow%, brow%, lcol%, rcol%, cnum%)

numcols% = (rcol% - lcol%) + 1      ' # of columns to cover

FOR x% = trow% TO brow%             ' for loop covers form toprow to
 LOCATE x%, lcol%                  ' bottomrow, numcol% wide with
 PRINT STRING$(numcols%, cnum%);   ' character(chr$) number (cnum%)
NEXT x%

END SUB
'---------------------------------------------------------------------------
SUB lilshad (trow%, brow%, lcol%, rcol%)

IF trow% = brow% THEN GOTO oneline

numcol% = (rcol% - lcol%) + 1
LOCATE brow% + 1, lcol% + 1: PRINT STRING$(numcol%, 223);
LOCATE trow%, rcol% + 1: PRINT CHR$(220);

FOR x% = trow% + 1 TO brow%
 LOCATE x%, rcol% + 1
 PRINT CHR$(219);
NEXT x%
EXIT SUB

oneline:           ' if just 1 row

numcol% = (rcol% - lcol%) + 1
LOCATE brow% + 1, lcol% + 1: PRINT STRING$(numcol%, 223);
LOCATE trow%, rcol% + 1: PRINT CHR$(220);

END SUB
'---------------------------------------------------------------------------
SUB putwin(trow%, brow%, lcol%, rcol%, shad%, text$, fg%, bg%)

' putwin calls putbox to make initial box
putbox trow%, brow%, lcol%, rcol%, 6, shad%, text$ ' border here must be 6
color fg%, bg%       ' must be reverse of original color for putwin
numcols% = (rcol% - lcol%) + 1        ' # of columns to cover

FOR x% = trow% + 1 TO brow% - 1       ' leave border top and bottom
 LOCATE x%, lcol%
 PRINT STRING$(numcols%, 0);          ' print nothing to cover (0)
NEXT x%

FOR x% = trow% + 1 TO brow% - 1
 LOCATE x%, lcol%: PRINT CHR$(221)    ' left border
 LOCATE x%, rcol%: PRINT CHR$(222)    ' right border
NEXT x%

END SUB
'---------------------------------------------------------------------------
SUB putbox(trow%, brow%, lcol%, rcol%, bord%, shad%, text$)

 SELECT CASE bord%
  CASE 1  ' single line border
   tlc$ = CHR$(218): tm$ = CHR$(196): trc$ = CHR$(191): s$ = CHR$(179)
   blc$ = CHR$(192): bm$ = CHR$(196): brc$ = CHR$(217)
  CASE 2  ' double line border
   tlc$ = CHR$(201): tm$ = CHR$(205): trc$ = CHR$(187): s$ = CHR$(186)
   blc$ = CHR$(200): bm$ = CHR$(205): brc$ = CHR$(188)
  CASE 3  ' double line top, single line side
   tlc$ = CHR$(213): tm$ = CHR$(205): trc$ = CHR$(184): s$ = CHR$(179)
   blc$ = CHR$(212): bm$ = CHR$(205): brc$ = CHR$(190)
  CASE 4  ' single line top, double line side
   tlc$ = CHR$(214): tm$ = CHR$(196): trc$ = CHR$(183): s$ = CHR$(186)
   blc$ = CHR$(211): bm$ = CHR$(196): brc$ = CHR$(189)
  CASE 5  ' thick line all sides
   tlc$ = CHR$(219): tm$ = CHR$(223): trc$ = CHR$(219): s$ = CHR$(219)
   blc$ = CHR$(219): bm$ = CHR$(220): brc$ = CHR$(219)
  CASE 6  ' no lines
   tlc$ = CHR$(0): tm$ = CHR$(0): trc$ = CHR$(0): s$ = CHR$(0)
   blc$ = CHR$(0): bm$ = CHR$(0): brc$ = CHR$(0)
  CASE ELSE  ' single line if < 1 or > 6
   tlc$ = CHR$(218): tm$ = CHR$(196): trc$ = CHR$(191): s$ = CHR$(179)
   blc$ = CHR$(192): bm$ = CHR$(196): brc$ = CHR$(217)
END SELECT

wide% = (rcol% - lcol%) - 1

IF text$ > "" THEN         ' text$ is title if wanted
 widedif% = wide% - LEN(text$)
 rwide% = widedif% - 3     ' put title 3 columns right of top-left corner
 LOCATE trow%, lcol%
 PRINT tlc$; STRING$(3, tm$); text$; STRING$(rwide%, tm$); trc$  ' top with title
ELSE
 LOCATE trow%, lcol%
 PRINT tlc$; STRING$(wide%, tm$); trc$;   ' top with no title
END IF

FOR I% = trow% + 1 TO brow% - 1           ' for loop prints middle
 LOCATE I%, lcol%
 PRINT s$; SPACE$(wide%); s$;
NEXT I%

LOCATE brow%, lcol%
PRINT blc$; STRING$(wide%, bm$); brc$;    ' print bottom

IF shad% = 0 THEN EXIT SUB     ' if no shadow wanted (0) exit sub

' put shadow right side and bottom of box

video& = vidseg&              ' call vidseg& function
IF video& =  &hb000 THEN
 EXIT SUB                     ' monochrome, no need for shadow
ELSE
 DEF SEG = &hb800
END IF

' get present screen attributes
attr% = SCREEN(brow% + 1, rcol% + 1, -1)  ' get attribute
attr% = attr% AND 15                      ' get forground
attr% = attr% - 8                         ' dim if bright
IF attr% < 1 THEN attr% = 8               ' if wasn't bright
' if don't want dim, 15 to 7 or 9 to 1, use 8 for attr%

' POKE shadow where needed...POKE right side

FOR row% = trow% + 1 TO brow% + 1       ' 1 less than top, 1 greater than bottom
 FOR col% = rcol% + 1 TO rcol% + shad%  ' shad% is # columns, 1 or 2 usually
  offset% = (row% - 1) * 160 + (col% - 1) * 2 + 1
  POKE offset%, attr%
 NEXT
NEXT
' POKE bottom
row% = brow% + 1                        '1 row past bottom

FOR col% = lcol% + shad% TO rcol% + shad%   ' shad% is 1 or 2
 offset% = (row% - 1) * 160 + (col% - 1) * 2 + 1
 POKE offset%, attr%
NEXT

DEF SEG

END SUB
'---------------------------------------------------------------------------
SUB putscrn(scrn$)

def seg = vidseg&
poke$ 0, scrn$
def seg

END SUB
'---------------------------------------------------------------------------
FUNCTION getscrn$()

def seg = vidseg&
getscrn$ = peek$(0, 4000)    ' 1 screen color
def seg

END FUNCTION

'---------------------------------------------------------------------------
FUNCTION vidseg&()

DEF SEG = 0
IF PEEK(&h463) = &hb4 THEN
 vidseg& = &hb000
ELSE
 vidseg& = &hb800
END IF
DEF SEG

END FUNCTION
'---------------------------------------------------------------------------
SUB hold()

WHILE NOT INSTAT
LOOP
DO
LOOP UNTIL INKEY$ = ""

END SUB