' +---------------------------------------------------------------------+ ' | | ' | - B B M e n u . B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | BBmenuQB.Bas was written by Don Smith. | ' | EMail: smithdonb@earthlink.net | ' | Todays date is: 06/16/2007 | ' +---------------------------------------------------------------------+ ' | See SUB BBMenu for complete details | ' | This version of BBMenu.Bas was designed | ' | to be compiled with QuickBASIC 4.5 | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a retired thiry-year teacher | ' | of Math/History/Spanish residing in Orange County, California. I am | ' | also a former 6-year Sergeant of Marines. Who-Rah! On certainforums | ' | I am known as MarineDon. My email is: smithdonb@earthlink.net | ' | | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - COPYING AND DISTIBUTING - | ' +---------------------------------------------------------------------+ ' | Since this code is public domain and freeware, anyone may freely | ' | copy and distribute it. If you use the QuickBasic code in one of | ' | your own programs, you do not have to cite my name as the author, | ' | and you may even change its name. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | | ' | Compile: BC: BBmenuQB.Bas | ' | LINK: BBmenuQB.Bas | ' | LIB: BCom45.Lib | ' +---------------------------------------------------------------------+ DEFINT A-Z DECLARE SUB BBMenu (Menu$(), Row%, Column%, MaxItems%, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, SD%, LenLine%, HotItem%, Selection%, ExitCode%) DECLARE SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) DECLARE SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) REDIM Menu$(1 TO 10) Menu$(1) = "1. Word Processing" Menu$(2) = "2. Private Correspondence" Menu$(3) = "3. Business Letters" Menu$(4) = "-" Menu$(5) = "4. Utilities" Menu$(6) = "5. Graphics" Menu$(7) = "6. Finance" Menu$(8) = "7. Loans" Menu$(9) = "-" Menu$(10) = "8. Quit" Selection = 1 'highlight choice 1 initially begin: COLOR 15, 1: CLS '-----------------Setup for SUB Tinybox----------------- ULRow = 2: ULCol = 20: LRRow = 24: LRCol = 60 BoxFGColr = 15: BoxBGColr = 1: SingOrDoub = 2 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) '-----------------Setup for SUB OneLine------------------ LineRow% = 4: LineCol% = 20: LineFG% = 15 LineBG% = 1: Style% = 4: LenStr% = 40 CALL OneLine(LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) CALL OneLine(11, 20, 15, 1, 4, 40) CALL OneLine(21, 20, 15, 1, 4, 40) '-----------------Setup for SUB BBMenu------------------ Row% = 5: Column% = 30: MaxItems% = 10: FGColr% = 15: BGColr% = 1 HiLiteFG% = 15: HiLiteBG% = 0 LenLine% = 20: HotItem% = 0 SD% = 2 'To make menu single space use SD = 1 LOCATE 3, 30: PRINT "Press TO EXIT" COLOR 11, 1: LOCATE 3, 37: PRINT "Esc" CALL BBMenu(Menu$(), Row%, Column%, MaxItems%, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, SD%, LenLine%, HotItem%, Selection%, ExitCode%) COLOR 15, 1: CLS COLOR FGColr, BGColr LOCATE 8, 25, 0 PRINT "Your selection was:" + STR$(Selection); LOCATE 10, 25, 0 PRINT "The last KEY pressed was ASCII" + STR$(ExitCode); LOCATE 12, 25 PRINT "The menu item was: "; LOCATE 12, 45: COLOR 15, 4 PRINT " " + Menu$(Selection) + " "; COLOR FGColr, BGColr IF ExitCode = 15104 OR ExitCode = 17408 THEN ' LOCATE 14, 25, 0 PRINT "Yeah! You press an KEY."; ELSEIF ExitCode = 27 THEN LOCATE 14, 25, 0 PRINT "You pressed "; END END IF LOCATE 18, 25, 0 PRINT "" DO: LOOP WHILE INKEY$ = "" GOTO begin SUB BBMenu (Menu$(), Row%, Column%, MaxItems%, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, SD%, LenLine%, HotItem%, Selection%, ExitCode%) ' +---------------------------------------------------------------------+ ' | BBmenuQB.Bas was written by Don Smith. | ' | EMail: smithdonb@earthlink.net | ' | Todays date is: 03/25/2002 | ' +---------------------------------------------------------------------+ ' | I got the idea for the Bounce Bar Menu (BBmenuQB.Bas) from an old | ' | basic menu called QBMenu. I downloaded this basic code from one | ' | of the many bulletin boards I used to belong to; that was before | ' | the days of the wide spread use of internet. It was dated 01-17-80.| ' | The author's name wasn't given. I liked the menu's idea but didn't | ' | like the way it was written. I completely rewrote it, retaining | ' | just 11 lines of original code. | ' | | ' | This menu, BBmenuQB.Bas needs no special libraries. The "QB" is | ' | used because of the name of the QBMenu and because it only needs | ' | dear 'ol QuickBASIC. | ' +---------------------------------------------------------------------+ ' | Eventhough it appears that this program is lengthy, the SUB is only | ' | 77 lines of code if REM lines are removed. With the beginning | ' | main program example, and counting all the REM lines, the code | ' | becomes bloated to 317 lines. Please discard what isn't needed. | ' | Of course, REM (or ') lines are not compiled; QuickBASIC ignores | ' | them. | ' +-----------+---------------------------------------------------------+ ' | Menu$() | Menu items are written in the main program section. | ' | | Be sure to REDIM (Example: REDIM Menu$(MaxItems + 1) | ' | | Normally what happens with the BBMenu is that when | ' | | HotItem = 0, the SUB BBMenu reads the extreme left | ' | | character of the menu items. These letters or numbers | ' | | may be used by the user to press. When pressed, the | ' | | SUB will exit with the Selection given as a number. | ' | | Of course, the user may opt to press | ' | | and to choose a menu item. | ' | | | ' | | Example with numbers: | ' | | REDIM MenuTT(MaxItems + 1) | ' | | MenuTT$(1) = "1. Utilities" | ' | | MenuTT$(2) = "2. Graphics" | ' | | Example with letters: | ' | | REDIM MenuGG(MaxItems + 1) | ' | | MenuGG$(1) = "A. Utilities" | ' | | MenuGG$(2) = "B. Graphics" | ' | | | ' | | With BBMenu please do not make the extreme left | ' | | hand character a parathesis. Example: | ' | | | ' | | (THIS IS A NO-NO!) | ' | | MenuHH$ = "(1) Correspondence" | ' | |  NO! | ' | | You may indeed use the above scheme if you turn off | ' | | HotItem, in which case HotItem = 1. | ' | | | ' | | NOTE: Another thing, beginning numbers and letters | ' | | may exist in the same menu. Example: | ' | | | ' | | Menu$(1) = "1. Finance" | ' | | Menu$(1) = "2. To Do List" | ' | | Menu$(1) = "-,20" | ' | | Menu$(1) = "A. Phone Calls" | ' | | Menu$(1) = "B. Letters To Mom" | ' |-----------+---------------------------------------------------------+ ' | Row% | Row to place menu. If you wish the menu to reenter | ' | | always at the top row, then place the Row statement | ' | | after the loop. However, if you desire for the menu to | ' | | reenter at the last hi lighted row, then the Row | ' | | statement has to be placed before loop. Example: | ' | | | ' | | Row% = 6 (Notice Row = 6 comes before "begin:" | ' | | Place before the loop in order that | ' | | menu will reenter at the last | ' | | hi lighted item.) | ' | | begin: | ' | | (Row% = 6) (Place here to always reenter at | ' | | Row 6 - hopefully the top row. | ' | | | ' | | REDIM Menu$(MaxItems + 1) | ' | | Menu$(1) = "1. SpreadSheet" | ' | | Menu$(2) = "2. MS Word" | ' | | . . . . . . . . . . . . . | ' | | | ' | | call BBMenu(Menu$(), Row%, Col%.....(etc.) | ' | | IF Selection% = 1 then | ' | | GOSUB spread | ' | | goto begin | ' | | ELSEIF Selection% = 2 | ' | | GOSUB word | ' | | goto begin | ' | | (Etc.) | ' +-----------+---------------------------------------------------------+ ' | Column% | Column to place menu. | ' +-----------+---------------------------------------------------------+ ' | MaxItems% | The total number of menu items. | ' +-----------+---------------------------------------------------------+ ' | FGColr% | Fore ground color of the menu. | ' +-----------+---------------------------------------------------------+ ' | BGColr% | Back ground color of the menu. | ' +-----------+---------------------------------------------------------+ ' | HiLiteFG% | The fore ground color of the hi lighted items. | ' +-----------+---------------------------------------------------------+ ' | HiLiteBG% | The background color of the hi lighted items. | ' +-----------+---------------------------------------------------------+ ' | SD% | Single space: SD = 1. Double space: SD = 2 | ' +-----------+---------------------------------------------------------+ ' | LenLine% | Gives length of line(s) in menu. Example: M$(3) = "-" | ' +-----------+---------------------------------------------------------+ ' | HotItem% | HotItem% = 0 | ' | | The extreme left character when pressed, will exit with | ' | | the number of that character. It will always be | ' | | reported as a number. Example: A/a = 1. D/d = 4 | ' | +---------------------------------------------------------+ ' | | HotItem% = 1 | ' | | Only may be used. | ' +-----------+---------------------------------------------------------+ ' | Selection%| When a number, letter or is pressed the SUB will| ' | | exit. You may use either numbers, letters or neither | ' | | when you design your menu, but when the SUB exits, the | ' | | Selection is always a number. IMPORTANT! PLEASE READ | ' | | THIS: Each item is numbered and that includes the | ' | | horizontal lines, so keep that in mind when you trap | ' | | after the SUB exits. If you use neither numbers or | ' | | letters, then the SUB will exit when is pressed.| ' | | Example: | ' | | ------- | ' | | Menu$(1) = "1. Word" | ' | | Menu$(2) = "2. Correspondence" | ' | | Menu$(3) = "-" ' <- A line goes here. | ' | | Menu$(4) = "3. Finances" | ' | |  | ' | |  | ' | | (Use this number as Selection number!) | ' | | | ' | | ' "Finances" will be reported as | ' | | ' Selection 4, NOT 3! | ' | | | ' | | CALL BBMenu(Menu$(), Row, Column, (etc) | ' | | 'For next line, see above Menu$(4) = "3. Finances" | ' | | IF Selection = 4 then  | ' | | GOSUB finances Use this number! | ' | | ELSEIF | ' | | (etc) | ' +-----------+---------------------------------------------------------+ ' | ExitCode% | Gives the ASCII number of last key pressed. | ' +-----------+---------------------------------------------------------+ ' | F Keys | See the note about F Keys mid point in the SUB routine. | ' | | +-----------------------------------------------+ | ' | | | Keys per Cvi Code | | ' | | +-----------------------------------------------+ | ' | | | = 15104 = 16128 = 16896 | | ' | | | = 15360 = 16384 = 17152 | | ' | | | = 15616 = 16640 = 17408 | | ' | | | = 15872 | | ' | | +-----------------------------------------------+ | ' | | Extended keys other than keys may be used. | ' | | Example: R is 4864. See key example mid | ' | | point in the SUB. | ' | | | ' | | Write or cut out the short program that follows to find | ' | | out which CVI numbers you need for the BBMenu SUB. | ' +-----------+---------------------------------------------------------+ ' | 'CviCode.Bas | ' | COLOR 15, 1: CLS | ' | LOCATE 3, 22: PRINT "- C V I C o d e P r o g r a m -" | ' | LOCATE 5, 22: PRINT "Press a key or combination of keys." | ' | LOCATE 6, 24, 0: PRINT "Press Or To Exit." | ' | PRINT : PRINT | ' | LOCATE , 30 | ' | DO | ' | DO | ' | T$ = INKEY$ | ' | LOOP UNTIL LEN(T$) > 0 | ' | T = CVI(T$ + CHR$(0)) | ' | IF T > 256 THEN | ' | LOCATE , 24, 0: PRINT "Extended Key" + " = " + STR$(T) | ' | ELSE | ' | LOCATE , 35, 0: PRINT T$ + " = " + STR$(T) | ' | END IF | ' | IF T = 27 OR T = 13 THEN | ' | COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END | ' | END IF | ' | LOOP | ' +---------------------------------------------------------------------+ IF HotItem% = 0 THEN FOR zoom = 1 TO MaxItems HotKey$ = HotKey$ + LEFT$(Menu$(zoom), 1) NEXT END IF HotKey$ = UCASE$(HotKey$) LetrOrNum% = 0 HotKey$ = UCASE$(HotKey$) NumOpts% = MaxItems% IF Selection% = 0 THEN Selection% = 1 FindRow% = Row% FOR MenuChoices% = 1 TO NumOpts% COLOR FGColr%, BGColr% LOCATE FindRow%, Column%, 0 IF Menu$(MenuChoices%) = "-" THEN PRINT STRING$(LenLine%, 196); ELSE PRINT " " + Menu$(MenuChoices%) + " "; END IF FindRow% = Row% + (MenuChoices * SD) NEXT begin.it: DO LOCATE Row% + (Selection% * SD%) - SD%, Column%, 0 COLOR HiLiteFG%, HiLiteBG% PRINT " " + Menu$(Selection%) + " "; IF LetrOrNum% THEN EXIT DO DO DO TouchKey$ = INKEY$ LOOP UNTIL LEN(TouchKey$) > 0 Touch = CVI(TouchKey$ + CHR$(0)) 'Cvi code produced here. ExitCode% = Touch% IF Touch% = 13 OR Touch% = 27 THEN '=13. =27. ExitCode% = Touch% EXIT SUB ' Key Example -> = 15104. = 17408. ELSEIF Touch% = 15104 OR Touch% = 17408 THEN ExitCode% = Touch% EXIT SUB ' = 18432. = 20482. ELSEIF Touch% = 18432 OR Touch% = 20480 THEN GOSUB up.or.down EXIT DO ELSEIF LEN(STR$(LetrOrNum%)) > 0 THEN IF TouchKey$ <> "-" THEN LetrOrNum% = INSTR(HotKey$, UCASE$(TouchKey$)) IF LetrOrNum% <> 0 THEN Selection% = LetrOrNum% EXIT SUB END IF END IF END IF LOOP LOOP up.or.down: LOCATE Row% + (Selection% * SD%) - SD%, Column%, 0 COLOR FGColr%, BGColr% PRINT " " + Menu$(Selection%) + " "; IF Touch% = 18432 THEN ' Selection% = Selection% - 1 IF Selection% = 0 THEN Selection% = NumOpts% IF Menu$(Selection%) = "-" THEN Selection% = Selection% - 1 END IF ELSEIF Touch% = 20480 THEN ' Selection% = Selection% + 1 IF Selection% > NumOpts% THEN Selection% = 1 IF Menu$(Selection%) = "-" THEN Selection% = Selection% + 1 END IF ELSE Selection% = LetrOrNum% END IF RETURN END SUB SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) ' +-------------------------------------------------------------------+ ' | SUB OneLine | ' +-------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB OneLine has 12 lines. | ' +-------------------------------------------------------------------+ ' | SUB OneLine will place one line on screen. There are 4 types | ' | of lines to choose from. See Style% below. | ' +---------------+---------------------------------------------------+ ' | LineRow% | Row to place line. | ' +---------------+---------------------------------------------------+ ' | LineCol% | Column to place line. | ' +---------------+---------------------------------------------------+ ' | LineFG% | Foreground color of line. | ' +---------------+---------------------------------------------------+ ' | LineBG% | Background color of line. | ' +---------------+---------------------------------------------------+ ' | Style% | Style% = 1 ÃÄÄÄ´ | ' | +---------------------------------------------------+ ' | | Style% = 2 ÆÍÍ͵ | ' | +---------------------------------------------------+ ' | | Style% = 3 ÌÍÍ͹ | ' | +---------------------------------------------------+ ' | | Style% = 4 ÇÄÄĶ | ' +---------------+---------------------------------------------------+ ' | LenStr% | Length of string (line). | ' +-------------------------------------------------------------------+ IF Style% = 1 THEN 'ÃÄÄÄ´ SingLine$ = CHR$(195) + STRING$(LenStr%, CHR$(196)) + CHR$(180) ELSEIF Style% = 2 THEN 'ÆÍÍ͵ SingLine$ = CHR$(198) + STRING$(LenStr%, CHR$(205)) + CHR$(181) ELSEIF Style% = 3 THEN 'ÌÍÍ͹ SingLine$ = CHR$(204) + STRING$(LenStr%, CHR$(205)) + CHR$(185) ELSEIF Style% = 4 THEN 'ÇÄÄĶ SingLine$ = CHR$(199) + STRING$(LenStr%, CHR$(196)) + CHR$(182) END IF LOCATE LineRow%, LineCol% COLOR LineFG%, LineBG% PRINT SingLine$; END SUB SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) ' +----------------------------------------------------------------------+ ' | SUB TinyBox | ' +----------------------------------------------------------------------+ ' | ULRow = Upper Left Row. ULCol = Upper Left Column. | ' | LRRow = Lower Right Row. LRCol = Lower Right Column. | ' | BoxFGColr = The Foreground Color The Box. | ' | BoxBGColr = The Back Ground Color Of The Box. | ' | SingOrDoub = 1 (Single Line Box). SingOrDoub = 2 (Double Line Box). | ' +----------------------------------------------------------------------+ COLOR BoxFGColr, BoxBGColr IF SingOrDoub = 1 THEN LOCATE ULRow, ULCol PRINT CHR$(218) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(191); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(179) + STRING$(LRCol - ULCol, " ") + CHR$(179); NEXT LOCATE LRRow, ULCol PRINT CHR$(192) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(217); ELSEIF SingOrDoub = 2 THEN LOCATE ULRow, ULCol PRINT CHR$(201) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(187); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(186) + STRING$(LRCol - ULCol, " ") + CHR$(186); NEXT LOCATE LRRow, ULCol PRINT CHR$(200) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(188); END IF END SUB