' +----------------------------------------------------------------------+ ' | | ' | - S m a l M e n u . B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' +----------------------------------------------------------------------+ ' +----------------------------------------------------------------------+ ' | - 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. | ' +----------------------------------------------------------------------+ ' +----------------------------------------------------------------------+ ' | SmalMenu.Bas | ' +----------------------------------------------------------------------+ ' | Created on 03/11/2002 by Don Smith. There is only one SUB called | ' | SmalMenu. This SUB is the same as TinyMenu with all lines removed | ' | which are not absolutely essential. For example, FKeys$ is removed.| ' +----------------------------------------------------------------------+ ' +----------------------------------------------------------------------+ ' | | ' | Compile: BC: SmalMenu.Bas | ' | LINK: SmalMenu | ' | LIB: BCom45 | ' | | ' +----------------------------------------------------------------------+ DEFINT A-Z DECLARE SUB SmalMenu (Menu$(), Title$, Selection, Row, Col, MaxItems, FGColr, BGColr, FGHiLite, BGHiLite, MenuNum, ExitCode) DECLARE SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) DECLARE SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) begin: COLOR 15, 1: CLS '--------------------Setup for SUB TinyBox----------------- ULRow = 2: ULCol = 20: LRRow = 21: LRCol = 60 BoxFGColr = 15: BoxBGColr = 1: SingOrDoub = 1 CALL TinyBox(ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) '--------------------Setup for SUB OneLine----------------- LineRow% = 4: LineCol% = 20: LineFG% = 15 LineBG% = 1: Style% = 1: LenStr% = 40 CALL OneLine(LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) CALL OneLine(17, 20, 15, 1, 1, 40) CALL OneLine(19, 20, 15, 1, 1, 40) '--------------------Setup for SUB SmalMenu---------------- Title$ = "Main Menu": FGColr = 15: BGColr = 1: FGHiLite = 15 BGHiLite = 0: MaxItems = 10: Row = 5: Col = 32 REDIM Menu$(MaxItems + 1) Menu$(1) = "Word Processing" Menu$(2) = "Private Letters" Menu$(3) = "Past Due Bills" Menu$(4) = "Address Book" Menu$(5) = "Utilities" Menu$(6) = "Finance" Menu$(7) = "Communications" Menu$(8) = "Windows 3.1" Menu$(9) = "SpreadSheet" Menu$(10) = "Exit to DOS" LOCATE 18, 25: PRINT "Press To View Selection"; LOCATE 20, 31: PRINT "Press to Exit"; COLOR 11, 1 LOCATE 18, 32: PRINT "Enter"; : LOCATE 20, 38: PRINT "Esc"; COLOR 15, 1 CALL SmalMenu(Menu$(), Title$, Selection, Row, Col, MaxItems, FGColr, BGColr, FGHiLite, BGHiLite, MenuNum, ExitCode) COLOR 15, 2: CLS IF MenuNum < MaxItems + 1 AND ExitCode = 0 THEN LOCATE 6, 21: PRINT "The Selection Was - Number " + RTRIM$(LTRIM$(STR$(MenuNum))) + "." LOCATE 9, 21: PRINT "The Menu Item Was - " + CHR$(34) + Menu$(MenuNum) + CHR$(34) + "." LOCATE 20, 16: PRINT "Press To Return, Or Press To Exit." END IF IF ExitCode = -59 THEN 'F1 pressed LOCATE 6, 20: PRINT "The ExitCode Was " + STR$(ExitCode) LOCATE 8, 20: PRINT " Was Pressed." LOCATE 10, 20: PRINT "Press To Return Or To Exit" END IF DO K$ = INKEY$ IF K$ = CHR$(13) THEN Selection = MenuNum GOTO begin ELSEIF K$ = CHR$(27) THEN COLOR 7, 0: CLS : END END IF LOOP 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 SmalMenu (Menu$(), Title$, Selection, Row, Col, MaxItems, FGColr, BGColr, FGHiLite, BGHiLite, MenuNum, ExitCode) ' +-------------------------------------------------------------------+ ' | SUB SmalMenu | ' +-------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB SmalMenu has 56 lines. | ' +-------------------------------------------------------------------+ ' | SUB SmalMenu will place on screen a small menu with the choice | ' | made by the programmer as to foreground and background colors, | ' | the high light foreground and background colors, the row and | ' | column to place menu, number of menu items, the total number of | ' | menu items and a unique Exitcode which traps other keys such | ' | as . | ' +---------------+---------------------------------------------------+ ' | Title$ | Name of title | ' +---------------+---------------------------------------------------+ ' | Selection | Starts of menu at the selected number | ' +---------------+---------------------------------------------------+ ' | Row | Row to place menu | ' +---------------+---------------------------------------------------+ ' | Col | Column to place menu | ' +---------------+---------------------------------------------------+ ' | MaxItems | Number of menu items | ' +---------------+---------------------------------------------------+ ' | FGColr | Foreground color of menu items | ' +---------------+---------------------------------------------------+ ' | BGColr | Background color of menu items | ' +---------------+---------------------------------------------------+ ' | FGHiLite | Foreground color of high lighted menu item | ' +---------------+---------------------------------------------------+ ' | BGHiLite | Background color of high lighted menu item | ' +---------------+---------------------------------------------------+ ' | MenuNum | The number of the menu item selected by user | ' +---------------+---------------------------------------------------+ ' | ExitCode | The SmalMenu exits with a special number for | ' | | designated special keys such as | ' +---------------+---------------------------------------------------+ ' | PressKey Routine: | ' +-------------------------------------------------------------------+ ' | | ' | 'Use they following short code to determined the numbers of | ' | 'special keys your want to trap, such as , , etc. | ' | | ' | CLS | ' | PRINT "Press any key on keyboard" | ' | PRINT "-------------------------" | ' | DO | ' | DO | ' | KeyPress$ = INKEY$ | ' | LOOP UNTIL LEN(KeyPress$) | ' | IF ASC(KeyPress$) = 0 THEN | ' | PressKey = -ASC(RIGHT$(KeyPress$, 1)) | ' | ELSE | ' | PressKey = ASC(KeyPress$) | ' | END IF | ' | IF PressKey = 27 THEN 'ESC Pressed | ' | PRINT "-------------------------" | ' | PRINT SPACE$(9) + "End" | ' | END | ' | ELSE | ' | PRINT "PressKey = "; PressKey | ' | END IF | ' | LOOP | ' +-------------------------------------------------------------------+ IF Selection = 0 THEN Selection = 1 END IF part1: GOSUB part2 GOSUB part3 part2: GOSUB part5 'Adjust LOCATE to match your location of Title$ LOCATE Row - 2, Col + 2: PRINT Title$ FOR Count = 1 TO MaxItems LOCATE Row + Count, Col PRINT Menu$(Count); NEXT RETURN part3: FOR Count = Selection TO MaxItems LOCATE Row + Count, Col - 1 COLOR FGHiLite, BGHiLite PRINT " " + Menu$(Count) + " "; DO KeyPress$ = INKEY$ LOOP UNTIL LEN(KeyPress$) > 0 IF ASC(KeyPress$) = 0 THEN PressKey = -ASC(RIGHT$(KeyPress$, 1)) ELSE PressKey = ASC(KeyPress$) END IF LOCATE Row + Count, Col - 1 COLOR FGColr, BGColr PRINT " " + Menu$(Count) + " "; Selection = 1 IF PressKey = 13 THEN ' key pressed MenuNum = Count ' MenuNum = Count sets the menu number ExitCode = 0 ' each time to reenter menu at last position EXIT SUB ELSEIF PressKey = -59 THEN ' pressed. Use the "PressKey ExitCode = PressKey ' Routine" above to determine any MenuNum = Count ' special keys you wish to employ. EXIT SUB ELSEIF PressKey = 27 THEN ' key pressed COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END END IF IF ASC(RIGHT$(KeyPress$, 1)) = 72 THEN 'Down Arrow (72) IF Count > 1 THEN Count = Count - 2 GOTO part4 ELSE Count = MaxItems - 1 GOTO part4 END IF END IF part4: NEXT GOTO part3 part5: MenuNum = Count - 1 IF Count = MaxItems THEN RETURN END IF Count = Count - 1 RETURN 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