' +------------------------------------------------------+ ' | | ' | WARNING WARNING WARNING | ' | ------- ------- ------- | ' | When you load this program into QuickBASIC 4.5, you must also | ' | load QuickBASIC's quick library. So, at the prompt enter: | ' | | ' | QB /L QB.QLB Magmenu1.Bas | ' | | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | | ' | 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. | ' +--------------------------------------------------------------------+ ' | With all blank lines and REM (') lines removed, the entire | ' | Magic Menu Program program with its five SUBs contains just 667 | ' | lines of code. | ' +--------------------------------------------------------------------+ ' | The Magic Menu Program and its five SUBs were written by me, | ' | Don Smith, on 12/01/2002. MagMenu1.Bas, SUB HorizMenu, | ' | SUB RoyalMenu, SUB SaveRestScrn, 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 680 and modify the | ' | 9 lines of text. | ' +--------------------------------------------------------------------+ ' | To remove or modify the "U.S.Marine Corps" of the opening screen, | ' | go to lines 704 to 718. To modify the two boxes of the opening | ' | screen, go to lines 366 and 367. | ' +--------------------------------------------------------------------+ ' | 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: MagMenu1 /e (e for ON ERROR) | ' | | ' | LINK: MagMenu1 | ' | LIB: QB BCom45 | ' | | ' +--------------------------------------------------------------------+ tippy.top: ' Next 19 lines set up SUB GetFileAttributes and SUB InterruptX. ' Magmenu1 uses these SUBs to check the existence of a file. For ' more information, go to SUB GetFileAttributes. TYPE RegTypeX ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER ds AS INTEGER es AS INTEGER END TYPE '--------------------------------------------------------------------- DECLARE SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) DECLARE SUB GetFileAttributes (fileName$, result) DECLARE SUB HorizMenu (MenuItem$(), Row%(), Col%(), MaxItems%, Items%, TempItems%, SpotColr%, TopFGColr%, TopBGColr%, TopHiLiteFG%, TopHiLiteBG%, TypeOfKey$, Hit%) DECLARE SUB InterruptX (intnum%, inreg AS RegTypeX, outreg AS RegTypeX) DECLARE SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) DECLARE SUB RoyalMenu (M$(), MenNum%, RoyalRow%, RoyalCol%, SpotLetrs$, SpotColr%, FKeys$, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, MaxMenuItems%, Selection%, MenuLine%, ExitCode%) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '--------------------------------------------------------------------- ON ERROR GOTO errorhandler '----------------------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 | '+------------------+-----------------------------------------------+ HelpColrFG% = 15 '| Help screen color - bright white on red | HelpColrBG% = 4 '| | '-------------------+-----------------------------------------------+ HelpAccentFG% = 11 '| Help screen accent color - bright blue on red| HelpAccentBg% = 4 '| on black | '-------------------+-----------------------------------------------+ TopFGColr% = 0 '| Top band HorizMenu item - black on | TopBGColr% = 7 '| dim white | '-------------------+-----------------------------------------------+ TopHiLiteFG% = 7 '| Top band HiLight HorizMenu color - | TopHiLiteBG% = 0 '| dim white on black | '-------------------+-----------------------------------------------+ FGColr% = 0 '| RoyalMenu item color - bright white | BGColr% = 7 '| on black | '-------------------+-----------------------------------------------+ HiLiteFG% = 7 '| RoyalMenu HiLight color - bright white | HiLiteBG% = 0 '| on red | '-------------------+-----------------------------------------------+ SpotColr% = 15 '| Spot Color for both HorizMenu & RoyalMenu - | '| bright blue | '-------------------+-----------------------------------------------+ BottColrFG% = 15 '| Bottom band info color - | BottColrBG% = 3 '| bright white on cyan | '-------------------+-----------------------------------------------+ BottAccentFG% = 11 '| Bottom band accent color - | BottAccentBG% = 3 '| yellow on cyan | '------------------'+-----------------------------------------------+ ClearScrnFG% = 15 '| Clear screen color - bright white on blue | ClearScrnBG% = 1 '| | '------------------'+-----------------------------------------------+ F10ColrFG% = 15 '| Info color - bright white on | F10ColrBG% = 5 '| black | '------------------'+-----------------------------------------------+ F10AccentFG% = 11 '| Accent color - bright red on | F10AccentBG% = 5 '| black | '-------------------+-----------------------------------------------+ '----------------------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 MARINE CORPS-------- COLOR ClearScrnFG%, ClearScrnBG%: CLS CALL BoxBoy("", 3, 2, 23, 78, 1, 1, 15, 1, 9, 1, 2, 0, 8, 0) 'Big box CALL BoxBoy("", 4, 3, 22, 77, 1, 1, 15, 1, 15, 1, 2, 0, 8, 0) 'Inset Box GOSUB marine.corps: 'Paint top line with a band of color COLOR TopFGColr%, TopBGColr% LOCATE 1, 1: PRINT SPACE$(80); 'Paint bottom line with info COLOR BottColrFG%, BottColrBG%: LOCATE 25, 1: PRINT SPACE$(80); LOCATE 25, 9 PRINT "Press To Access Help Window. Press For Special Info."; COLOR BottAccentFG%, BottAccentBG% LOCATE 25, 16, 0, 0, 0: PRINT "F1"; : LOCATE 25, 52: PRINT "F10"; horiz.menu: CALL HorizMenu(MenuItem$(), Row%(), Col%(), MaxItems%, Items%, TempItems%, SpotColr%, TopFGColr%, TopBGColr%, TopHiLiteFG%, TopHiLiteBG%, 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 BoxColrFG% = 0 BoxColrBG% = 7 Shadow% = 1 ShadowColr% = 8 EdgeYN% = 0 '----------------------------------------------------------------- ' 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 ReadLine$(25): REDIM ReadColr%(25, 80) 'save underlying screen CALL SaveRestScrn(ReadLine$(), ReadColr%(), ULRow% - 1, ULCol%, LRRow% + 1, LRCol% + 3, 1) CALL BoxBoy("", ULRow%, ULCol%, LRRow%, LRCol%, 1, 1, 0, 7, BoxColrFG%, BoxColrBG%, BoxStyle%, Shadow%, ShadowColr%, EdgeYN%) royal.menu: CALL RoyalMenu(M$(), MenNum%, RoyalRow%, RoyalCol%, SpotLetrs$, SpotColr%, FKeys$, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, MaxMenuItems%, Selection%, MenuLine%, ExitCode%) IF ExitCode% = 27 THEN ' Items% = MenNum% Selection% = 0 GOTO make.horiz.menu: ELSEIF ExitCode% = 11 THEN ' GOSUB unpaint.top 'restore screen - next 2 lines CALL SaveRestScrn(ReadLine$(), ReadColr%(), ULRow%, ULCol%, LRRow% + 1, LRCol% + 3, 2) ERASE ReadLine$: ERASE ReadColr% 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 ' GOSUB unpaint.top 'restore screen - next 2 lines CALL SaveRestScrn(ReadLine$(), ReadColr%(), ULRow%, ULCol%, LRRow% + 1, LRCol% + 3, 2) ERASE ReadLine$: ERASE ReadColr% 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 ReadTheScrn$(25): REDIM ReadTheColr%(25, 80) CALL SaveRestScrn(ReadTheScrn$(), ReadTheColr%(), 1, 1, 25, 80, 1) CALL BoxBoy("", 11, 11, 15, 67, 1, 1, 0, 7, HelpColrFG%, HelpColrBG%, 2, 1, 8, 1) LOCATE 12, 16: COLOR HelpColrFG%, HelpColrBG% PRINT "Your Pick Was Selection Number"; Selection%; "Of Menu Number"; MenNum%; " "; LOCATE 13, 13 CALL OneLine(13, 12, HelpColrFG%, HelpColrBG%, 3, 56) COLOR HelpColrFG%, HelpColrBG% LOCATE 14, 18: PRINT "Press To Return Or Press To Quit"; COLOR HelpAccentFG%, HelpAccentBg% LOCATE 14, 25: PRINT "Enter"; LOCATE 14, 52: PRINT "Esc"; DO Exit$ = INKEY$ IF Exit$ = CHR$(27) THEN ' GOTO leave ELSEIF Exit$ = CHR$(13) THEN ' CALL SaveRestScrn(ReadTheScrn$(), ReadTheColr%(), 1, 1, 25, 80, 2) ERASE ReadTheScrn$: ERASE ReadTheColr% 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%) COLOR TopHiLiteFG%, TopHiLiteBG% PRINT MenuItem$(Items%); COLOR SpotColr%, TopHiLiteBG% LOCATE 1, Col%(Items%) + 1 PRINT LEFT$(RTRIM$(LTRIM$(MenuItem$(Items%))), 1); RETURN unpaint.top: 'returns top item to previous color LOCATE 1, Col%(Items%) COLOR TopFGColr%, TopBGColr% PRINT MenuItem$(Items%); LOCATE 1, Col%(Items%) + 1 COLOR SpotColr%, TopBGColr% PRINT LEFT$(RTRIM$(LTRIM$(MenuItem$(Items%))), 1); RETURN leave: COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END bring.help: REDIM RLine$(25): REDIM RColr%(25, 80) CALL SaveRestScrn(RLine$(), RColr%(), 1, 1, 25, 80, 1) 'save 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 CALL GetFileAttributes("MagMenu.Hlp", result) 'Checks if a file exists IF result > 0 THEN 'or not. See SUB REDIM SpecialRead$(25): REDIM SpecialColr%(25, 80) CALL SaveRestScrn(SpecialRead$(), SpecialColr%(), 1, 1, 25, 80, 1) ErrMM% = 1 GOSUB errorscreen CALL SaveRestScrn(SpecialRead$(), SpecialColr%(), 1, 1, 25, 80, 2) ERASE SpecialRead$: ERASE SpecialColr% ErrMM% = 0 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 SaveRestScrn(RLine$(), RColr%(), 1, 1, 25, 80, 2) 'restore ERASE RLine$: ERASE RColr% SZero$ = "" RETURN help.screen: CALL BoxBoy("", 7, 10, 16, 70, 1, 1, 15, 4, HelpColrFG%, HelpColrBG%, 2, 1, 8, 1) CALL OneLine(9, 11, HelpColrFG%, HelpColrBG%, 4, 60) COLOR HelpAccentFG%, HelpAccentBg% LOCATE 8, 33: PRINT "- HELP WINDOW -" HelpCol% = 26 'adjust HelpCol% to be centered in help window FOR SeeHelp% = 1 TO 4 COLOR HelpColrFG%, HelpColrBG% LOCATE SeeHelp% + 9, HelpCol% PRINT UCASE$(help$(SeeHelp%)) NEXT CALL OneLine(14, 11, HelpColrFG%, HelpColrBG%, 4, 60) LOCATE 15, 27 PRINT "" COLOR HelpAccentFG%, HelpAccentBg% LOCATE 15, 28 PRINT "Press Any Key To Continue"; DO: LOOP WHILE INKEY$ = "" RETURN f10.key: REDIM SpecialRead$(25): REDIM SpecialColr%(25, 80) CALL SaveRestScrn(SpecialRead$(), SpecialColr%(), 1, 1, 25, 80, 1) CALL BoxBoy("", 6, 10, 19, 70, 1, 1, 15, 4, F10ColrFG%, F10ColrBG%, 2, 1, 8, 1) CALL OneLine(8, 11, F10ColrFG%, F10ColrBG%, 4, 60) COLOR F10AccentFG%, F10AccentBG% LOCATE 7, 24: PRINT "SPECIAL INFORMATION TO PROGRAMMERS:" COLOR F10ColrFG%, F10ColrBG% LOCATE 9, 17: PRINT "The MagicMenu System was written by Don Smith on" LOCATE 10, 17: PRINT "10/01/2002. You may alter the source code in any" LOCATE 11, 17: PRINT "fashion you see fit. All parts of the MagicMenu" LOCATE 12, 17: PRINT "System, including its five SUBs, are Public Domain" LOCATE 13, 17: PRINT "FreeWare. You need not give my name as author." LOCATE 14, 17: PRINT "You may even change the name of the program. " CALL OneLine(15, 11, F10ColrFG%, F10ColrBG%, 4, 60) COLOR F10AccentFG% + 3, F10AccentBG% LOCATE 16, 26: PRINT "EMail: smithdonb@earthlink.net" CALL OneLine(17, 11, F10ColrFG%, F10ColrBG%, 4, 60) COLOR F10AccentFG%, F10AccentBG% LOCATE 18, 27: PRINT ""; DO: LOOP WHILE INKEY$ = "" CALL SaveRestScrn(SpecialRead$(), SpecialColr%(), 1, 1, 25, 80, 2) ERASE SpecialRead$: ERASE SpecialColr% RETURN marine.corps: COLOR 12, 1: LOCATE 6, 5: PRINT "ÖÄ¿ ÖÄ¿ ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄÄÄ¿ ÖÄÄÄÄÄÄ¿ ÖÄÄÄÄÄÄ¿ ÖÄÄÄ¿ ÖÄÄÄÄ¿ÖÄ¿ ÖÄÄÄÄÄ¿" COLOR 15, 1: LOCATE 7, 5: PRINT "º ³ º ³ º ÕÍÍ; º Õ» Õ» ³ º ÕÍÍ» ³ º ÕÍÍ» ³ È» Õ¾ º Õ» ³º ³ º ÕÍÍ;" COLOR 11, 1: LOCATE 8, 5: PRINT "º ³ º ³ º ÀÄÄÄ¿ º ³º ³º ³ º ÀÄĽ ³ º ÀÄĽ ³ º ³ º ³º ³º ³ º ÀÄ¿ " COLOR 15, 1: LOCATE 9, 5: PRINT "º ³ º ³ ÈÍÍÍ» ³ º ³È;º ³ º ÕÍÍ» ³ º ÕÍ» Õ¾ º ³ º ³º ³º ³ º Õ; " COLOR 15, 1: LOCATE 10, 5: PRINT "º ÀĽ ³ ÖÄÄĽ ³ º ³ º ³ º ³ º ³ º ³ º À¿ Ö½ À¿ º ³º À½ ³ º ÀÄÄÄ¿" COLOR 15, 1: LOCATE 11, 5: PRINT "ÈÍÍÍÍ; ÈÍÍÍÍ; È; È; È; È; È; ÈÍ; ÈÍÍ; È;ÈÍÍÍ; ÈÍÍÍÍ;" COLOR 12, 1: LOCATE 13, 20: PRINT "ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄÄ¿ ÖÄÄÄÄÄ¿ ÖÄÄÄÄÄ¿" COLOR 15, 1: LOCATE 14, 20: PRINT "º ÕÍ» ³ º ÕÍ» ³ º ÕÍÍ» ³ º ÕÍ» ³ º ÕÍÍ;" COLOR 11, 1: LOCATE 15, 20: PRINT "º ³ È; º ³ º ³ º ÀÄĽ ³ º ÀĽ ³ º ÀÄÄÄ¿" COLOR 15, 1: LOCATE 16, 20: PRINT "º ³ ÖÄ¿ º ³ º ³ º ÕÍ» Õ¾ º ÕÍÍ; ÈÍÍÍ» ³" COLOR 15, 1: LOCATE 17, 20: PRINT "º ÀĽ ³ º ÀĽ ³ º ³ º À¿ º ³ ÖÄÄĽ ³" COLOR 15, 1: LOCATE 18, 20: PRINT "ÈÍÍÍÍ; ÈÍÍÍÍ; È; ÈÍ; È; ÈÍÍÍÍ;" RETURN errorscreen: CALL BoxBoy("", 7, 10, 14, 70, 7, 36, 14, 4, 15, 4, 2, 1, 7, 1) COLOR 14, 4: LOCATE 8, 34 PRINT "<<< Error >>>"; : 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) 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) 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 DEFINT A-Z SUB BoxBoy (Title$, ULRow%, ULCol%, LRRow%, LRCol%, TitleRow%, TitleCol%, TitColrFG%, TitColrBG%, BoxColrFG%, BoxColrBG%, 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)| ' | TitColrFG% | The foreground color of the title| . . . . . . . . | ' +-------------+----------------------------------| Example -> | ' | TitColrBG% | The background color of the title| TitColrFG% = 0 | ' +-------------+----------------------------------+-------------------+ ' | BoxColrFG% | The foreground color of the box itself. | ' +-------------+------------------------------------------------------+ ' | BoxColrBG% | The back ground color of the box. | ' +-------------+------------------------------------------------------+ ' | 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 COLOR FGScrnColr%, 0 ELSEIF ShadowColr% = 8 THEN COLOR 8, 0 END IF IF Shadow% = 1 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% + 1)); ELSEIF Shadow% = 2 THEN PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (ULCol% - 3)); 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% PRINT Edge$ + ULCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + URCorner$ + Edge$; '³ ³ or º º LOCATE ULRow% + 1, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; IF Title$ <> "" THEN 'ÃÄÄÄ´ or ÇÄÄĶ 'made cross bar if there is a title LOCATE ULRow% + 2, ULCol% PRINT Edge$ + LeftSide$ + STRING$(LRCol% - ULCol%, 196) + RightSide$ + Edge$; ELSEIF Title$ = "" THEN LOCATE ULRow% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; END IF '³ ³ or º º FOR Print.Box% = 1 TO (LRRow% - ULRow%) - 3 LOCATE ULRow% + Print.Box% + 2, ULCol% PRINT Edge$ + VertLine$ + SPACE$(LRCol% - ULCol%) + VertLine$ + Edge$; NEXT 'ÀÄÄÄÙ or ÈÍÍͼ LOCATE LRRow%, ULCol%, 0 PRINT Edge$ + LLCorner$ + STRING$(LRCol% - ULCol%, HorLine$) + LRCorner$ + Edge$; IF Title$ <> "" THEN LOCATE TitleRow%, TitleCol% COLOR TitColrFG%, TitColrBG% PRINT Title$; END IF END SUB REM $DYNAMIC DEFSNG A-Z SUB GetFileAttributes (fileName$, result) STATIC ' +---------------------------------------------------------------------+ ' | GetFileAttributes is used to determine if a file exists or not. | ' | To use this SUB within QuickBASIC 4.5, you must load the QuickBASIC | ' | Quick Library. At the prompt it would be: | ' | | ' | QB /L QB.QLB Magmenu1.Bas (and press ENTER) | ' | | ' | See example, below: | ' +---------------------------------------------------------------------+ ' | | ' | To use SUB GetFileAttributes -> | ' | | ' | CALL GetFileAttributes (fileName$, result) | ' | IF result > 0 THEN | ' | 'file does not exist. Use a pop-up screen and | ' | 'back out. | ' | ELSEIF result = 0 THEN | ' | 'file does indeed exist. Continue with routine. | ' | END IF | ' | | ' +---------------------------------------------------------------------+ DIM regX AS RegTypeX regX.ax = &H4300 F$ = fileName$ + CHR$(0) regX.ds = VARSEG(F$) regX.dx = SADD(F$) InterruptX &H21, regX, regX IF regX.flags AND 1 THEN result = regX.ax ELSE result = 0 END IF END SUB REM $STATIC DEFINT A-Z SUB HorizMenu (MenuItem$(), Row%(), Col%(), MaxItems%, Items%, TempItems%, SpotColr%, TopFGColr%, TopBGColr%, TopHiLiteFG%, TopHiLiteBG%, 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. | ' +------------+-----------------------------------------------------+ ' | TopFGColr% | Foreground color of menu item (0-15). | ' +------------+-----------------------------------------------------+ ' | TopBGColr% | Background color of menu item (1-7). | ' +------------+-----------------------------------------------------+ ' | TopHiLiteFG% | Foreground color of hi-lighted menu item (0-15).| ' +------------+-----------------------------------------------------+ ' | TopHiLiteBG% | Background color of hi-lighted menu item (0-7). | ' +------------+-----------------------------------------------------+ ' | 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: COLOR TopHiLiteFG%, TopHiLiteBG% SpotColrBG% = TopHiLiteBG% GOSUB paint.menu.items RETURN paint.regular: COLOR TopFGColr%, TopBGColr% SpotColrBG% = TopBGColr% GOSUB paint.menu.items RETURN paint.menu.items: LOCATE Row%(Items%), Col%(Items%), 0 PRINT MenuItem$(Items%); FrstLetr$ = LEFT$(RTRIM$(LTRIM$(MenuItem$(Items%))), 1) COLOR SpotColr%, SpotColrBG% LOCATE Row%(Items%), Col%(Items%) + 1, 0 PRINT FrstLetr$; RETURN END SUB SUB OneLine (LineRow%, LineCol%, LineFG%, LineBG%, Style%, LenStr%) ' +-------------------------------------------------------------------+ ' | SUB OneLine | ' +-------------------------------------------------------------------+ ' | Not counting REM (') lines, SUB OneLine has 12 lines. | ' +-------------------------------------------------------------------+ ' | SUB OneLine will place one line on screen. There are 4 types | ' | of lines to choose from. See Style% below. | ' +---------------+---------------------------------------------------+ ' | LineRow% | Row to place line. | ' +---------------+---------------------------------------------------+ ' | LineCol% | Column to place line. | ' +---------------+---------------------------------------------------+ ' | LineFG% | Foreground color of line. | ' +---------------+---------------------------------------------------+ ' | LineBG% | Background color of line. | ' +---------------+---------------------------------------------------+ ' | Style% | Style% = 1 ÃÄÄÄ´ | ' | +---------------------------------------------------+ ' | | Style% = 2 ÆÍÍ͵ | ' | +---------------------------------------------------+ ' | | Style% = 3 ÌÍÍ͹ | ' | +---------------------------------------------------+ ' | | Style% = 4 ÇÄÄĶ | ' +---------------+---------------------------------------------------+ ' | LenStr% | Length of string (line). | ' +-------------------------------------------------------------------+ IF Style% = 1 THEN 'ÃÄÄÄ´ SingLine$ = CHR$(195) + STRING$(LenStr%, CHR$(196)) + CHR$(180) ELSEIF Style% = 2 THEN 'ÆÍÍ͵ SingLine$ = CHR$(198) + STRING$(LenStr%, CHR$(205)) + CHR$(181) ELSEIF Style% = 3 THEN 'ÌÍÍ͹ SingLine$ = CHR$(204) + STRING$(LenStr%, CHR$(205)) + CHR$(185) ELSEIF Style% = 4 THEN 'ÇÄÄĶ SingLine$ = CHR$(199) + STRING$(LenStr%, CHR$(196)) + CHR$(182) END IF LOCATE LineRow%, LineCol% COLOR LineFG%, LineBG% PRINT SingLine$; END SUB SUB RoyalMenu (M$(), MenNum%, RoyalRow%, RoyalCol%, SpotLetrs$, SpotColr%, FKeys$, FGColr%, BGColr%, HiLiteFG%, HiLiteBG%, MaxMenuItems%, 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 item 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 letter of a menu item. When a | ' | | designated hi-lite 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 foreground menu color. | ' +--------------+------------------------------------------------------+ ' | BGColr% | The background menu color. | ' +--------------+------------------------------------------------------+ ' | HiLiteFG% | The foreground hi-light color. | ' +--------------+------------------------------------------------------+ ' | HiLiteBG% | The background hi-light color. | ' +--------------+------------------------------------------------------+ ' | MaxMenuItems%| The 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% > MaxMenuItems% THEN Selection% = 1 END IF 'find length of longest M$ - next 7 lines FOR AFrame% = 1 TO MaxMenuItems% 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 MaxMenuItems% COLOR FGColr%, BGColr% Fox% = RoyalRow% + Ace% - 1 LOCATE Fox%, RoyalCol%, 0 IF M$(MenNum%, Ace%) = "-" THEN LOCATE Fox%, RoyalCol% - 1, 0 PRINT FrontLine$ + STRING$(MaxLen%, 196) + BackLine$ ELSE PRINT " "; M$(MenNum%, Ace%); TAB(RoyalCol% + MaxLen%); IF LEN(SpotLetrs$) > 0 THEN Apple$ = MID$(SpotLetrs$, Ace%, 1) Box% = INSTR(UCASE$(M$(MenNum%, Ace%)), Apple$) IF Box% = 0 THEN Box% = 1 IF Box% THEN COLOR SpotColr%, BGColr% LOCATE Fox%, RoyalCol% + Box%, 0 IF Apple$ <> "+" THEN PRINT MID$(M$(MenNum%, Ace%), Box%, 1); END IF 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% = MaxMenuItems% IF M$(MenNum%, Selection%) = "-" THEN Selection% = Selection% - 1 END IF ELSEIF k% = 20480 THEN ' Selection% = Selection% + 1 IF Selection% > MaxMenuItems% THEN Selection% = 1 IF M$(MenNum%, Selection%) = "-" THEN Selection% = Selection% + 1 END IF ELSE Selection% = LetrOrNum% END IF RETURN paint.hilite: COLOR HiLiteFG%, HiLiteBG% SpotColrBG% = HiLiteBG% GOSUB display.menu.items RETURN paint.regular.color: COLOR FGColr%, BGColr% SpotColrBG% = BGColr% GOSUB display.menu.items RETURN display.menu.items: LOCATE RoyalRow% + Selection% - 1, RoyalCol%, 0 PRINT " " + M$(MenNum%, Selection%) + STRING$(MaxLen% - LEN(M$(MenNum%, Selection%)) - 1, " ") IF LEN(SpotLetrs$) > 0 THEN AtBat$ = MID$(SpotLetrs$, Selection%, 1) Bear% = INSTR(UCASE$(M$(MenNum%, Selection%)), AtBat$) IF Bear% = 0 THEN Bear% = 1 IF Bear% THEN COLOR SpotColr%, SpotColrBG% LOCATE RoyalRow% + Selection% - 1, RoyalCol% + Bear%, 0 IF AtBat$ <> "+" THEN PRINT MID$(M$(MenNum%, Selection%), Bear%, 1); END IF 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. | | ' | +-----------------------------------------------------+ | ' | | ' | 1. Here the full screen is saved: | ' | -------------------------------- | ' | REDIM ReadLine$(25): REDIM ReadColr%(25, 80) 'REDIMs full screen. | ' | CALL SaveRestScrn(1, 1, 25, 80, 1) 'The last 1 means | ' | 'save the screen. | ' | | ' | 2. The full screen is restored: | ' | ------------------------------ '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