' +------------------------[ MagMenu4.Bas ]----------------------------+ ' | | ' | M a g i c M e n u S y s t e m | ' | -------------------------------- | ' | | ' | (Public Domain FreeWare - 12/01/2002) | ' | | ' | Magmenu4.Bas requires the Pro.Lib library for compiling. | ' | See Full Moon Software below for more info on Pro.Lib. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | | ' | M a g i c M e n u S y s t e m | ' | -------------------------------- | ' | | ' | (Public Domain FreeWare - 12/01/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. | ' +--------------------------------------------------------------------+ ' | MagMenu1.Bas, MagMenu2.Bas, MagMenu3.Bas and MagMenu4.Bas all | ' | demo a menu system similar to the QBasic editor. The first | ' | three programs may be compiled using BCom45.Lib or BRun45.Lib of | ' | QuickBASIC 4.5. The last program, MagMenu4.Bas, employs the use | ' | of the Pro.Lib library of Crecent Software. See Full Moon Software | ' | just below: | ' +--------------------------------------------------------------------+ ' | Full Moon Software: | ' | ------------------ | ' | Magmenu1.Bas, Magmenu2.Bas, Magmenu3.Bas are all compiled as | ' | regular QB45 programs. Magmenu4.Bas, however, requires the use | ' | of the Pro.Lib from the Full Moon Software of Ethan Winer. | ' | - - - - - - - - - - - - - - - | ' | I often use three toolboxes originally from Crescent Software. | ' | They are: QuickPak, PDQ and QuickScreen. Crescent Software was | ' | sold to Progress Software. The original owner/programmer of | ' | Crescent Software, Ethen Winer, took back the MS-DOS toolboxes | ' | so that they still would be available to MS-DOS programmers. He | ' | now operates Full Moon Software. These three toolboxes have | ' | hundreds of routines. Using their included libraries instead of | ' | BRUN45.Lib or BCOM45.Lib and utilizing their assembly written | ' | routines, makes for an extremely tight, executable program very | ' | close to the tiny size and speed of an assembly language program. | ' | For example, this program in its executable form, MagMenu4.Exe, | ' | is only 31 kilobytes. I especially enjoy using the QuickScreen | ' | program, Qscr.Exe, whick makes short work of converting a "BSaved" | ' | (.BSV) file into a linkable.OBJ file. | ' | | ' | Ethan Winer's internet site: | ' | --------------------------- | ' | http://www.ehtanwiner.com | ' | | ' | Ethan Winer's Mailing Address: | ' | ------------------------------ | ' | FULL MOON SOFTWARE | ' | 34 Cedar Vale Drive | ' | New Milford, CT 06776 | ' | | ' | (Voice) 860-350-8188 | ' | (Fax) 860-350-6130 | ' | (Email) ethan@ethanwiner.com | ' | | ' +--------------------------------------------------------------------+ ' | The MagicMenu System is an exceptionally complete menu program, | ' | written in QuickBASIC (v4.5), which allows the programmer a | ' | systematic way to install a professional looking menu system. | ' | It is similar in appearance to the QuickBASIC editor, but the | ' | programmer may change the color values and menu item names. | ' | These 4 demo programs replicate the QuickBASIC 4.5 editor | ' | showing different color schemes. | ' +--------------------------------------------------------------------+ ' | The Magic Menu Program and its four SUBs were written by me, | ' | Don Smith, on 12/01/2002. MagMenu4.Bas, SUB HorizMenu, | ' | SUB RoyalMenu, SUB BoxBoy and SUB OneLine are Public Domain | ' | Freeware. Anyone may use them and alter them as they see fit. | ' | There is no need to name me as the author. I leave that up to | ' | you as a fellow programmer. | ' | | ' | The help window information is contained in an accompanying | ' | ASCII text file called MagMenu.Hlp. The information on how | ' | to modify the help file is at the top of MagMenu.Hlp. Use an | ' | ASCII text editor to type in your own comments. If no such | ' | editor is available, use your own word processor, and when | ' | you save MagMenu.Hlp, use: "SAVE AS..." and select ASCII (.txt) | ' | or Text (.txt) or similar words. As a matter of fact, you may | ' | use the QuickBASIC editor to modify your help file. Just make | ' | sure to save it: SAVE AS... and select: (.) Text Readable by | ' | Other Programs | ' | | ' | Each SUB has complete comments on how to use them. Press . | ' +--------------------------------------------------------------------+ ' | While pressing brings up the help screen, pressing | ' | pops up a special window. Currently, it holds information about | ' | me and the Magic Menu Program. You probably will want to alter | ' | the window contents. To do so, go to line 655 and modify the | ' | 9 lines of text. | ' +--------------------------------------------------------------------+ ' | To remove or modify the "U.S.Marine Corps" of the opening screen, | ' | go to lines 679 to 691. To modify the two boxes of the opening | ' | screen, go to lines 344 and 345. | ' +--------------------------------------------------------------------+ ' | There are two interactive menu SUBs: | ' | (1) SUB HorizMenu and (2) SUB RoyalMenu | ' | | ' | (1) SUB HorizMenu: | ' | ----------------- | ' | The HorizMenu is the top bar horizontal menu. Pressing | ' | will exit the entire program and return to the command prompt. | ' | If or are pressed, the hi-light menu | ' | items moves right or left accordingly. Once or | ' | are pressed, the vertical menu drops down. What | ' | actually happens is that the program exits HorizMenu and enters | ' | RoyalMenu, the vertical menu. | ' | | ' | (2) SUB RoyalMenu: | ' | ----------------- | ' | RoyalMenu is a vertical menu just below the HorizMenu. Just | ' | above RoyalMenu, the HorizMenu item is hi-lighted. If | ' | is pressed, the underlying screen is restored, RoyalMenu is | ' | rolled back, and control goes back to HorizMenu. If or are pressed, the current RoyalMenu | ' | exits and another RoyalMenu immediately forms to the right | ' | or left according to which was pressed. | ' | | ' | RoyalMenu is set so that action occurs if , | ' | , , or are pressed. Pressing | ' | or moves the block cursor up or | ' | down. If is pressed, a small screen appears naming | ' | the menu number and selection. The programmer should delect | ' | this and use the menu and selection numbers to branch to other | ' | subroutines (See/read lines 516 to 542). If is pressed | ' | the help screen appears. To discover how to use the help | ' | screen, read the information at the top of the file: MagMenu.Hlp. | ' | If is pressed, an informational screen about the Magic Menu | ' | System appears. The programmer should retype this with his own | ' | pertinent data, or delete this section altogether (lines 680 | ' | to 703. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | COMPILE INFORMATION: | ' +--------------------------------------------------------------------+ ' | BC: MagMenu4.Bas | ' | | ' | LINK: MagMenu4 | ' | LIB: PRO | ' | | ' +--------------------------------------------------------------------+ tippy.top: '$DYNAMIC DEFINT A-Z DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColr%, BoxColr%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) DECLARE SUB HorizMenu (MenuItem$(), Row%(), Col%(), MaxItems%, Items%, TempItems%, SpotColr%, TopColr%, TopHiLite%, TypeOfKey$, Hit%) DECLARE SUB OneLine (LineRow%, LineCol%, LineColr%, Style%, LenStr%) DECLARE SUB RoyalMenu (M$(), MenNum%, RoyalRow%, RoyalCol%, SpotLetrs$, SpotColr%, FKeys$, Colr%, HiLite%, MaxMenuItems%, Selection%, MenuLine%, ExitCode%) DECLARE FUNCTION Exist% (FileName$) '----------------------Set up for SUB RoyalMenu----------------------- REDIM M$(1 TO 9, 1 TO 15) M$(1, 1) = "New Program" M$(1, 2) = "Open Program" M$(1, 3) = "Merge..." M$(1, 4) = "Save" M$(1, 5) = "Save As..." M$(1, 6) = "Save All" M$(1, 7) = "-" M$(1, 8) = "Create File..." M$(1, 9) = "Load File..." M$(1, 10) = "Unload File..." M$(1, 11) = "-" M$(1, 12) = "Print..." M$(1, 13) = "DOS Shell" M$(1, 14) = "-" M$(1, 15) = "Exit" M$(2, 1) = "Undo Alt+Backspace" M$(2, 2) = "Cut Shift+Del" M$(2, 3) = "Copy Ctrl+Ins" M$(2, 4) = "Paste Shift+Ins" M$(2, 5) = "Clear Del" M$(2, 6) = "-" M$(2, 7) = "New SUB..." M$(2, 8) = "New FUNCTION..." M$(3, 1) = "SUBs... F2" M$(3, 2) = "Next SUB Shift+F2" M$(3, 3) = "Split" M$(3, 4) = "-" M$(3, 5) = "Next Statement" M$(3, 6) = "Output Screen F4" M$(3, 7) = "-" M$(3, 8) = "Included File" M$(3, 9) = "Included Lines" M$(4, 1) = "Find..." M$(4, 2) = "Selected Text Ctrl+\" M$(4, 3) = "Repeat Last Find F3" M$(4, 4) = "Change..." M$(4, 5) = "Label..." M$(5, 1) = "Start Shift+F5" M$(5, 2) = "Restart" M$(5, 3) = "Continue F5" M$(5, 4) = "Modify COMMAND$" M$(5, 5) = "-" M$(5, 6) = "Make EXE File..." M$(5, 7) = "Make Library..." M$(5, 8) = "-" M$(5, 9) = "Set Main Module..." M$(6, 1) = "Add Watch..." M$(6, 2) = "Instant Watch... Shift+F9" M$(6, 3) = "Watchpoint..." M$(6, 4) = "Delete Watch..." M$(6, 5) = "Delete All Watch" M$(6, 6) = "-" M$(6, 7) = "Trace On" M$(6, 8) = "-" M$(6, 9) = "Toggle Breakpoint F9" M$(6, 10) = "Clear All Breakpoints" M$(6, 11) = "Break on Errors" M$(6, 12) = "Set Next Statement" M$(7, 1) = "Untitled" M$(8, 1) = "Display..." M$(8, 2) = "Set Paths..." M$(8, 3) = "Right Mouse..." M$(8, 4) = "Syntax Checking" M$(8, 5) = "Full Menus" M$(9, 1) = "Index" M$(9, 2) = "Contents" M$(9, 3) = "Topic F1" M$(9, 4) = "Help on Help Shift+F1" '+------------------------------------------------------------------+ '| THE COLORS | '+------------------+-----------------------------------------------+ HelpColr% = 79 '| Help screen color - bright white on red | '-------------------+-----------------------------------------------+ HelpAccent% = 75 '| Help screen accent color - light blue on red | '-------------------+-----------------------------------------------+ TopColr% = 112 '| Top band HorizMenu color - black on | '| dim white | '-------------------+-----------------------------------------------+ TopHiLite% = 7 '| Top band HiLight HorizMenu color - | '| light white on black | '-------------------+-----------------------------------------------+ Colr% = 112 '| RoyalMenu item color - black on dim white | '-------------------+-----------------------------------------------+ HiLite% = 7 '| RoyalMenu HiLight color - bright white | '| on black | '-------------------+-----------------------------------------------+ SpotColr% = 15 '| Spot Color for both HorizMenu & RoyalMenu - | '| bright white | '-------------------+-----------------------------------------------+ BottColr% = 63 '| Bottom band info color - | '| bright white on light green | '-------------------+-----------------------------------------------+ BottAccent% = 62 '| Bottom band accent color - | '| yellow on light green | '------------------'+-----------------------------------------------+ ClearScrnFG% = 15 '| Clear screen color - bright white on blue | ClearScrnBG% = 1 '| | '------------------'+-----------------------------------------------+ F10Colr% = 95 '| Info color - bright white | '| on purple | '------------------'+-----------------------------------------------+ F10Accent% = 91 '| Accent color - yellow on purple | '-------------------+-----------------------------------------------+ '----------------------Set up for SUB HorizMenu----------------------- Items% = 1 make.horiz.menu: MaxItems% = 9 TypeOfKey$ = "FEVSRDCOH" REDIM Row%(MaxItems%) REDIM Col%(MaxItems%) REDIM MenuItem$(MaxItems%) Row%(1) = 1 Col%(1) = 3 MenuItem$(1) = " File " Row%(2) = 1 Col%(2) = 9 MenuItem$(2) = " Edit " Row%(3) = 1 Col%(3) = 15 MenuItem$(3) = " View " Row%(4) = 1 Col%(4) = 21 MenuItem$(4) = " Search " Row%(5) = 1 Col%(5) = 29 MenuItem$(5) = " Run " Row%(6) = 1 Col%(6) = 34 MenuItem$(6) = " Debug " Row%(7) = 1 Col%(7) = 41 MenuItem$(7) = " Calls " Row%(8) = 1 Col%(8) = 48 MenuItem$(8) = " Options " Row%(9) = 1 Col%(9) = 73 MenuItem$(9) = " Help " TempItems% = 1 '-------next 5 lines paint screen with US MARINE CORPS-------- COLOR ClearScrnFG%, ClearScrnBG%: CLS CALL Box0(2, 2, 23, 79, 2, 31) CALL Box0(3, 3, 22, 78, 2, 25) GOSUB smith.plumbing: 'Paint top line with a band of color LOCATE 1, 1: CALL MQPrint(SPACE$(80), TopColr%) 'Paint bottom line with info LOCATE 25, 1: CALL MQPrint(SPACE$(80), BottColr%) LOCATE 25, 9 CALL MQPrint("Press To Access Help Window. Press For Special Info.", BottColr%) LOCATE 25, 16: CALL MQPrint("F1", BottAccent%) LOCATE 25, 52, 0, 0, 0: CALL MQPrint("F10", BottAccent%) horiz.menu: CALL HorizMenu(MenuItem$(), Row%(), Col%(), MaxItems%, Items%, TempItems%, SpotColr%, TopColr%, TopHiLite%, TypeOfKey$, Hit%) IF Hit% = 27 THEN ' pressed to exit GOTO leave ELSEIF Hit% = 1 THEN ' pressed GOSUB paint.top MenNum% = Items% GOSUB bring.help GOTO horiz.menu ELSEIF Hit% = 10 THEN ' pressed GOSUB paint.top MenNum% = Items% GOSUB f10.key GOTO horiz.menu END IF 'MenNum% is used by RoyalMenu and Items% is used 'to set up SpotLetrs$ and MaxItems% for RoyalMenu MenNum% = VAL(CHR$(Hit%)) Items% = MenNum% make.royal.menu: 'Items% = 1-9 below will set up SpotLetrs% and MaxItems% for RoyalMenu IF MenNum% = 1 THEN SpotLetrs$ = "NOMSAV-CLU-PD-x" MaxMenuItems% = 15 ELSEIF MenNum% = 2 THEN SpotLetrs$ = "+++P+-SF" MaxMenuItems% = 8 ELSEIF MenNum% = 3 THEN SpotLetrs$ = "SEP-Nu-+L" MaxMenuItems% = 9 ELSEIF MenNum% = 4 THEN SpotLetrs$ = "FSRCL" MaxMenuItems% = 5 ELSEIF MenNum% = 5 THEN SpotLetrs$ = "SRnC-XL-M" MaxMenuItems% = 9 ELSEIF MenNum% = 6 THEN SpotLetrs$ = "AIW++-TH-BCE+" MaxMenuItems% = 12 ELSEIF MenNum% = 7 THEN SpotLetrs$ = "u" MaxMenuItems% = 1 ELSEIF MenNum% = 8 THEN SpotLetrs$ = "DPMSF" MaxMenuItems% = 5 ELSEIF MenNum% = 9 THEN SpotLetrs$ = "IC+H" MaxMenuItems% = 4 END IF 'Next 8 lines determine the longest length of menu items for block cursor MaxLen% = 0 FOR APlus% = 1 TO MaxMenuItems% Battle% = LEN(M$(MenNum%, APlus%)) IF Battle% > MaxLen% THEN MaxLen% = Battle% END IF NEXT MaxLen% = MaxLen% + 2 'next 5 lines for SUB RoyalMenu RoyalRow% = Row%(MenNum%) + 2 RoyalCol% = Col%(MenNum%) MenuLine% = 0 FKeys$ = "10" Selection% = 1 'next 16 lines for: SUBs SaveRestScrn and BoxBoy ULRow% = RoyalRow% - 1 ULCol% = RoyalCol% - 1 LRRow% = ULRow% + MaxMenuItems% + 1 IF RoyalCol% + MaxLen% + 3 > 80 THEN ULCol% = 80 - 3 - MaxLen% LRCol% = ULCol% + MaxLen% RoyalCol% = ULCol% + 1 ELSE LRCol% = ULCol% + MaxLen% END IF BoxStyle% = 1 BoxColr% = 112 ShadowColr% = 8 'Shadow% = 1 'Do not deploy these here because the Pro.Lib is 'EdgeYN% = 0 'being used '----------------------------------------------------------------- ' GOSUB paint.top & GOSUB unpaint.top '----------------------------------------------------------------- ' Once HorizMenu exits, then the program displays RoyalMenu. In ' RoyalMenu, when the or is pressed, ' the program continually exits and reenters RoyalMenu, displaying ' the menu to the left or right according to which was ' pressed (See ExitCode% = 11 or ExitCode% = 12 below). This ' action means that the top band, previously running under ' HorizMenu, is no longer under the the control of HorizMenu. ' Therefore, there is a need for GOSUB paint.top and GOSUB ' unpaint.top GOSUB paint.top REDIM ReadArray%(2500) CALL ScrnSave0(ULRow% - 1, ULCol%, LRRow% + 1, LRCol% + 3, SEG ReadArray%(0)) CALL PaintBox0(ULRow% + 1, ULCol% + 2, LRRow% + 1, LRCol% + 3, ShadowColr%) CALL ClearScr0(ULRow%, ULCol%, LRRow%, LRCol% + 1, 112) CALL Box0(ULRow%, ULCol%, LRRow%, LRCol% + 1, BoxStyle%, BoxColr%) royal.menu: CALL RoyalMenu(M$(), MenNum%, RoyalRow%, RoyalCol%, SpotLetrs$, SpotColr%, FKeys$, Colr%, HiLite%, MaxMenuItems%, Selection%, MenuLine%, ExitCode%) IF ExitCode% = 27 THEN ' Items% = MenNum% Selection% = 0 GOTO make.horiz.menu: ELSEIF ExitCode% = 11 THEN ' 'restore screen - next 2 lines CALL ScrnRest0(ULRow% - 1, ULCol%, LRRow% + 1, LRCol% + 3, SEG ReadArray%(0)) ERASE ReadArray% GOSUB unpaint.top MenNum% = MenNum% + 1 'get next menu to the right IF MenNum% > MaxItems% THEN 'MaxItems% from HorizMenu MenNum% = 1 END IF Items% = MenNum% GOTO make.royal.menu 'recall RoyalMenu for new menu ELSEIF ExitCode% = 12 THEN ' 'restore screen - next 2 lines CALL ScrnRest0(ULRow% - 1, ULCol%, LRRow% + 1, LRCol% + 3, SEG ReadArray%(0)) ERASE ReadArray% GOSUB unpaint.top MenNum% = MenNum% - 1 'get next menu to the left IF MenNum% = 0 THEN 'if menu 1, then goto menu 9 MenNum% = MaxItems% 'MaxItems% from HorizMenu END IF Items% = MenNum% GOTO make.royal.menu 'recall RoyalMenu for new menu ELSEIF ExitCode% > 12 AND ExitCode% < 123 THEN 'all ASCII from 12-122 ' +----------------------------------------------------------------+ ' | BRANCH TO YOUR CODE HERE -> | ' +----------------------------------------------------------------+ ' | For your program, REM (') out or delete the 23 lines of code | ' | immediately below this section. Then you will need to make | ' | a series of IF/ELSEIF/END IF statements to branch to your code.| ' | See EXAMPLE just below: | ' +----------------------------------------------------------------+ ' | EXAMPLE : IF MenNum% = 1 THEN | ' | If Selection% = 1 THEN | ' | CALL SaveRestScrn(....,1) 1 saves screen | ' | GOSUB goose.feathers (your code) | ' | Call SaveRestScrn(....,2) 2 restores | ' | GOTO Royal.menu | ' | ELSEIF Selection% 2 THEN | ' | 'etc | ' | 'More Selections% here, etc. | ' | END IF | ' | ELSEIF MenNum% = 2 THEN | ' | IF Selection% = 1 THEN | ' | 'blah-blah-blah | ' | END IF | ' | END IF | ' +----------------------------------------------------------------+ ' | REM (') out or delete the next 23 lines in favor of your own | ' | code. | ' +----------------------------------------------------------------+ REDIM ReadTheArray%(2500) CALL ScrnSave0(1, 1, 25, 80, SEG ReadTheArray%(0)) CALL PaintBox0(12, 12, 16, 70, 8) CALL ClearScr0(11, 10, 15, 68, HelpColr%) CALL Box0(11, 11, 15, 67, 2, HelpColr%) LOCATE 12, 16: CALL MQPrint("Your Pick Was Selection Number" + STR$(Selection%) + " Of Menu Number" + STR$(MenNum%) + " ", HelpColr%) LOCATE 13, 13 CALL OneLine(13, 11, HelpColr%, 3, 55) LOCATE 14, 18 CALL MQPrint("Press To Return Or Press To Quit", HelpColr%) LOCATE 14, 25: CALL MQPrint("Enter", HelpAccent%) LOCATE 14, 52: CALL MQPrint("Esc", HelpAccent%) DO Exit$ = INKEY$ IF Exit$ = CHR$(27) THEN ' GOTO leave ELSEIF Exit$ = CHR$(13) THEN ' CALL ScrnRest0(1, 1, 25, 80, SEG ReadTheArray%(0)) ERASE ReadTheArray% GOTO royal.menu END IF LOOP GOTO leave ELSEIF ExitCode% = 1 THEN ' pressed GOSUB bring.help GOTO royal.menu ELSEIF ExitCode% = 10 THEN ' pressed GOSUB f10.key GOTO royal.menu END IF paint.top: 'retains top item's hi-lighted color ' paint.top and unpaint.top are used to hilite or unhilite ' the top bar when or under ' RoyalMenu are pressed. LOCATE 1, Col%(Items%) CALL MQPrint(MenuItem$(Items%), TopHiLite%) LOCATE 1, Col%(Items%) + 1 CALL MQPrint(LEFT$(RTRIM$(LTRIM$(MenuItem$(Items%))), 1), SpotColr%) RETURN unpaint.top: 'returns top item to previous color LOCATE 1, Col%(Items%) CALL MQPrint(MenuItem$(Items%), TopColr%) LOCATE 1, Col%(Items%) + 1 SpotDiv16% = TopColr% \ 16 HitSpotNow% = (SpotColr% AND 16) * 8 + ((SpotDiv16% AND 7) * 16) + (SpotColr% AND 15) CALL MQPrint(LEFT$(RTRIM$(LTRIM$(MenuItem$(Items%))), 1), HitSpotNow%) RETURN leave: COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END bring.help: REDIM RLineArray%(2500) CALL ScrnSave0(1, 1, 25, 80, SEG RLineArray%(0)) IF MenNum% < 10 THEN MZero$ = "0" END IF IF Selection% < 10 THEN SZero$ = "0" END IF IF Selection% = 0 THEN M$ = "MENU #" + MZero$ + RTRIM$(LTRIM$(STR$(MenNum%))) ELSE M$ = "MENU #" + MZero$ + RTRIM$(LTRIM$(STR$(MenNum%))) + " AND " END IF M1$ = "MENU #" + RTRIM$(LTRIM$(STR$(MenNum%))) S$ = "SELECTION #" + SZero$ + RTRIM$(LTRIM$(STR$(Selection%))) IF Selection% = 0 THEN S1$ = "" Info$ = M$ ELSE S1$ = "SELECTION #" + RTRIM$(LTRIM$(STR$(Selection%))) Info$ = M$ + S$ END IF IF Selection% = 0 THEN HelpScrn$ = M1$ ELSE HelpScrn$ = M1$ + " AND " + S1$ END IF REDIM Help$(4) 'REDIM to a higher number if more than 4 lines '"MagMenu.Hlp" may be changed to another name ItsThere% = Exist%("MagMenu.Hlp") IF ItsThere% = 0 THEN REDIM NoMMArray%(2500) CALL ScrnSave0(1, 1, 25, 80, SEG NoMMArray%(0)) ErrMM% = 1 GOSUB errorscreen ErrMM% = 0 CALL ScrnRest0(1, 1, 25, 80, SEG NoMMArray%(0)) ERASE NoMMArray% RETURN END IF OPEN "MagMenu.Hlp" FOR INPUT AS #1 DO LINE INPUT #1, HelpLine$ IF HelpLine$ <> "'" THEN IF HelpLine$ = Info$ THEN FOR Four% = 1 TO 4 Hlp% = Hlp% + 1 LINE INPUT #1, HelpLine$ IF HelpLine$ = "+" THEN EXIT DO END IF Help$(Hlp%) = HelpLine$ NEXT END IF END IF LOOP UNTIL EOF(1) CLOSE #1 GOSUB help.screen ERASE Help$: Hlp% = 0 CALL ScrnRest0(1, 1, 25, 80, SEG RLineArray%(0)) ERASE RLineArray% SZero$ = "" RETURN help.screen: CALL PaintBox0(8, 11, 17, 73, 8) CALL ClearScr0(7, 9, 16, 71, HelpColr%) CALL Box0(7, 10, 16, 70, 2, HelpColr%) CALL OneLine(9, 10, HelpColr%, 4, 59) LOCATE 8, 33: CALL MQPrint("- HELP WINDOW -", HelpAccent%) HelpCol% = 26 'adjust HelpCol% to be centered in help window FOR SeeHelp% = 1 TO 4 LOCATE SeeHelp% + 9, HelpCol% CALL MQPrint(UCASE$(Help$(SeeHelp%)), HelpColr%) NEXT CALL OneLine(14, 10, HelpColr%, 4, 59) LOCATE 15, 27 CALL MQPrint("", HelpColr%) LOCATE 15, 28 CALL MQPrint("Press Any Key To Continue", HelpAccent%) DO: LOOP WHILE INKEY$ = "" RETURN f10.key: REDIM F10Array%(2500) CALL ScrnSave0(1, 1, 25, 80, SEG F10Array%(0)) 'CALL BoxBoy("", 6, 10, 19, 70, 1, 15, 4, F10Colr%, 2, 1, 7, 1) CALL PaintBox0(7, 11, 20, 73, 8) CALL ClearScr0(6, 9, 19, 71, F10Colr%) CALL Box0(6, 10, 19, 70, 2, F10Colr%) CALL OneLine(8, 10, F10Colr%, 4, 59) LOCATE 7, 24: CALL MQPrint("SPECIAL INFORMATION TO PROGRAMMERS:", F10Accent%) LOCATE 9, 17: CALL MQPrint("The MagicMenu System was written by Don Smith on", F10Colr%) LOCATE 10, 17: CALL MQPrint("10/01/2002. You may alter the source code in any", F10Colr%) LOCATE 11, 17: CALL MQPrint("fashion you see fit. All parts of the MagicMenu", F10Colr%) LOCATE 12, 17: CALL MQPrint("System, including its three SUBs, are Public Domain", F10Colr%) LOCATE 13, 17: CALL MQPrint("FreeWare. You need not give my name as author.", F10Colr%) LOCATE 14, 17: CALL MQPrint("You may even change the name of the program. ", F10Colr%) CALL OneLine(15, 10, F10Colr%, 4, 59) LOCATE 16, 26: CALL MQPrint("EMail: smithdonb@earthlink.net", F10Accent% + 3) CALL OneLine(17, 10, F10Colr%, 4, 59) LOCATE 18, 27: CALL MQPrint("", F10Accent%) DO: LOOP WHILE INKEY$ = "" CALL ScrnRest0(1, 1, 25, 80, SEG F10Array%(0)) ERASE F10Array% RETURN smith.plumbing: LOCATE 6, 5: CALL MQPrint("ÖÄ¿ ÖÄ¿ ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄÄÄ¿ ÖÄÄÄÄÄÄ¿ ÖÄÄÄÄÄÄ¿ ÖÄÄÄ¿ ÖÄÄÄÄ¿ÖÄ¿ ÖÄÄÄÄÄ¿", 28) LOCATE 7, 5: CALL MQPrint("º ³ º ³ º ÕÍÍ; º Õ» Õ» ³ º ÕÍÍ» ³ º ÕÍÍ» ³ È» Õ¾ º Õ» ³º ³ º ÕÍÍ;", 31) LOCATE 8, 5: CALL MQPrint("º ³ º ³ º ÀÄÄÄ¿ º ³º ³º ³ º ÀÄĽ ³ º ÀÄĽ ³ º ³ º ³º ³º ³ º ÀÄ¿ ", 25) LOCATE 9, 5: CALL MQPrint("º ³ º ³ ÈÍÍÍ» ³ º ³È;º ³ º ÕÍÍ» ³ º ÕÍ» Õ¾ º ³ º ³º ³º ³ º Õ; ", 31) LOCATE 10, 5: CALL MQPrint("º ÀĽ ³ ÖÄÄĽ ³ º ³ º ³ º ³ º ³ º ³ º À¿ Ö½ À¿ º ³º À½ ³ º ÀÄÄÄ¿", 31) LOCATE 11, 5: CALL MQPrint("ÈÍÍÍÍ; ÈÍÍÍÍ; È; È; È; È; È; ÈÍ; ÈÍÍ; È;ÈÍÍÍ; ÈÍÍÍÍ;", 31) LOCATE 13, 20: CALL MQPrint("ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄÄ¿ ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄ¿", 28) LOCATE 14, 20: CALL MQPrint("º ÕÍ» ³ º ÕÍ» ³ º ÕÍÍ» ³ º ÕÍ» ³ º ÕÍÍ;", 31) LOCATE 15, 20: CALL MQPrint("º ³ È; º ³ º ³ º ÀÄĽ ³ º ÀĽ ³ º ÀÄÄÄ¿", 25) LOCATE 16, 20: CALL MQPrint("º ³ ÖÄ¿ º ³ º ³ º ÕÍ» Õ¾ º ÕÍÍ; ÈÍÍÍ» ³", 31) LOCATE 17, 20: CALL MQPrint("º ÀĽ ³ º ÀĽ ³ º ³ º À¿ º ³ ÖÄÄĽ ³", 31) LOCATE 18, 20: CALL MQPrint("ÈÍÍÍÍ; ÈÍÍÍÍ; È; ÈÍ; È; ÈÍÍÍÍ;", 31) RETURN errorscreen: Title$ = "" ULRow% = 7 ULCol% = 10 LRRow% = 14 LRCol% = 70 TitleRow% = 1 TitleCol% = 1 TitColr% = 78 BoxColr% = 79 BoxStyle% = 2 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 1 CALL BoxBoy(Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColr%, BoxColr%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) 'CALL BoxBoy("", 7, 10, 14, 70, 7, 36, 14, 4, 15, 4, 2, 1, 7, 1) COLOR 14, 4: LOCATE 8, 34 PRINT "<<>>"; : COLOR 15, 4 IF ErrMM% = 1 THEN E$ = "Unable to find: MagMenu.Hlp" LOCATE 8, 52: PRINT "(Error #53)"; ELSEIF ErrMM% = 0 THEN LOCATE 8, 52: PRINT "(Error #" + RTRIM$(LTRIM$(STR$(ERR))) + ")"; END IF 'CALL OneLine(9, 11, 15, 4, 4, 60) LineRow% = 9 LineCol% = 11 LineColr% = 79 Style% = 4 LenStr% = 60 CALL OneLine(LineRow%, LineCol%, LineColr%, Style%, LenStr%) COLOR 15, 4 LOCATE 10, 17: PRINT "Error description is:"; COLOR 11, 4 LOCATE 11, 30: PRINT E$; COLOR 15, 4 'CALL OneLine(12, 11, 15, 4, 4, 60) LineRow% = 12 LineCol% = 11 LineColr% = 79 Style% = 4 LenStr% = 60 CALL OneLine(LineRow%, LineCol%, LineColr%, Style%, LenStr%) LOCATE 13, 25: PRINT ""; GOSUB make.noise DO: LOOP WHILE INKEY$ = "" RETURN errorhandler: COLOR 15, 1: CLS GOSUB error.codes GOSUB errorscreen GOSUB make.noise DO: LOOP WHILE INKEY$ = "" END error.codes: IF ERR = 4 THEN E$ = "Out of data." ELSEIF ERR = 5 THEN E$ = "Illegal function call." ELSEIF ERR = 7 THEN E$ = "Out of memory." ELSEIF ERR = 9 THEN E$ = "Subscript out of range." ELSEIF ERR = 14 THEN E$ = "Out of string space." ELSEIF ERR = 16 THEN E$ = "String formula too complex." ELSEIF ERR = 25 THEN E$ = "Device fault" ELSEIF ERR = 27 THEN E$ = "Out of paper" ELSEIF ERR = 52 THEN E$ = "Bad file number." ELSEIF ERR = 53 THEN E$ = "File not found." ELSEIF ERR = 54 THEN E$ = "Bad file mode." ELSEIF ERR = 55 THEN E$ = "File already open." ELSEIF ERR = 57 THEN E$ = "Device In/Out error." ELSEIF ERR = 58 THEN E$ = "File/Path already exists." ELSEIF ERR = 61 THEN E$ = "Disk full." ELSEIF ERR = 62 THEN E$ = "Input past end." ELSEIF ERR = 64 THEN E$ = "Bad file name." ELSEIF ERR = 67 THEN E$ = "Too many lines." ELSEIF ERR = 68 THEN E$ = "Device unavailable." ELSEIF ERR = 70 THEN E$ = "Permission denied." ELSEIF ERR = 71 THEN E$ = "Disk not ready." ELSEIF ERR = 72 THEN E$ = "Disk media error." ELSEIF ERR = 75 THEN E$ = "Bad File/Path access." ELSEIF ERR = 76 THEN E$ = "Path not found." ELSEIF ERR = 77 THEN E$ = "Invalid drive specs." ELSEIF ERR = 79 THEN E$ = "Bad FAT table area." ELSEIF ERR = 80 THEN E$ = "Invalid time data." ELSEIF ERR = 81 THEN E$ = "Invalid time data." ELSEIF ERR = 82 THEN E$ = "Invalid parameter." ELSEIF ERR = 83 THEN E$ = "Buffer too small." ELSEIF ERR = 84 THEN E$ = "Current directory renamed." ELSEIF ERR = 85 THEN E$ = "Lock conflict." ELSEIF ERR = 86 THEN E$ = "Sharing conflict" ELSEIF ERR = 87 THEN E$ = "Read-only conflict." ELSEIF ERR = 100 THEN E$ = "Insufficient elements." ELSEIF ERR = 125 THEN E$ = "Overflow" ELSEIF ERR = 126 THEN E$ = "Out of stack space." ELSEIF ERR = 127 THEN E$ = "Undefined error." ELSE E$ = "Unspecified error." END IF RETURN make.noise: Melody = 100: Throat = 0 DO Throat = Throat + 1 FOR Melody = 600 TO 1000 STEP 300 SOUND Melody, Melody / 1000 NEXT FOR Melody = 1000 TO 600 STEP -150 SOUND Melody, Melody / 1000 NEXT LOOP UNTIL Throat = 2 RETURN REM $STATIC SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColr%, BoxColr%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) ' +--------------------------------------------------------------------+ ' | | ' | SUB BoxBoy | ' | | ' +--------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB BoxBoy has 121 lines. | ' +--------------------------------------------------------------------+ ' | Version 1.0 of SUB BoxBoy was written by Don Smith on 03/25/2002. | ' | This is Version 2.0 and it was written on 10/01/2002. Both | ' | versions are declared Public Domain FreeWare. Other programmers | ' | may use this SUB without naming me as the author, and they may | ' | modify the code in any way they see fit. | ' | | ' | Don's EMail: smithdonb@earthlink.net | ' | | ' | This SUB only saves that portion of the underlying screen under | ' | the box and repaints with a shadow. So recommend using the SUB | ' | SaveRestScrn to save/restore the complete screen, or a larger | ' | portion of the screen than the box. | ' +-------------+------------------------------------------------------+ ' | Title$ | The title of the menu. To make a box without a title,| ' | | use: Title$ = "". When there is no Title, the cross | ' | | bar is not deployed. | ' +-------------+------------------------------------------------------+ ' | ULRow% | The upper left row to place the box. | ' +-------------+------------------------------------------------------+ ' | ULCol% | The upper left column to place the box. | ' +-------------+------------------------------------------------------+ ' | LRRow% | The lower right row to place the box. | ' +-------------+------------------------------------------------------+ ' | LRCol% | The lower right column to place the box. | ' +-------------+----------------------------------+-------------------+ ' | TitleRow% | The row to place the title. | If Title$ = "" | ' +-------------+----------------------------------| (or NO title), | ' | TitleCol% | The column to place the title. | report these four | ' +-------------+----------------------------------| values as zero (0)| ' | TitColr% | The title color (one number) | . . . . . . . . | ' +-------------+----------------------------------| Example -> | ' | TitColrFG% = 0 | ' +-------------+----------------------------------+-------------------+ ' | BoxColr% | The color of the box itselt (one number). | ' +-------------+------------------------------------------------------+ ' | BoxStyle% | BoxStyle% = 0 (No line around box) | ' | | BoxStyle% = 1 (Single line around box | ' | | BoxStyle% = 2 (Double line around box | ' +-------------+------------------------------------------------------+ ' | Shadow% | If Shadow% equals 0, there will be no shadow. | ' | | If Shadow% equals 1, there will be a right shadow. | ' | | If Shadow% equals 2, there will be a left shadow | ' | +------------------------------------------------------+ ' | | NOTE #1: | ' | | ------- | ' | | When a shadow is used, the underlying text will | ' | | be saved and printed with the ShadeColr% (just | ' | | below). This causes the shadow to look like a | ' | | real shadow. | ' | | | ' | | NOTE #2: | ' | | ------- | ' | | If the first four values of BoxBoy are 1, 1, 25, 80, | ' | | in other words a full screen, please set Shadow% = 0;| ' | | otherwise an error will result (no room for shadow). | ' +-------------+------------------------------------------------------+ ' | ShadowColr% | The ShadowColr% is the foreground color of the | ' | | shadow. The background color will always be | ' | | black. Either choose ShadowColr% = 7 or | ' | | ShadowColr% = 8. | ' | | | ' | | ShadowColr% = 7 saves the foreground color and | ' | | changes it to a shade darker, if possible. For | ' | | example, a bright white on blue (COLOR 15, 1) | ' | | becomes dim white on black (COLOR 7, 0). A bright | ' | | blue on blue (COLOR 9, 1) becomes regular blue | ' | | on black (COLOR 1, 0). Very realistic. | ' | | | ' | | ShadowColr% = 8 saves the foreground and reprints | ' | | it as COLOR 8, 0. Darker then ShadowColr% = 7 | ' +-------------+----------------+-------------------------------------+ ' | EdgeYN% | EdgeYN% = 0 | Do NOT print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | EdgeYN% = 1 | YES, DO print an edge of one space | ' | | | with BoxColrFG% color on the right | ' | | | and left edges of the box. | ' | +----------------+-------------------------------------+ ' | | What does it mean to "print an edge of one space | ' | | with BoxColrFG% color on the right and left edges | ' | | of the box". Well, I will attempt to demonstrate | ' | | by drawing the boxes with non-extended ASCII | ' | | characters. The X's represent a shadow to the | ' | | right. | ' | | | ' | | NO EDGE RIGHT/LEFT 1 SPACE EDGE RIGHT/LEFT | ' | | ~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~ | ' | | (EdgeYN% = 0) (EdgeYN% = 1 | ' | | | ' | | +-----------------+ +-------------------+ | ' | | |+---------------+| | +---------------+ | | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | || ||XX | | | |XX | ' | | |+---------------+|XX | +---------------+ |XX | ' | | +-----------------+XX +-------------------+XX | ' | | XXXXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXXXXXX | ' | | | ' +-------------+------------------------------------------------------+ IF ULCol% <= 1 THEN ULCol% = 1 END IF IF LRCol% = 80 THEN IF Shadow% > 0 THEN LRCol% = 78 ELSEIF Shadow% = 0 THEN LRCol% = 79 END IF END IF make.box: IF BoxStyle% = 0 THEN 'No Lines ULCorner$ = CHR$(255) URCorner$ = CHR$(255) HorLine$ = CHR$(255) LeftSide$ = CHR$(255) RightSide$ = CHR$(255) VertLine$ = CHR$(255) LLCorner$ = CHR$(255) LRCorner$ = CHR$(255) ELSEIF BoxStyle% = 1 THEN 'Single Line ULCorner$ = CHR$(218) URCorner$ = CHR$(191) HorLine$ = CHR$(196) LeftSide$ = CHR$(195) RightSide$ = CHR$(180) VertLine$ = CHR$(179) LLCorner$ = CHR$(192) LRCorner$ = CHR$(217) ELSEIF BoxStyle% = 2 THEN 'Double Line ULCorner$ = CHR$(201) URCorner$ = CHR$(187) HorLine$ = CHR$(205) LeftSide$ = CHR$(199) RightSide$ = CHR$(182) VertLine$ = CHR$(186) LLCorner$ = CHR$(200) LRCorner$ = CHR$(188) END IF IF Shadow% > 0 THEN IF EdgeYN% = 1 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 5 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% END IF ELSEIF EdgeYN% = 0 THEN IF Shadow% = 1 THEN LeftLimit% = ULCol% + 2 RightLimit% = LRCol% + 3 ELSEIF Shadow% = 2 THEN LeftLimit% = ULCol% - 2 RightLimit% = LRCol% - 1 END IF END IF REDIM ReadLine$(25): REDIM ReadColr%(25, 80) FOR ViewIt% = ULRow% + 1 TO LRRow% + 1 FOR Horizon% = LeftLimit% TO RightLimit% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT FOR FindRow% = ULRow% + 1 TO LRRow% + 1 FOR ScrnCol% = LeftLimit% TO RightLimit% LOCATE FindRow%, ScrnCol%, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 'make colors less bright IF FGScrnColr% = 0 THEN FGScrnColr% = 7 IF FGScrnColr% = 9 THEN FGScrnColr% = 1 IF FGScrnColr% = 10 THEN FGScrnColr% = 2 IF FGScrnColr% = 11 THEN FGScrnColr% = 3 IF FGScrnColr% = 12 THEN FGScrnColr% = 4 IF FGScrnColr% = 13 THEN FGScrnColr% = 5 IF FGScrnColr% = 14 THEN FGScrnColr% = 7 IF FGScrnColr% = 15 THEN FGScrnColr% = 7 BGScrnColr% = OneColr% \ 16 IF ShadowColr% = 7 THEN FSC% = FGScrnColr% ELSEIF ShadowColr% = 8 THEN FSC% = 8 END IF IF Shadow% = 1 THEN CALL MQPrint(MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% + 1)), FSC%) ELSEIF Shadow% = 2 THEN CALL MQPrint(MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% - 3)), FSC%) END IF NEXT NEXT ERASE ReadLine$: ERASE ReadColr% END IF IF EdgeYN% = 1 THEN Edge$ = " " END IF Title.Length% = LEN(Title$) 'COLOR BoxColrFG%, BoxColrBG% 'ÚÄÄÄ¿ or ÉÍÍÍ» LOCATE ULRow%, ULCol% CALL MQPrint(Edge$ + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + Edge$, BoxColr%) '³ ³ or º º LOCATE ULRow% + 1, ULCol% CALL MQPrint(Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$, BoxColr%) IF Title$ <> "" THEN 'ÃÄÄÄ´ or ÇÄÄĶ 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol% CALL MQPrint(Edge$ + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + Edge$, BoxColr%) ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol% CALL MQPrint(Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$, BoxColr%) END IF '³ ³ or º º FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol% CALL MQPrint(Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$, BoxColr%) NEXT 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol%, 0 CALL MQPrint(Edge$ + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + Edge$, BoxColr%) IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol% 'COLOR TitColrFG%, TitColrBG% CALL MQPrint(Title$, TitColr%) END IF END SUB SUB HorizMenu (MenuItem$(), Row%(), Col%(), MaxItems%, Items%, TempItems%, SpotColr%, TopColr%, TopHiLite%, TypeOfKey$, Hit%) ' +------------------------------------------------------------------+ ' | SUB HorizMenu | ' +------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB HorizMenu has 65 lines. | ' +------------------------------------------------------------------+ ' | HorizMen.Bas written by Don Smith on 10/01/2002; HorizMen.Bas is | ' | Public Domain FreeWare. HorizMen.Bas will present a horizontal | ' | menu and hi-light the horizontal menu items as the | ' | or keys are pressed. The row and column are given | ' | as part of the set up. There is no need to name Don as | ' | the author. | ' +------------------------------------------------------------------+ ' | | ' | EMail: smithdonb@earthlink.net | ' | | ' +------------+-----------------------------------------------------+ ' | MenuItem$()| Menu items to display horizontally. These menu | ' | | items, together with the row/column need to be | ' | | REDIMmed in the main module: | ' | | | ' | | Example -->>> REDIM Row%(MaxItems%) | ' | | REDIM Col%(MaxItems%) | ' | | REDIM Item$(MaxItems%) | ' | | | ' | | Please be aware that the first letter of each | ' | | menu item will be hi-lighted with SpotColr%. | ' | | It would be best to list menu items which have | ' | | different first letters so that, in the case | ' | | that a letter is pressed, there will only one | ' | | letter to consider. | ' +------------+------------------------------+----------------------+-+ ' | Row%() | Row of menu item. Each menu | Row% & Col% Example: | ' | | item needs row and column.->| ------------------- | ' +------------+----------------------------+-+ Row%(1) = 1 | ' | Col%() | Colunn of menu item. Each | Col%(1) = 5 | ' | | menu item needs row/column | MenuItem$(1) = " File "| ' +------------+------------------------------+ | ' | MaxItems% | Total number of menu items | Row%(2) = 1 | ' +------------+------------------------------+ Col%(2) = 16 | ' | Items% | The menu item selected. | MenuItem$(2) = " Text "| ' +------------+------------------------------+----------------------+-+ ' | TempItems% | Temporary menu item. SUB needs this to convey | ' | | a previous menu item. | ' +------------+-----------------------------------------------------+ ' | SpotColr% | The foreground color with which to hi-light | ' | | letters/numbers so designated by TypeOfKey$. | ' | | This SpotColr% will function both for the | ' | | regular menu color, and when the menu item is | ' | | hi-lighted. If the regular menu color is | ' | | COLOR 0, 7 and the SpotColr% is 15, then the | ' | | first letter of the menu item will be COLOR 15, 7. | ' +------------+-----------------------------------------------------+ ' | TopColr% | Color of menu items as one number. | ' +------------+-----------------------------------------------------+ ' | TopHiLite% | Color of hi-lighted menu item as one number. | ' +------------+-----------------------------------------------------+ ' | TypeOfKey$ | Numbers or letters that the SUB will respond to. | ' | | Example: TypeOfKey$ = "FEVSR" The SUB will | ' | | jump to the correct menu item upon pressing | ' | | "F-E-V-S-R". Also, the appropriate TypeOfKey$ | ' | | letter will be hi-lighted; these TypeOfKey$ | ' | | letters should be the first letter of each | ' | | menu item. Refer to MenuItem$ above. | ' | | . . . . . . . . . . . . . . . . | ' | | If TypeOfKey$ = "" then, when a key "F-E-V-S-R" | ' | | is pressed, nothing will happen. | ' +------------+-----------------------------------------------------+ ' | Hit% | The CVI number of a key pressed. If the key | ' | | pressed is an ASCII key, then CVI will report the | ' | | ASCII number. If the key pressed is an extended | ' | | key like , the number will be a unique CVI | ' | | number. The HorizMenu SUB will exit if , a | ' | | , a or is pressed. The | ' | | or must have been so stipulated | ' | | in TypeOfLetrs$. If another letter/number not so | ' | | stipulated is pressed, it will be ignored. The | ' | | Hit% number or Items% number may be used upon | ' | | exiting the SUB. | ' | | | ' | | +---------------------------------+ | ' | | | CVI Number | | ' | | +----------------+----------------+ | ' | | | Key Pressed: | ASCII Number: | | ' | | +----------------+----------------+ | ' | | | .........|....27 | | ' | | | .......|....13 | | ' | | | Numbers 0-9...|....48 - 57 | | ' | | | Letters A-Z...|....65 - 90 | | ' | | | Letters a-z...|....97 - 122 | | ' | | +----------------+----------------+ | ' | | | ' | | Since the above Hit% 0-9 numbers are ASCII | ' | | numbers, to change them to regular numericals, | ' | | use: | ' | | MenNum% = ASC(CHR$(Hit%)) | ' | | | ' | | Extended CVI numbers: | ' | | -------------------- | ' | | Hit% = 15104 is the key. | ' | | Hit% = 17408 is the key | ' | | | ' | | To find other values for Hit%, like , | ' | | refer to KeyCode.Bas just below. This short | ' | | program allows QuickBASIC programmers the ability | ' | | to trap every key on the keyboard. The basic | ' | | ingredient is the CVI command. To use this | ' | | command, make 2 DO/LOOPs and a series of IF, | ' | | ELSEIF and END IFs. Example -> | ' | | | ' | | DO | ' | | DO | ' | | Hit$ = INKEY$ | ' | | LOOP UNTIL LEN(Hit$) > 0 | ' | | Hit% = CVI(Hit$ + CHR$(0)) '<- CVI made here! | ' | | IF Hit% = 27 THEN ' pressed | ' | | END | ' | | ELSEIF Hit% = 13 THEN ' pressed | ' | | GOSUB date.info | ' | | ELSEIF Hit% = 15104 THEN ' pressed | ' | | GOSUB F1.Info | ' | | END IF | ' | | LOOP | ' +------------+-----------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | Use KeyCode.Bas below to find out what the CVI numbers will be | ' | for keys you wish to trap. | ' +--------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' Date: 09/01/2002. | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' +--------------------------------------------------------------------+ ' | | ' | COLOR 14, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "-----------------------------------------------------" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ TempItems% = Items% FOR Items% = 1 TO MaxItems% GOSUB paint.regular NEXT Items% = TempItems% DO GOSUB paint.hi.lite DO Hit$ = INKEY$ LOOP UNTIL LEN(Hit$) > 0 Hit% = CVI(Hit$ + CHR$(0)) GOSUB paint.regular IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB ELSEIF Hit% > 47 AND Hit% < 123 THEN '0-9 & A-Z TypeOfKey$ = UCASE$(TypeOfKey$) IF TypeOfKey$ <> "" THEN Burst% = INSTR(TypeOfKey$, RTRIM$(LTRIM$(UCASE$(CHR$(Hit%))))) Hit% = Burst% + 48 TempItems% = Items% GOSUB paint.regular EXIT SUB END IF ELSEIF Hit% = 13 OR Hit% = 20480 THEN ' Hit% = Items% + 48 TempItems% = Items% GOSUB paint.hi.lite EXIT SUB ELSEIF Hit% = 19200 THEN ' Items% = Items% - 1 IF Items% < 1 THEN Items% = MaxItems% END IF ELSEIF Hit% = 19712 OR Hit% = 9 THEN ' / Items% = Items% + 1 IF Items% > MaxItems% THEN Items% = 1 END IF ELSEIF Hit% = 15104 THEN ' Hit% = 1 EXIT SUB ELSEIF Hit% = 17408 THEN ' Hit% = 10 EXIT SUB END IF LOOP paint.hi.lite: ColrNow% = TopHiLite% SpotColrBG% = TopHiLite% \ 16 GOSUB paint.menu.items RETURN paint.regular: ColrNow% = TopColr% SpotColrBG% = TopColr% \ 16 GOSUB paint.menu.items RETURN paint.menu.items: LOCATE Row%(Items%), Col%(Items%), 0 CALL MQPrint(MenuItem$(Items%), ColrNow%) FrstLetr$ = LEFT$(RTRIM$(LTRIM$(MenuItem$(Items%))), 1) SpotNow% = (SpotColr% AND 16) * 8 + ((SpotColrBG% AND 7) * 16) + (SpotColr% AND 15) LOCATE Row%(Items%), Col%(Items%) + 1, 0 CALL MQPrint(FrstLetr$, SpotNow%) RETURN END SUB SUB OneLine (LineRow%, LineCol%, LineColr%, 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. | ' +---------------+---------------------------------------------------+ ' | LineColr% | Color of the line (one number). | ' +---------------+---------------------------------------------------+ ' | 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% CALL MQPrint(SingLine$, LineColr%) END SUB SUB RoyalMenu (M$(), MenNum%, RoyalRow%, RoyalCol%, SpotLetrs$, SpotColr%, FKeys$, Colr%, HiLite%, MaxItems%, Selection%, MenuLine%, ExitCode%) ' +---------------------------------------------------------------------+ ' | SUB RoyalMenu | ' +---------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB RoyalMenu has 134 lines. | ' +---------------------------------------------------------------------+ ' | RoyalMenu menu is a regular vertical menu and is able to draw | ' | horizontal lines which the block cursor will jump up or down. | ' | RoyalMenu will hi-light designated letters of a menu item. | ' +---------------------------------------------------------------------+ ' | SUB RoyalMenu is a Public Domain FreeWare program by Don Smith. | ' | There is no need to name Don as the author. | ' | EMail: smithdonb@earthlink.net Today's Date: 10/01/2002 | ' +---------------------------------------------------------------------+ ' +--------------+------------------------------------------------------+ ' | M$() | If there is only one menu, then set up the menu | ' | | items as M$(1), etc., and if there are 10 menu | ' | | items, then REDIM M$(10) in the main module. | ' | | | ' | | As there are nine different menus here running | ' | | under MagicMenu.Bas then each menu item will need | ' | | a double array. Example: M$(2, 3). The "2" is | ' | | the menu number, and the "3" is the item selected. | ' | | If there are 9 menus, and up to 15 menu items, | ' | | then REDIM M$(9, 15) in the main module. | ' | | | ' | | To force the menu to skip a line and also to | ' | | print a line, use M$(2, 3) = "-" . | ' | | | ' | | Remember that the skipped line ("-") also counts | ' | | as a menu item number. | ' | | | ' | | Example: M$(1, 1) = "Word Processing" | ' | | M$(1, 2) = "Spread Sheet" | ' | | M$(1, 3) = "-" (<-draw line here) | ' | | M$(1, 4) = "Private Letters" | ' | | | ' | | In the above example, "Private Letters" is | ' | | menu 1 and item 4, NOT item 3. | ' +--------------+------------------------------------------------------+ ' | RoyalRow% | Row to place menu. Set Row% = 1 in main program | ' | | to begin at the first item. | ' +--------------+------------------------------------------------------+ ' | RoyalCol% | The column to place menu. | ' +--------------+------------------------------------------------------+ ' | SpotLetrs$ | A string that stipulates which letters/numbers in | ' | | a menu to hi-light with the SpotColr% color. | ' | | | ' | | Example: SpotLetrs$ = "BrT-++US-x" | ' | | ---------------------------------- | ' | | Please use both upper and lower case | ' | | letters to imulate particular letters | ' | | of a menu item. Numbers may also be used. | ' | | | ' | | A dash (-) indicates a line to skip. | ' | | A plus (+) indicates to NOT hi-light | ' | | a menu item. If it so happens that a | ' | | particular menu item has plus (+) in | ' | | it already, then switch to a dot (.). | ' | | Example: SpotLetrs$ = "SOr-w..F-ex" | ' | | When a designated letter is pressed, | ' | | the block cursor will jump to the | ' | | appropriate row and hi-light the | ' | | menu item. | ' +--------------+------------------------------------------------------+ ' | SpotColr% | The foreground color (0-15) with which to hi-light | ' | | a menu letter or number which has been set by | ' | | SpotLetrs$. | ' +--------------+------------------------------------------------------+ ' | FKeys$ | Indicates which keys to "turn on". | ' | | | ' | | Example: FKeys$ = "150" This set up will "turn | ' | | on" . The "0" of "150" | ' | | means . RoyalMenu will self-set | ' | | the key ExitCode% numbers to reflect | ' | | = 1 through = 10. | ' +--------------+------------------------------------------------------+ ' | FGColr% | The menu color (one number). | ' +--------------+------------------------------------------------------+ ' | HiLiteFG% | The hi-light color (one number). | ' +--------------+------------------------------------------------------+ ' | MaxItems% | Maximum number of menu items. | ' +--------------+------------------------------------------------------+ ' | 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 once 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. | ' +--------------+------------------------------------------------------+ ' | MenuLine% | If MenuLine% = 0 then a line in menu is ÃÄÄÄÄÄ´ | ' | | If MenuLine% = 1 then a line in menu is ÄÄÄÄÄÄÄ | ' +--------------+------------------------------------------------------+ ' | ExitCode% | ExitCode% is the last key pressed. is | ' | | ExitCode% = 27 and is ExitCode% = 13. | ' | | If an key is pressed, then the SUB will | ' | | self-set the key ExitCode% numbers to | ' | | = 1 to = 10. | ' | | | ' | | The RoyalMenu code determines that if k% = 19712, | ' | | then has been pressed. At that | ' | | point it proclaims that ExitCode% equals 11 and | ' | | exits (EXIT SUB). | ' | | | ' | | ExitCode% = 11 for | ' | | ExitCode% = 12 for | ' | | | ' | | Where did this k% number (19712) come from? Read | ' | | about CVI NUMBERS just below. | ' | | | ' +--------------+------------------------------------------------------+ ' | CVI NUMBERS | ' +---------------------------------------------------------------------+ ' | In this program, when a key is pressed, the CVI number of that | ' | key is trapped, and action is taken. The variable k% is used | ' | here, but it can be renamed, to something else, like Hit% or | ' | KeyPressed%, etc. If the key pressed is an ASCII key, then CVI | ' | will report the ASCII number. If the key pressed is an extended | ' | key, like , the number will be a unique CVI number. | ' | This SUB will respond if , , , | ' | or is pressed. The or | ' | must have been so stipulated in SpotLetrs$, or it will | ' | be ignored. The k% number, Selection% or ExitCode% number may | ' | be used upon exiting the SUB. | ' | | ' | +---------------------------------+ | ' | | CVI Number | | ' | +----------------+----------------+ | ' | | Key Pressed: | ASCII Number: | | ' | +----------------+----------------+ | ' | | .........|....27 | | ' | | .......|....13 | | ' | | Numbers 0-9...|....48 - 57 | | ' | | Letters A-Z...|....65 - 90 | | ' | | Letters a-z...|....97 - 122 | | ' | +----------------+----------------+ | ' | | ' | To find other values for k%, like , refer to the short | ' | KeyCode.Bas program below. This program allows a QuickBASIC | ' | programmer the ability to trap every key on the keyboard. The | ' | basic ingredient is the CVI command. To use this command, make | ' | 2 DO/LOOPs and a series of IFs, ELSEIFs and END IFs. | ' | | ' | Example -> | ' | ---------- | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | LOOP UNTIL LEN(Hit$) > 0 | ' | k% = CVI(Hit$ + CHR$(0)) '<- CVI made here! | ' | IF k% = 27 THEN ' pressed | ' | END | ' | ELSEIF k% = 13 THEN ' pressed | ' | GOSUB date.info | ' | ELSEIF k% = 15104 THEN ' pressed | ' | GOSUB F1.Info | ' | END IF | ' | LOOP | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | KEYCODE.BAS | ' +---------------------------------------------------------------------+ ' | Use KeyCode.Bas below to find out what the CVI numbers will be | ' | for keys you wish to trap. | ' +---------------------------------------------------------------------+ ' | ' KeyCode.Bas - By Don Smith. FreeWare and Public Domain Program. | ' | ' Date: 09/01/2002. | ' | ' +-------------------------------------------------------------+ | ' | ' | Note: To reach the extended ASCII characters 127 to 255, | | ' | ' | press down on the key, and while pressed down, | | ' | ' | type in the number on your keypad, not the numbers | | ' | ' | above then keys. | | ' | ' +-------------------------------------------------------------+ | ' +---------------------------------------------------------------------+ ' | | ' | COLOR 14, 1: CLS | ' | Top1$ = "Press a key and the KeyCode% value will be displayed." | ' | Top2$ = "-----------------------------------------------------" | ' | Top3$ = "(Press To Quit" | ' | COLOR 15, 1 | ' | LOCATE 2, 15: PRINT Top1$ | ' | LOCATE 3, 15: PRINT Top2$ | ' | COLOR 11, 1 | ' | LOCATE 4, 30, 0: PRINT Top3$ | ' | PRINT : PRINT | ' | COLOR 14, 1 | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | IF Hit$ = CHR$(27) THEN | ' | PRINT | ' | LOCATE , 10: COLOR 15, 1: PRINT STRING$(62, "-"); | ' | PRINT | ' | LOCATE , 34: COLOR 11, 1: PRINT "Program Ends"; | ' | PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL Hit$ <> "" | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | Key$ = STR$(Hit%) | ' | IF Hit% < 256 THEN | ' | LOCATE , 32, 0 | ' | PRINT Hit$ + SPACE$(9) + "= " + Key$ | ' | ELSEIF Hit% > 255 THEN | ' | LOCATE , 21, 0 | ' | PRINT "Extended Key" + SPACE$(9) + "= " + Key$; "" | ' | END IF | ' | LOOP | ' | | ' +---------------------------------------------------------------------+ LetrOrNum% = 0 SpotLetrs$ = UCASE$(SpotLetrs$) IF Selection% = 0 THEN Selection% = 1 FindRow% = RoyalRow% MaxLen% = 0 IF Selection% = 0 OR Selection% > MaxItems% THEN Selection% = 1 END IF 'find length of longest M$ - next 7 lines FOR AFrame% = 1 TO MaxItems% Battle% = LEN(M$(MenNum%, AFrame%)) IF Battle% > MaxLen% THEN MaxLen% = Battle% END IF NEXT MaxLen% = MaxLen% + 2 IF MenuLine% = 1 THEN FrontLine$ = CHR$(196): BackLine$ = CHR$(196) ELSE FrontLine$ = CHR$(195): BackLine$ = CHR$(180) END IF FOR Ace% = 1 TO MaxItems% Fox% = RoyalRow% + Ace% - 1 LOCATE Fox%, RoyalCol%, 0 IF M$(MenNum%, Ace%) = "-" THEN LOCATE Fox%, RoyalCol% - 1, 0 CALL MQPrint(FrontLine$ + STRING$(MaxLen%, 196) + BackLine$, Colr%) ELSE CALL MQPrint(" " + M$(MenNum%, Ace%) + SPACE$(MaxLen% - LEN(M$(MenNum%, Ace%)) - 1), Colr%) IF LEN(SpotLetrs$) > 0 THEN Apple$ = MID$(SpotLetrs$, Ace%, 1) Box% = INSTR(UCASE$(M$(MenNum%, Ace%)), Apple$) IF Box% THEN BGColr% = Colr% \ 16 SpotUpColr% = (SpotColr% AND 16) * 8 + ((BGColr% AND 7) * 16) + (SpotColr% AND 15) LOCATE Fox%, RoyalCol% + Box%, 0 CALL MQPrint(MID$(M$(MenNum%, Ace%), Box%, 1), SpotUpColr%) END IF END IF END IF NEXT DO GOSUB paint.hilite 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(SpotLetrs$, UCASE$(k$)) IF LetrOrNum% <> 0 THEN GOSUB paint.regular.color Selection% = LetrOrNum% ExitCode% = k% GOSUB paint.hilite EXIT SUB END IF END IF ELSEIF k% = 20480 THEN ' GOSUB up.or.down ELSEIF k% = 18432 THEN ' GOSUB up.or.down ELSEIF k% > 15103 AND k% < 17409 THEN 'F1 - F10 IdentKey$ = STR$(((k% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKeys$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 EXIT SUB ELSE ExitCode% = VAL(IdentKey$) EXIT SUB END IF END IF ELSEIF k% = 19712 THEN ' ExitCode% = 11 EXIT SUB ELSEIF k% = 19200 THEN ' ExitCode% = 12 EXIT SUB END IF IF k% > 0 AND k% <> 45 AND k% <> 43 THEN letter% = INSTR(SpotLetrs$, UCASE$(k$)) END IF LOOP UNTIL letter% up.or.down: GOSUB paint.regular.color IF k% = 18432 THEN ' Selection% = Selection% - 1 IF Selection% = 0 THEN Selection% = MaxItems% IF M$(MenNum%, Selection%) = "-" THEN Selection% = Selection% - 1 END IF ELSEIF k% = 20480 THEN ' Selection% = Selection% + 1 IF Selection% > MaxItems% THEN Selection% = 1 IF M$(MenNum%, Selection%) = "-" THEN Selection% = Selection% + 1 END IF ELSE Selection% = LetrOrNum% END IF RETURN paint.hilite: ColrNowIs% = HiLite% SpotColrBG% = HiLiteBG% HiLiteBG% = HiLite% \ 16 SpotColrNow% = (HiLite% AND 16) * 8 + ((SpotColrBG% AND 7) * 16) + (SpotColr% AND 15) GOSUB display.menu.items RETURN paint.regular.color: ColrNowIs% = Colr% SpotColrBG% = Colr% \ 16 SpotColrNow% = (SpotColr% AND 16) * 8 + ((SpotColrBG% AND 7) * 16) + (SpotColr% AND 15) GOSUB display.menu.items RETURN display.menu.items: IF MenuLine% = 1 THEN LOCATE RoyalRow% + Selection% - 1, RoyalCol% - 1, 0 CALL MQPrint(" " + M$(MenNum%, Selection%) + STRING$(MaxLen% - LEN(M$(MenNum%, Selection%)) - 1, " ") + " ", ColrNowIs%) ELSE LOCATE RoyalRow% + Selection% - 1, RoyalCol%, 0 CALL MQPrint(" " + M$(MenNum%, Selection%) + STRING$(MaxLen% - LEN(M$(MenNum%, Selection%)) - 1, " "), ColrNowIs%) END IF IF LEN(SpotLetrs$) > 0 THEN AtBat$ = MID$(SpotLetrs$, Selection%, 1) Bear% = INSTR(UCASE$(M$(MenNum%, Selection%)), AtBat$) IF Bear% THEN SpotColrNow% = (SpotColr% AND 16) * 8 + ((SpotColrBG% AND 7) * 16) + (SpotColr% AND 15) LOCATE RoyalRow% + Selection% - 1, RoyalCol% + Bear%, 0 CALL MQPrint(MID$(M$(MenNum%, Selection%), Bear%, 1), SpotColrNow%) END IF END IF RETURN END SUB SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) ' +---------------------------------------------------------------------+ ' | SUB SaveRestScrn | ' +---------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB SaveRestScrn has 34 lines. | ' +---------------------------------------------------------------------+ ' | SUB written by Don Smith on 03/25/02 - Public Domain FreeWare. | ' | No need to name Don as the author. EMail: smithdonb@earthlink.net | ' | SUB SaveRestScrn will save a designated portion of the screen and | ' | later restore the same. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | PROGRAM SETS NUMBERS 1 AND 2 -> | ' +------------------+--------------------------------------------------+ ' | (1) ReadLine$() | Program self reads data at each Row and Column | ' +------------------+--------------------------------------------------+ ' | (2) ReadColr%() | Program self reads color at each Row and Column | ' +------------------+--------------------------------------------------+ ' | THE PROGRAMMER MUST SET NUMBERS 3 TO 9 -> | ' +---------------------------------------------------------------------+ ' | (Note: The "SR" below means "Save" Or "Restore") | ' +------------------+--------------------------------------------------+ ' | (3) SR.UL.Row% | Screen to save or restore at upper left row. | ' | (4) SR.UL.Col% | Screen to save or restore at upper left column. | ' | (5) SR.LR.Row% | Screen to save or restore at lower right row. | ' | (6) SR.LR.Col% | Screen to save or restore at lower right column | ' | +--------------------------------------------------+ ' | | SPECIAL CAUTION: | ' | | --------------- | ' | | When you call the SUB to restore the underlying | ' | | screen, use MUST use the same row and column | ' | | numbers as you used when you first called the | ' | | SUB to save the screen. | ' +------------------+--------------------------------------------------+ ' | (7) SaveOrRest% | SaveOrRest% = 1 (1 means save the screen) | ' | | SaveOrRest% = 2 (2 means restore the screen) | ' +------------------+----------+---------------------------------------+ ' | (8) REDIM ReadLine$(25) | The REDIM for ReadLine$ and ReadColr% | ' | REDIM ReadColr%(25, 80) | must be placed in the main module | ' | | before calling the SUB. The 25 and 80| ' | | reflects a screen of 25 lines and 80 | ' | | columns. You may use smaller amounts | ' | | of memory if you do not need all 25 | ' | | lines and 80 columns. | ' +-----------------------------+---------------------------------------+ ' | (9) ERASE ReadLine$ | Reclaim memory after calling the SUB | ' | ERASE ReadColr% | to restore the screen. Use REDIM and | ' | | ERASE in main module please! | ' +-----------------------------+---------------------------------------+ ' | +-----------------------------------------------------+ | ' | | Example of how to use SaveRestScrn in main module. | | ' | +-----------------------------------------------------+ | ' | | ' | REDIM ReadLine$(25): REDIM ReadColr%(25, 80) 'REDIMs full screen. | ' | CALL SaveRestScrn(1, 1, 25, 80, 1) 'The last 1 means | ' | 'save the screen. | ' | | ' | 'The last 2 means | ' | Call SaveRestScrn(1, 1, 25, 80, 2) 'restore the screen. | ' | ERASE ReadLine$: ERASE ReadColr% 'Reclaim memory. | ' | | ' +---------------------------------------------------------------------+ ' | SPECIAL NOTE: | ' +---------------------------------------------------------------------+ ' | NOTE: If there is an additional screen to save/restore, at the | ' | same time that another screen is in the SAVE mode, that is not | ' | a problem - just use another name. | ' | | ' | +-------------------------------------------------+ | ' | | EXAMPLE using DaBigScreen$ instead of ReadLine$:| | ' | +-------------------------------------------------+ | ' | | ' | Example to SAVE: | ' | --------------- | ' | REDIM DaBigScreen$(25): REDIM DaBigColor%(25, 80) | ' | CALL SaveRestScrn(DaBigScreen$(), DaBigColor%(), 1, 1, 25, 80, 1) | ' | | ' | Example to RESTORE: | ' | ------------------ | ' | CALL SaveRestScrn(DaBigScreen$(), DaBigColor%(), 1, 1, 25, 80, 2) | ' | ERASE DaBigScreen$: ERASE DaBigColor% | ' +---------------------------------------------------------------------+ IF SR.LR.Col% > 80 THEN SR.LR.Col% = 80 END IF IF SR.LR.Row% > 25 THEN SR.LR.Row% = 25 END IF IF SaveOrRest% = 1 THEN GOSUB save.scrn ELSEIF SaveOrRest% = 2 THEN GOSUB restore.scrn END IF EXIT SUB save.scrn: FOR ViewIt% = SR.UL.Row% TO SR.LR.Row% FOR Horizon% = SR.UL.Col% TO SR.LR.Col% ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%)) ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1) NEXT NEXT RETURN restore.scrn: FOR FindRow% = SR.UL.Row% TO SR.LR.Row% FOR ScrnCol% = SR.UL.Col% TO SR.LR.Col% LOCATE FindRow%, ScrnCol%, 0 OneColr% = ReadColr%(FindRow%, ScrnCol%) FGScrnColr% = OneColr% MOD 16 BGScrnColr% = OneColr% \ 16 COLOR FGScrnColr%, BGScrnColr% PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (SR.UL.Col% - 1)); NEXT NEXT RETURN END SUB