' +----------------------------------------------------------------------+ ' | | ' | - 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: BBmenuQB.Bas | ' | LINK: BBmenuQB.Bas | ' | LIB: BCom45.Lib | ' | | ' +----------------------------------------------------------------------+ 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) 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 PressKey = ASC(RIGHT$(KeyPress$, 1)) LOCATE Row + Count, Col - 1 COLOR FGColr, BGColr PRINT " " + Menu$(Count) + " "; Selection = 1 IF PressKey = 13 THEN MenuNum = Count ExitCode = 0 EXIT SUB ELSEIF PressKey = 59 THEN ExitCode = PressKey MenuNum = Count EXIT SUB ELSEIF PressKey = 27 THEN COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END END IF IF ASC(RIGHT$(KeyPress$, 1)) = 72 THEN 'DnArrow (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