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 | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | Author: Donald B. "Don" Smith | ' | Email : smithdonb@earthlink.net | ' | Date: 03/28/2002 | ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a thirty-year retired teacher | ' | of Math/History/Spanish residing in Orange County, California. I | ' | am also a former six-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. | ' +---------------------------------------------------------------------+ ' | CMenu means "Chico Menu". Chico means little or tiny in Spanish. | ' | I first developed this menu while revising PrintDoc.Bas, | ' | on 03/28/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 | ' +---------------------------------------------------------------------+ ' +--------------+------------------------------------------------------+ ' | 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