home *** CD-ROM | disk | FTP | other *** search
'Bounce-bar menu routine for Microsoft QuickBasic 4.0 'By Michael J. Himowitz, 8134 Scotts Level Rd, Baltimore, MD 21208 'CIS 71655,1327, Delphi MHIMOWITZ ' 'This set of routines will allow you to set up and call a series 'of Bounce-Bar type menus in QB4. The user may select a choice from 'a menu by moving the UP and DOWN cursor keys to highlight the choice 'and then hitting RETURN to make his selection. Or, he can just type 'the number opposite the choice. The user's choice (a number from 1 to 9) 'is returned to the program in a variable named CH. I've set up four menus 'in various colors (some pretty hideous) to demonstrate the program. 'You can monkey with the colors to your heart's content. ' 'The program makes use of two major routines. The first is a generic 'box drawing routine that can be used to draw a box on the screen anywhere. 'Here I used it to frame the entire screen for the menu. The second 'is the routine that creates the bounce-bar menu. I adapted it for the 'compiler from an interpreter routine by Frank R. Neal, whom I've never 'met but to whom I'm indebted for making me look like a much better 'programmer than I really am. The code here is fully commented. Just 'remember to set up your choices for each menu in the array M$() and tell 'the menu routine how many choices to display by assigning the number 'of choices to the variable NP. Hope you find this useful. ' ' I've also thrown in a demo of a routine that boxes text in any ' color. It's available from the first menu. DECLARE SUB box (r1%, c1%, R2%, c2%, men%) ' Be sure to include these DECLARE SUB rmsg (whichline!, tl$) ' lines at the top of your DECLARE SUB menu (front, back, border) ' program. And of course, you DIM SHARED m$(10), np, ch, yn$ ' must include the subroutines DECLARE SUB yesorno () ' they reference. DECLARE SUB center (whichline, tl$) ' DECLARE SUB box.text (msg$, row%, col%, front, back, ofront, oback) DECLARE SUB hold () Second.title$ = "This is the Second Line of The Menu Title" bottom.msg$ = "This is the bottom line of the Menu Screen" 'Note: the two variables above are for the second line of the menu title 'and the line that goes at the bottom of the menu screen. 'You can substitute anything you want here, or make them part of each 'menu routine as you call the menu. 7 '======= This starts the calling code for Menu No. 1 ======= first.menu: m$(1) = "Go to Menu 2" 'These are the menu choices m$(2) = "Go to Menu 3" 'that will be printed on the screen m$(3) = "Go to Menu 4" m$(5) = "Quit the Demo" m$(4) = "Demo of Boxed Text" np = 5 'This is the total number of choices 'You have a maximum of nine choices COLOR 1, 7, 7 'This sets the overall screen colors CLS CALL box(1, 1, 24, 79, 1) 'Parameters are starting row, starting column, 'ending row and ending column. The last parameter, 'set to 1, puts bars at the top and bottom of the 'box to set off the title and bottom line of a 'menu screen. If you set the last parameter to 'zero, you'll just get a box. CALL center(2, "This is the First Menu Title") 'Prints the first menu title CALL center(3, Second.title$) 'Prints the second menu title CALL center(23, bottom.msg$) 'Bottom line message menu 4, 7, 7 'The parameters are the foreground, background 'and border colors for the menu printing CLS ON ch GOTO second.menu, third.menu, fourth.menu, box.demo, quittin.time '======= This is the end of the first menu call =========== '======= The value of the menu choice is returned in variable CH ====== second.menu: m$(1) = "Go to First Menu" m$(2) = "Go to Third Menu" m$(3) = "Go to the Fourth Menu" m$(4) = "Quit The Demo" np = 4 COLOR 7, 0, 0 CLS CALL box(1, 1, 24, 79, 1) CALL center(2, "This is Menu No. 2") CALL center(3, Second.title$) CALL center(23, bottom.msg$) CALL menu(14, 0, 0) ON ch GOTO first.menu, third.menu, fourth.menu, quittin.time third.menu: m$(1) = "Go to First Menu" m$(2) = "Go to Second Menu" m$(3) = "Go to the Fourth Menu" m$(4) = "Quit The Demo" np = 4 COLOR 7, 4, 4 CLS CALL box(1, 1, 24, 79, 1) CALL center(2, "This is Menu No. 3") CALL center(3, Second.title$) CALL center(23, bottom.msg$) CALL menu(0, 4, 4) ON ch GOTO first.menu, second.menu, fourth.menu, quittin.time fourth.menu: m$(1) = "Go to First Menu" m$(2) = "Go to Second Menu" m$(3) = "Go to the Third Menu" m$(4) = "Quit The Demo" np = 4 COLOR 7, 1, 1 CLS CALL box(1, 1, 24, 79, 1) CALL center(2, "This is Menu No. 4") CALL center(3, Second.title$) CALL center(23, bottom.msg$) CALL menu(6, 1, 1) ON ch GOTO first.menu, second.menu, third.menu, quittin.time quittin.time: COLOR 7, 0, 0: CLS SOUND 1200, 2 CALL rmsg(10, "Do you want to Quit? (Y/N)") yesorno IF yn$ <> "Y" THEN GOTO first.menu END box.demo: 'This is a demo of how to box text COLOR 7, 0, 0 'in any color. For explanation, see the CLS 'remarks in the box.text subprogram box.text "This is some text", 3, 8, 7, 1, 7, 0 box.text "Here's some more text", 7, 15, 4, 1, 7, 0 box.text "And another piece of text", 22, 40, 1, 6, 7, 0 box.text "Here's some more stuff", 12, 33, 15, 13, 7, 0 box.text "Now is the time for all good men", 19, 16, 2, 0, 7, 0 SOUND 1200, 2 COLOR 7, 0 center 25, "Strike the space bar repeatedly to make the boxes disappear." 'The following routines erase the boxes one by one. hold box.text "Now is the time for all good men", 19, 16, 0, 0, 7, 0 hold box.text "Here's some more stuff", 12, 33, 0, 0, 7, 0 hold box.text "And another piece of text", 22, 40, 0, 0, 7, 0 hold box.text "Here's some more text", 7, 15, 0, 0, 7, 0 hold box.text "This is some text", 3, 8, 0, 0, 7, 0 CLS GOTO first.menu END SUB box (r1%, c1%, R2%, c2%, men%) ' DRAW A BOX AT SPECIFIED COORDINATE ' This is a generic routine that can be used to draw a box anywhere. ' r1% is the starting row. c1% is the starting column. ' r2% is the ending row. c2% is the ending column. ' The paramater men%, set to 1, prints horizontal bars ' three rows down from the top of the box and two rows up from the bottom. ' If men% is set to 0, the routine will print a plain box. GLOOP$ = "║" BOXTOP = (c2% - c1%) - 1: BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187): BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188) MIDBOX$ = CHR$(204) + STRING$(BOXTOP, 205) + CHR$(185) LOCATE r1%, c1%: PRINT BOXTOP$; : FOR E1% = r1% + 1 TO R2% - 1: LOCATE E1%, c1%: PRINT GLOOP$; : LOCATE E1%, c2%: PRINT GLOOP$; : NEXT LOCATE R2%, c1%: PRINT BOXBOTTOM$; IF men% > 0 THEN 'Prints optional top and bottom bars in box LOCATE r1% + 3, c1%: PRINT MIDBOX$; LOCATE R2% - 2, c1%: PRINT MIDBOX$; END IF END SUB SUB box.text (tl$, r1%, c1%, fgd, bkg, ofg, obk) ' BOX TEXT AT SPECIFIED COORDINATE 'This routine will box a one-line string of text in the color 'of your choice at the starting coordinate you choose. 'TL$ is the text, r1% is the starting row, c1% is the starting column. 'fgd and bkg are the fore and background colors of the boxed text. 'ofg and obk are the colors to restore after you've boxed the text. GLOOP$ = "║" BOXTOP = LEN(tl$) + 2 BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187): BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188) MIDBOX$ = GLOOP$ + " " + tl$ + " " + GLOOP$ COLOR fgd, bkg LOCATE r1%, c1%: PRINT BOXTOP$; : E1% = r1% + 1: R2% = E1% + 1 LOCATE E1%, c1%: PRINT MIDBOX$; LOCATE R2%, c1%: PRINT BOXBOTTOM$; COLOR ofg, obk 'switch to these text colors after boxing the text END SUB SUB center (whichline, tl$) 'This is a simple routine that centers a string of text TL$ 'on line number WHICHLINE. You can use it anywhere. tl = LEN(tl$) tl = INT((80 - tl) / 2) LOCATE whichline, tl PRINT tl$; END SUB SUB hold WHILE INKEY$ = "": WEND END SUB SUB menu (fgd, BKGD, brdr) 'This is the heart of the program. It's a compiler version of an interpreter 'bounce-bar routine by Frank R. Neal of Columbus, Ohio. I use it in many 'of my program. It returns the user's choice in the variable CH. Note that 'CH must be DIM'ed as a SHARED variable at the beginning of the program. 'The FBD, BKGD and BRDR parameters are the foreground, background and 'border text of the menu printing. COLOR fgd, BKGD, brdr REM REM step1: row = 8: col = 20: ' SET ROW AND COLUMN FOR MENU C1F = fgd: C1B = BKGD' SET COLOR CODES C2F = BKGD: C2B = fgd: ' SET BAR COLOR TO COLOR 0,2 'M$(1) = "ADD A NAME": M$(2) = "UPDATE A NAME": M$(3) = "DELETE A NAME": M$(4) = "FIND A NAME": M$(5) = "FILTER THE LIST": M$(6) = "SORT THE LIST": M$(7) = "PRINT THE LIST": M$(8) = "QUIT THE PROGRAM" 'np = 8: ' step2: GOSUB step3 CLS GOTO menu.end GOTO step1 GOTO step2 ' ' step3: COLOR C1F, C1B: ' CLS CALL center(row, "THE MENU") CALL center(row + 1, "Use <ARROWS> to select <ENTER> to Choose") FOR J = 1 TO 16: X$ = INKEY$: NEXT: ch = 1 LS = 2: FOR J = 1 TO np: IF LEN(m$(J)) > LS THEN LS = LEN(m$(J)) NEXT: ML$ = "## \" + SPACE$(LS - 1) + "\": SL = col + 18 - LEN(ML$) / 2 FOR K = 1 TO np: LOCATE row + 2 + K, SL: PRINT USING ML$; K, m$(K): NEXT step4: LOCATE row + 2 + ch, SL: COLOR C2F, C2B: PRINT USING ML$; ch, m$(ch): COLOR C1F, C1B: TD = ch step5: X$ = INKEY$: IF LEN(X$) THEN KP = ASC(RIGHT$(X$, 1)) ELSE GOTO step5 IF KP = 72 THEN ch = ch - 1: IF ch < 1 THEN ch = np IF KP = 80 THEN ch = ch + 1: IF ch > np THEN ch = 1 IF X$ >= "1" AND X$ <= "9" THEN IF VAL(X$) >= 1 AND VAL(X$) <= np THEN ch = VAL(X$): RETURN IF KP = 13 THEN RETURN IF KP <> 72 AND KP <> 80 THEN KP = KP - 48: IF KP < 1 OR KP > np THEN PRINT CHR$(7): GOTO step5 ELSE ch = KP IF ch = TD THEN GOTO step5 ELSE LOCATE row + 2 + TD, SL: PRINT USING ML$; TD, m$(TD): GOTO step4 menu.end: END SUB SUB rmsg (whichline, tl$) 'This routine also centers a string of text TL$ on line number WHICLINE. 'Unlike the CENTER subroutine, it clears the line before printing the 'centered text. You can use this anywhere, too." tl = LEN(tl$) tl = INT((80 - tl) / 2) LOCATE whichline, 2 PRINT STRING$(77, 32); LOCATE whichline, tl PRINT tl$; END SUB SUB yesorno 'This simple routine gets a "Y" or "N" response to a yes/no question 'and returns it to the caller in variable YN$. Note that YN$ must 'be DIM'ed as a SHARED variable at the beginning of the program. answer.please: yn$ = INKEY$: IF yn$ = "" THEN GOTO answer.please IF INSTR("YyNn", yn$) = 0 THEN GOTO answer.please yn$ = UCASE$(yn$) END SUB 
