' +---------------------------------------------------------------------+ ' | | ' | - C h i c M n Q B . B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | ChicMnQB means "Chico Menu". Chico means little or tiny in Spanish.| ' | This version of Chico Menu contains a SUB. The orginal Chico Menu | ' | (ChicMenu.Bas) is not a SUB. ChicMnQB.BAS means Chico menu for | ' | QuickBASIC. All versions of Chico Menu are Public Domain FreeWare. | ' | Author :Don Smith. Today's Date: 03/28/2002. | ' +---------------------------------------------------------------------+ ' | This menu will start at the last position it held. Notice that | ' | Row% is before loopdeloop. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - 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 certain forums| ' | 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 | ' | | ' +---------------------------------------------------------------------+ DECLARE SUB CMenu (M$(), Row%, Col%, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) DECLARE SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) DECLARE SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) Selection% = 1 Row% = 4 loopdeloop: COLOR 15, 1: CLS REDIM M$(10) M$(1) = "1. Print" M$(2) = "2. Change Printer Settings" M$(3) = "3. ReType File Name" M$(4) = "-" M$(5) = "4. Four" M$(6) = "5. Five" M$(7) = "6. Six" M$(8) = "R. Seven" M$(9) = "8. Eight" M$(10) = "9. Nine" '------------------Setup for SUB Tinybox-------------- ULRow = 1 ULCol = 20 LRRow = 24 LRCol = 60 BoxFGColr = 15 BoxBGColr = 1 SingOrDoub = 1 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) '-----------------Setup for SUB OneLine--------------- LineRow% = 10: LineCol% = 20: LineFG% = 15 LineBG% = 1: Style% = 1: LenStr% = 40 CALL OneLine(LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) CALL OneLine(3, 20, 15, 1, 1, 40) '-----------------Setup for SUB CMenu----------------- FGColr% = 15: BGColr% = 1: HiLiteFG% = 15: HiLiteBG% = 0 Col% = 29: MaxItems% = 10: LenLine% = 20: SD% = 2 LOCATE 2, 30: PRINT "Press To Exit"; LOCATE 2, 37: COLOR 11, 1: PRINT "Esc"; CALL TinyBox(17, 44, 23, 64, 15, 1, 2) LOCATE 18, 53: PRINT "MOVE:"; LOCATE 20, 46: PRINT "<> <> "; LOCATE 21, 46: PRINT "Or: Press a Number"; LOCATE 22, 46: PRINT " or a Letter"; CALL OneLine(19, 44, 15, 1, 4, 20) CALL CMenu(M$(), Row%, Col%, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) what.choice: COLOR FGColr%, BGColr%: CLS LOCATE 8, 25, 0 PRINT "Your selection was:" + STR$(Selection%); LOCATE 10, 25, 0 PRINT "The ASCII key pressed was: " + STR$(ExitCode%); LOCATE 12, 25 PRINT "The menu item was: "; LOCATE 12, 45: COLOR 15, 4 PRINT " " + M$(Selection%) + " "; IF ExitCode% = 1 OR ExitCode% = 10 THEN ' LOCATE 14, 25, 0: COLOR 14, 1 PRINT "You press the key!"; ELSEIF ExitCode% = 27 THEN LOCATE 16, 25, 0 COLOR 11, 1 PRINT "You pressed "; END END IF LOCATE 18, 25, 0: COLOR 11, 1 PRINT ""; DO: LOOP WHILE INKEY$ = "" GOTO loopdeloop SUB CMenu (M$(), Row%, Col%, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, MaxItems%, LenLine%, SD%, Selection%, ExitCode%) ' +---------------------------------------------------------------------+ ' | | ' | C h i c o M e n u . B a s | ' | | ' | Public Domain - FreeWare | ' +---------------------------------------------------------------------+ ' | CMenu means "Chico Menu". Chico means little or tiny in Spanish. | ' | I first developed this menu while revising PrintDoc.Bas, | ' | on 03/21/2002. This particular version of Chico Menu is designed | ' | to use QuickBASIC only, with no special libraries needed. | ' | | ' | SUB CMenu will: (1) double space menu items if needed | ' | (2) insert horizontal line(s) in the menu | ' +---------------------------------------------------------------------+ ' | CMenu is a Public Domain FreeWare program by Don Smith, | ' | EMail: smithdonb@earthlink.net | ' | Today's Date: 03/28/2002, | ' +---------------------------------------------------------------------+ ' +--------------+------------------------------------------------------+ ' | M$() | REDIM M$(MaxItem% + 1). REDIM in main program. | ' +--------------+------------------------------------------------------+ ' | Row% | Row to place menu. Set Row% = 1 in main program | ' | | to always hi-light the first item. To allow the | ' | | menu to reenter on last hi-lighted item, place | ' | | Row% above the loop. | ' +--------------+------------------------------------------------------+ ' | Col% | The column to place menu. | ' +--------------+------------------------------------------------------+ ' | FGColr% | The fore ground menu color. | ' +--------------+------------------------------------------------------+ ' | BGColr% | The background menu color. | ' +--------------+------------------------------------------------------+ ' | HiLiteFG% | The fore ground hi light color. | ' +--------------+------------------------------------------------------+ ' | HiLiteBG% | The background hi light color. | ' +--------------+------------------------------------------------------+ ' | MaxItems% | The number of menu items. | ' +--------------+------------------------------------------------------+ ' | LenLine% | Length of horizontal line. Example: M$(4) = "-" | ' +--------------+------------------------------------------------------+ ' | SD% | SD% = 1 (Menu is single spaced) | ' | | SD% = 2 (Menu is double spaced) | ' +--------------+------------------------------------------------------+ ' | Selection% | The Selection is always given as a number. | ' | | IMPORTANT. PLEASE READ -> Every menu item is counted| ' | | as a number, including horizontal lines, so take | ' | | that into consideration when trapping after the | ' | | SUB exits. All selections are counted as a number, | ' | | even letters. Letter E for example would be | ' | | Selection% = 5. If there were a horizontal line | ' | | above E, then Selection% = 6. | ' | | | ' | | SUB CMenu self-reads the extreme left hand | ' | | character of each menu item, allowing the user | ' | | to press that number or letter. | ' | | | ' | | Example: M$(3) = "3. Utilities" | ' | | | ' | | Here, the "3" is the number read. When the user | ' | | presses "3", the SUB exits with Selection% = 3. | ' | | | ' | | Letters also may be used: | ' | | | ' | | Example: M$(3) = "C. Utilities" | ' | | | ' | | Here, the "C" is the letter read. When the user | ' | | presses "C", the SUB with the Selection% = 3. | ' | | | ' | | Selection% = 3 will become Selection% = 4 if | ' | | there exists a horizontal line above M$(3). | ' | | | ' +--------------+------------------------------------------------------+ ' | ExitCode% | ExitCode% is the last key pressed. is | ' | | ExitCode% = 27 and is ExitCode% = 13. | ' | | If an key were pressed, then ExitCode% should | ' | | be renamed as ExitCode% = 1 for , and | ' | | ExitCode% = 10 for . See explanation | ' | | below. | ' +--------------+------------------------------------------------------+ FOR Jefe% = 1 TO MaxItems% HotKey$ = HotKey$ + LEFT$(RTRIM$(LTRIM$(M$(Jefe%))), 1) NEXT LetrOrNum% = 0 HotKey$ = UCASE$(HotKey$) IF Selection% = 0 THEN Selection% = 1 FindRow% = Row% FOR xyz% = 1 TO MaxItems% COLOR FGColr%, BGColr% LOCATE FindRow%, Col%, 0 IF LEFT$(M$(xyz%), 1) = "-" THEN PRINT STRING$(LenLine%, CHR$(196)); ELSE PRINT " " + M$(xyz%) + " "; END IF FindRow% = Row% + (xyz% * SD%) NEXT DO LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 COLOR HiLiteFG%, HiLiteBG% PRINT " " + M$(Selection%) + " "; DO K$ = INKEY$ LOOP UNTIL LEN(K$) > 0 K% = CVI(K$ + CHR$(0)) IF K% = 13 THEN ExitCode% = 13 EXIT SUB ELSEIF K% = 27 THEN 'Press and exit ExitCode% = 27 EXIT SUB 'K% = 27 K% = 122 is last letter, or "z". ELSEIF K% > 27 AND K% < 123 THEN IF K$ <> "-" THEN LetrOrNum% = INSTR(HotKey$, UCASE$(K$)) IF LetrOrNum% <> 0 THEN OldSelection% = Selection% LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 COLOR FGColr%, BGColr% PRINT " " + M$(Selection%) + " "; Selection% = LetrOrNum% LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 COLOR HiLiteFG%, HiLiteBG% PRINT " " + M$(Selection%) + " "; ' 'Selection% = LetrOrNum% ' ExitCode% = K% EXIT SUB END IF END IF ELSEIF K% = 20480 THEN ' GOSUB up.or.down ELSEIF K% = 18432 THEN ' GOSUB up.or.down ELSEIF K% = 16128 THEN ' ' To use other keys, use the numbers below: ' = 15104. = 15360. = 15616. = 15872. ' = 16128. = 16384. = 16640. = 16896. ' = 17152. = 17408. 'Use availibility of ExitCode% to rename = 1 and = 10 ExitCode% = 5 'F5> EXIT SUB ELSEIF K% = 17408 THEN ' ExitCode% = 10 EXIT SUB END IF LOOP up.or.down: LOCATE Row% + (Selection% * SD%) - SD%, Col%, 0 COLOR FGColr%, BGColr% PRINT " " + M$(Selection%) + " "; IF K% = 18432 THEN ' Selection% = Selection% - 1 IF Selection% = 0 THEN Selection% = MaxItems% IF M$(Selection%) = "-" THEN Selection% = Selection% - 1 END IF ELSEIF K% = 20480 THEN ' Selection% = Selection% + 1 IF Selection% > MaxItems% THEN Selection% = 1 IF M$(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