' +---------------------------------------------------------------------+ ' | | ' | - B i g P a g e . B a s - | ' | | ' | | ' | Public Domain - FreeWare | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | BigPage.Bas is another example of how to use the SUB MesaMenu. | ' | This program is Public Domain, FreeWare. Written by | ' | Don Smith on 10-01-2002. EMail: smithdonb@earthlink.net | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | - ABOUT THE AUTHOR - | ' +---------------------------------------------------------------------+ ' | | ' | Hello. My name is Don Smith and I am a retired thiry-year teacher | ' | of Math/History/Spanish residing in Orange County, California. I am | ' | also a former 6-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. | ' +---------------------------------------------------------------------+ ' +---------------------------------------------------------------------+ ' | | ' | Compile: BC: BBmenuQB.Bas | ' | LINK: BBmenuQB.Bas | ' | LIB: BCom45.Lib | ' +---------------------------------------------------------------------+ DEFINT A-Z '----------------------------------------------------------------------- DECLARE SUB EasyBox (BoxULRow%, BoxULCol%, BoxLRRow%, BoxLRCol%, BoxColrFG%, BoxColrBG%) DECLARE SUB EditQB (EdW$, EdPW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, PW%, ExitCode%) DECLARE SUB MesaMenu (M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '----------------------------------------------------------------------- COLOR 15, 1: CLS BoxULRow% = 1 BoxULCol% = 1 BoxLRRow% = 25 BoxLRCol% = 80 BoxColrFG% = 15 BoxColrBG% = 1 CALL EasyBox(BoxULRow%, BoxULCol%, BoxLRRow%, BoxLRCol%, BoxColrFG%, BoxColrBG%) line$ = CHR$(195) + STRING$(78, CHR$(196)) + CHR$(180) LOCATE 3, 1: PRINT line$; LOCATE 1, 20: PRINT CHR$(194); LOCATE 2, 20: PRINT CHR$(179); LOCATE 3, 20: PRINT CHR$(193); LOCATE 1, 53: PRINT CHR$(194); LOCATE 2, 53: PRINT CHR$(179); LOCATE 3, 53: PRINT CHR$(193); COLOR 11, 1 LOCATE 2, 4: PRINT "Reference Work"; LOCATE 2, 23: PRINT "Press to search"; LOCATE 2, 57: PRINT "Press To View"; COLOR 15, 1 LOCATE 2, 30: PRINT "Space Bar"; LOCATE 2, 64: PRINT "Enter"; LOCATE 23, 1: PRINT line$; COLOR 0, 7 LOCATE 24, 2: PRINT SPACE$(56); LOCATE 24, 3 PRINT "MOVE: " + CHR$(24) + " " + CHR$(25) + " " + CHR$(27) + " " + CHR$(26) + " " + " Aborts"; COLOR 15, 4 LOCATE 24, 58: PRINT " Press "; '-------------------------------- Start% = 1 ' <- <- put Start% above "top" top: ' Count% = 2000 ' RegColrFG% = 15 ' RegColrBG% = 1 ' HiLiteFG% = 15 ' HiLiteBG% = 4 ' +--------------------------------------+ MaxScrRows% = 19 ' | For an explanation of the items to | MaxScrCols% = 12 ' | the left, visit the SUB MesaMenu. | ColumnPointer% = 1 ' | | TweenSpace% = 1 ' +--------------------------------------+ TableULRow% = 4 ' TableULCol% = 6 ' CurrentRow% = 0 ' CurrentCol% = 0 ' ItemNum% = Start% ' ItemWidth% = 5 ' FKey$ = "150" ' ExitCode% = 0 REDIM M$(2000) FOR PageNum% = 1 TO 2000 M$(PageNum%) = RTRIM$(LTRIM$(STR$(PageNum%))) NEXT begin.complete.menu: CALL MesaMenu(M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) check.number: IF ExitCode% = 32 THEN REDIM ReadScrn$(25) REDIM ReadColr%(25, 80) CALL SaveRestScrn(ReadScrn$(), ReadColr%(), 1, 1, 25, 80, 1) CALL EasyBox(10, 20, 12, 65, 15, 4) LOCATE 11, 24: PRINT "Which file do you wish? (1-2000)"; COLOR 15, 4 CALL EditQB(EdW$, EdPW$, 11, 57, 57, 4, 1, "0123456789", 1, 15, 4, "", PW%, ExitCode%) IF EdW$ = "" THEN GOTO begin.complete.menu END IF IF ExitC% = 27 THEN GOTO begin.complete.menu END IF CALL SaveRestScrn(ReadScrn$(), ReadColr%(), 1, 1, 25, 80, 2) IF VAL(RTRIM$(LTRIM$(EdW$))) > 0 AND VAL(RTRIM$(LTRIM$(EdW$))) < 2001 THEN Start% = VAL(RTRIM$(LTRIM$(EdW$))) GOTO top ELSE CALL EasyBox(10, 20, 12, 65, 15, 4) LOCATE 11, 22: PRINT "Oops! Can't find that. Try Again (Y/N)?"; DO DO KBird$ = INKEY$ LOOP UNTIL LEN(KBird$) KBird% = CVI(KBird$ + CHR$(0)) IF KBird% = 121 OR KBird% = 89 THEN 'y/Y GOTO check.number ELSEIF KBird% = 110 OR KBird% = 78 OR KBird% = 27 THEN 'n/Y GOTO begin.complete.menu END IF LOOP END IF ELSEIF ExitCode% = 27 THEN ' COLOR 7, 0: CLS : LOCATE 1, 1, 1, 6, 7: END ' 'If user presses , the menu will exit set to M$(ItemNum%) ' and ExitCode% = 13. ELSEIF ExitCode% = 1 OR ExitCode% = 5 OR ExitCode% = 10 OR ExitCode% = 13 THEN GOSUB save.screen COLOR 15, 2: CLS BoxULRow% = 8 BoxULCol% = 20 BoxLRRow% = 16 BoxLRCol% = 63 BoxColrFG% = 15 BoxColrBG% = 2 CALL EasyBox(BoxULRow%, BoxULCol%, BoxLRRow%, BoxLRCol%, BoxColrFG%, BoxColrBG%) LOCATE 10, 27: PRINT "ExitCode% Was" + STR$(ExitCode%) + "." IF ExitCode% = 1 OR ExitCode% = 5 OR ExitCode% = 10 THEN LOCATE 12, 27: PRINT " Was Pressed." ELSEIF ExitCode% = 13 THEN LOCATE 12, 27: PRINT "Reference Page " + RTRIM$(LTRIM$(M$(ItemNum%))) + " Was Pressed." END IF LOCATE 14, 27: PRINT ""; DO: LOOP WHILE INKEY$ = "" GOSUB restore.screen Start% = ItemNum% GOTO begin.complete.menu ELSE GOTO begin.complete.menu END IF save.screen: REDIM ReadLine$(25) REDIM ReadColr%(25, 80) SR.UL.Row% = 1 SR.UL.Col% = 1 SR.LR.Row% = 25 SR.LR.Col% = 80 SaveOrRest% = 1 CALL SaveRestScrn(ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) RETURN restore.screen: SR.UL.Row% = 1 SR.UL.Col% = 1 SR.LR.Row% = 25 SR.LR.Col% = 80 SaveOrRest% = 2 CALL SaveRestScrn(ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) ERASE ReadLine$: ERASE ReadColr% RETURN SUB EasyBox (BoxULRow%, BoxULCol%, BoxLRRow%, BoxLRCol%, BoxColrFG%, BoxColrBG%) ' +--------------------------------------------------------------------+ ' | SUB EasyBox is Public Domain, FreeWare written by | ' | Don Smith on 08/01/2002. EMail: smithdonb@earthlink.net | ' +--------------------------------------------------------------------+ COLOR BoxColrFG%, BoxColrBG% LOCATE BoxULRow%, BoxULCol% PRINT CHR$(218) + STRING$(BoxLRCol% - BoxULCol% - 1, CHR$(196)) + CHR$(191); FOR BuildSides% = BoxULRow% + 1 TO BoxLRRow% - 1 LOCATE BuildSides%, BoxULCol% PRINT CHR$(179) + STRING$(BoxLRCol% - BoxULCol% - 1, " ") + CHR$(179); NEXT LOCATE BoxLRRow%, BoxULCol% PRINT CHR$(192) + STRING$(BoxLRCol% - BoxULCol% - 1, CHR$(196)) + CHR$(217); END SUB SUB EditQB (EdW$, EdPW$, Row%, Col%, FCol%, LenStr%, See%, TypeOfText$, Caps%, FGColr%, BGColr%, FKey$, PW%, ExitCode%) STATIC ' +--------------------------------------------------------------------+ ' | SUB EditQB: | ' +--------------------------------------------------------------------+ ' | SUB EditQB is a one-line editor able to use a password, if needed.| ' +--------------------------------------------------------------------+ ' | EdW$ | The string to be edited. | ' +--------------+-----------------------------------------------------+ ' | Row% | The row to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | Col% | The column to begin the editing. | ' +--------------+-----------------------------------------------------+ ' | FCol% | Use same number as Col% | ' +--------------+-----------------------------------------------------+ ' | LenStr% | Length of the string to edit. | ' +--------------+-----------------------------------------------------+ ' | See% | If See% = 0 then existing text will be displayed. | ' | | If See% = 1 existing text will be wiped. | ' +--------------+-----------------------------------------------------+ ' | TypeOfText$ | For all ASCII characers 32 to 255, TypeOfText = "" | ' | | For numbers only, TypeOfText$ = "1234567890" | ' | | For numbers with commas and decimals points, | ' | | TypeOfText$ = ".,1234567890" | ' | | For Yes or No answers, TypeOfText$ = "YNyn" | ' | | Whatever is included within the parethesis | ' | | is what will be accepted. | ' +--------------+-----------------------------------------------------+ ' | Caps% | Capital letters enabled, Caps% = 1 | ' +--------------+-----------------------------------------------------+ ' | FGColr% | Foreground color. | ' +--------------+-----------------------------------------------------+ ' | BGColr% | Background color. | ' +--------------+-----------------------------------------------------+ ' | FKey$ | Which keys to enable. To enabled | ' | | and , FKey$ = "150" ("0" is F10). | ' +--------------+-----------------------------------------------------+ ' | PW% | PW% = 1 password mode enabled. | ' | | PW% = 0 password mode NOT enabled. | ' +--------------+-----------------------------------------------------+ ' | The ExitCode% is derived from the unique CVI Basic command. | ' | The ExitCode% for the keys gets changed to 101 to 110. | ' | To enable programmers to use the CVI code in their own programs, | ' | I have attached a short program, KeyCode.Bas (just below this | ' | section) | ' +--------------------------------------------------------------------+ ' | ExitCode% = 101 is F1 key | ' | ExitCode% = 102 is F2 key | ' | ExitCode% = 103 is F3 key | ' | ExitCode% = 104 is F4 key | ' | ExitCode% = 105 is F5 key | ' | ExitCode% = 106 is F6 key | ' | ExitCode% = 107 is F7 key | ' | ExitCode% = 108 is F8 key | ' | ExitCode% = 109 is F9 key | ' | ExitCode% = 110 is F10 key | ' | ExitCode% = 13 is ENTER key | ' | ExitCode% = 18432 is Up Arrow | ' | ExitCode% = 20480 is Down Arrow | ' | ExitCode% = 9 is TAB key | ' | ExitCode% = 27 is EXIT key | ' +--------------------------------------------------------------------+ ' | Please include at the top of the routine DEFINT A-Z | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | 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 | ' | | ' +--------------------------------------------------------------------+ COLOR FGColr%, BGColr% IF See% = 1 THEN LOCATE Row%, Col%: PRINT STRING$(LenStr%, " "); END IF begin.edit.line: DO DO LOCATE Row%, Col%, 1, 6, 7 EdW$ = INKEY$ LOOP UNTIL LEN(EdW$) > 0 SlamKey% = CVI(EdW$ + CHR$(0)) ' IF SlamKey% > 31 AND SlamKey% < 256 THEN 'CHR$(31) to CHR$255) IF TypeOfText$ = "" THEN 'CHR$(32) is GOSUB show.char ELSEIF TypeOfText$ <> "" THEN IF INSTR(TypeOfText$, EdW$) > 0 THEN GOSUB show.char END IF END IF ELSEIF SlamKey% = 27 THEN ' Key ExitCode% = 27 GOSUB get.string EXIT SUB ELSEIF SlamKey% = 19712 THEN ' Arrow Col% = Col% + 1 IF Col% > FCol% + LenStr% - 1 THEN Col% = FCol% ELSE LOCATE Row%, Col%, 1, 6, 7 END IF ELSEIF SlamKey% = 19200 THEN ' Col% = Col% - 1 IF Col% = FCol% - 1 OR Col% < FCol% THEN Col% = FCol% + LenStr% - 1 END IF ELSEIF SlamKey% = 13 THEN ' GOSUB get.string ExitCode% = 13 EXIT SUB ' or or - If not used, REM these 3 out. ELSEIF SlamKey% = 9 OR SlamKey% = 18432 OR SlamKey% = 20480 THEN GOSUB get.string ExitCode% = SlamKey% EXIT SUB ELSEIF SlamKey% = 8 THEN ' Col% = Col% - 1 IF Col% = FCol% OR Col% < FCol% THEN Col% = FCol% END IF LOCATE Row%, Col%: PRINT " ": EdPW$ = LEFT$(EdPW$, LEN(EdPW$) - 1) ELSEIF SlamKey% = 21248 THEN ' SaveScr$ = SPACE$((FCol% + LenStr%) - Col% + 1) FOR DelK% = Col% + 1 TO FCol% + LenStr% SaveScr$ = SaveScr$ + CHR$(SCREEN(Row%, DelK%)) NEXT SaveScr$ = RTRIM$(LTRIM$(SaveScr$)) LOCATE Row%, Col%, 1 PRINT SaveScr$ + " "; ELSEIF SlamKey% = 18176 THEN ' Col% = FCol% ELSEIF SlamKey% = 20224 THEN ' GOSUB get.string Col% = FCol% + LEN(EdW$) LOCATE Row%, Col%, 1, 6, 7 ELSEIF SlamKey% = 25 THEN ' = clears line of LOCATE Row%, FCol% 'all text. WipeOut$ = SPACE$(LenStr%) PRINT WipeOut$ ELSEIF SlamKey% > 15103 OR SlamKey% < 17409 THEN ' to IdentKey$ = STR$(((SlamKey% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 110 GOSUB get.string EXIT SUB ELSE ExitCode% = VAL(IdentKey$) + 100 GOSUB get.string EXIT SUB END IF END IF END IF LOOP show.char: LOCATE Row%, Col% EdPW$ = EdPW$ + CHR$(SlamKey%) COLOR FGColr%, BGColr% IF Col% = FCol% + LenStr% THEN Col% = FCol% RETURN END IF IF PW% = 0 THEN IF Caps% > 0 THEN PRINT UCASE$(CHR$(SlamKey%)); ELSEIF Caps% = 0 THEN PRINT CHR$(SlamKey%); END IF ELSEIF PW% = 1 THEN LOCATE Row%, Col%: PRINT "ù"; LOCATE Row%, Col% + 1, 1, 6, 7 END IF Col% = Col% + 1 RETURN get.string: EditLine$ = SPACE$(LenStr%) FOR Horizontal% = FCol% TO FCol% + LenStr% EditLine$ = EditLine$ + CHR$(SCREEN(Row%, Horizontal%)) NEXT EditLine$ = LTRIM$(RTRIM$(EditLine$)) EdW$ = EditLine$ RETURN END SUB SUB MesaMenu (M$(), Start%, Count%, RegColrFG%, RegColrBG%, HiLiteFG%, HiLiteBG%, MaxScrRows%, MaxScrCols%, ColumnPointer%, TweenSpace%, TableULRow%, TableULCol%, CurrentRow%, CurrentCol%, ItemNum%, ItemWidth%, FKey$, ExitCode%) ' +--------------------------------------------------------------------+ ' | | ' | - S U B: M e s a M e n u - | ' | | ' | Public Domain - FreeWare | ' +--------------------------------------------------------------------+ ' | MesaMenu was created by Don Smith on 08/01/2002. MesaMenu is | ' | declared Public Domain FreeWare. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The MesaMenu name is abbreviated as MM to make it easier to | ' | enter at the command prompt. | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The object of MesaMenu is to display on screen a table menu | ' | of selected files on the current directory. When MM.Exe is used | ' | by itself instead of as a SUB, then enter as a parameter a group | ' | of files which have a common extension. Example: "MM *.txt" | ' | (without quotes) For this example, MesaMenu will bring up in a | ' | viewing window all files on the current directory having the | ' | extension of .TXT. To view ALL the files on the current directory, | ' | use "MM *.*" To view all your QuickBASIC files, use "MM *.bas" | ' | To view files having no extension, use "MM *." | ' | - - - - - - - - - - - - - - - - - - - - - - - - | ' | The program user may move the block cursor by pressing: | ' | . In | ' | addition, the user may press a letter, a number, an exclamation | ' | , or an underline <_>. The hi-lite cursor | ' | will jump to the first item beginning with the letter pressed, | ' | and, if there are any more items beginning with that letter, it | ' | will move down at each press of that letter. This SUB is not | ' | set up to use a mouse. | ' +----------------+---------------------------------------------------+ ' | M$() | Menu Item. In main program rediminsion: | ' | | REDIM M$(MaxNum% + 10) | ' +----------------+---------------------------------------------------+ ' | Start% | Which item to hi-light first. | ' +----------------+---------------------------------------------------+ ' | Count% | Count of total menu items. | ' +----------------+---------------------------------------------------+ ' | RegColrFG% | Regular fore ground color. | ' +----------------+---------------------------------------------------+ ' | RegColrBG% | Regular background color. | ' +----------------+---------------------------------------------------+ ' | HiLiteFG% | Hi-light foreground color. | ' +----------------+---------------------------------------------------+ ' | HiLiteBG% | Hi-light background color. | ' +----------------+---------------------------------------------------+ ' | MaxScrRows% | Number of rows to display on screen. | ' +----------------+---------------------------------------------------+ ' | MaxScrCols% | Number of columns to display on screen. | ' +----------------+---------------------------------------------------+ ' | ColumnPointer% | Points to current column in use. | ' +----------------+---------------------------------------------------+ ' | TweenSpace% | Number of spaces between columns. | ' +----------------+---------------------------------------------------+ ' | TableULRow% | Upper left row to place menu. | ' +----------------+---------------------------------------------------+ ' | TableULCol% | Upper left column to place menu. | ' +----------------+---------------------------------------------------+ ' | CurrentRow% | Current row of hi-light item. | ' +----------------+---------------------------------------------------+ ' | CurrentCol% | Current column of hi-light item. | ' +----------------+---------------------------------------------------+ ' | ItemNum% | Menu item number of the hi-lighted item. | ' | | In main program Start% and ItemNum% should be | ' | | the same. | ' +----------------+---------------------------------------------------+ ' | ItemWidth% | Width of menu items. | ' +----------------+---------------------------------------------------+ ' | FKey$ | To exit when an key is pressed, designate | ' | | the keys by placing them between paranthesis. | ' | | Example: FKey$ = "150". This means the SUB will | ' | | exit on pressing , or . The "0" | ' | | means "10". In the main program, indicate the | ' | | keys with ExitCode%. to is | ' | | ExitCode% = 1 to ExitCode% = 10. | ' | | | ' | | Example: | ' | | ------- | ' | | IF ExitCode% = 1 THEN ' | ' | | GOSUB save.screen | ' | | COLOR 15, 1: CLS | ' | | LOCATE 2, 33 | ' | | PRINT "Help Screen" | ' | | DO: LOOP WHILE INKEY$ = "" | ' | | GOSUB restore.screen | ' | | Start% = ItemNum% | ' | | GOTO begin.complete.menu | ' | | END IF | ' +----------------+---------------------------------------------------+ ' | ExitCode% | The exit number as explained below. | ' +--------------------------------------------------------------------+ ' | In the code below this REM (') section, find the area beginning | ' | "loopdeloop" and notice the keys trap below it. In QuickBASIC | ' | it is very easy to trap for any key on the keyboard by using the | ' | CVI command. It is accomplished through the use of a double | ' | DO/LOOP and then a series of IF/THENs (See Example). | ' | | ' | Example: | ' | ------- | ' | COLOR 15, 1: CLS | ' | PRINT "Press or X. To exit, press " | ' | PRINT | ' | DO | ' | DO | ' | Hit$ = INKEY$ | ' | LOOP UNTIL LEN(Hit$) > 0 | ' | Hit% = CVI(Hit$ + CHR$(0)) | ' | IF Hit% = 27 THEN ' | ' | CLS : END | ' | ELSEIF Hit% = 15104 THEN ' | ' | PRINT "F1 - Yeah!" | ' | ELSEIF Hit% = 24 THEN ' or | ' | PRINT "Ctrl-X. Yeah!" | ' | 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. | ' | ' | ' | ' +-------------------------------------------------------------+ | ' | ' | 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 15, 1: CLS | ' | LOCATE 2, 16 | ' | PRINT "Press a key and the CVI value will be displayed." | ' | LOCATE 4, 28 | ' | PRINT "(Press To Quit" | ' | LOCATE 5, 16: PRINT STRING$(47, "-") | ' | LOCATE 6, 24: LOCATE , , 1, 6, 7 | ' | DO | ' | DO | ' | k$ = INKEY$ | ' | IF k$ = CHR$(27) THEN | ' | LOCATE , 16 | ' | PRINT STRING$(47, "-") | ' | LOCATE , 34: PRINT "Program Ends": PRINT : PRINT | ' | END | ' | END IF | ' | LOOP UNTIL k$ <> "" | ' | KeyCode% = CVI(k$ + CHR$(0)) | ' | Key$ = STR$(KeyCode%) | ' | Sp$ = STRING$(9, ".") | ' | IF KeyCode% = 13 THEN | ' | LOCATE , 31, 0, 0, 0 | ' | PRINT "Enter" + Sp$ + Key$ | ' | ELSEIF KeyCode% = 255 THEN | ' | LOCATE , 25, 0, 0, 0 | ' | PRINT "Blank Space" + Sp$ + Key$ | ' | ELSEIF KeyCode% < 256 THEN | ' | LOCATE , 35, 0, 0, 0 | ' | PRINT k$ + Sp$ + Key$ | ' | ELSEIF KeyCode% > 255 THEN | ' | LOCATE , 24, 0, 0, 0 | ' | PRINT "Extended Key" + Sp$ + Key$ | ' | END IF | ' | LOOP | ' | | ' +--------------------------------------------------------------------+ FOR EqWidth% = 1 TO Count% 'make all M$ items of equal length M$(EqWidth%) = M$(EqWidth%) + SPACE$(ItemWidth% - LEN(M$(EqWidth%))) NEXT subtop: DivideIt% = Count% \ MaxScrRows% Remainder% = Count% MOD MaxScrRows% IF Remainder% > 0 THEN Remainder% = 1 END IF NumColsPossible% = DivideIt% + Remainder% LeftOver% = Count% MOD MaxScrRows% 'Count of items of last row IF Start% = 1 THEN CurrentRow% = TableULRow% CurrentCol% = TableULCol% ColumnPointer% = 1 ELSE LocateRow% = Start% MOD MaxScrRows% IF LocateRow% = 0 THEN LocateRow% = MaxScrRows% ColumnPointer% = (Start% \ MaxScrRows%) ELSE ColumnPointer% = (Start% \ MaxScrRows%) + 1 END IF CurrentRow% = TableULRow% + LocateRow% - 1 LocateCol% = (Start% \ MaxScrRows%) IF Start% MOD MaxScrRows% > 0 THEN LocateCol% = LocateCol% + 1 END IF IF LocateCol% > MaxScrCols% THEN LocateCol% = LocateCol% - MaxScrCols% FOR Spy% = 1 TO NumColsPossible% IF LocateCol% > MaxScrCols% THEN LocateCol% = LocateCol% - MaxScrCols% END IF IF LocateCol% <= MaxScrCols% THEN EXIT FOR END IF NEXT TheFactor% = ColumnPointer% \ MaxScrCols% IF ColumnPointer% MOD MaxScrCols% = 0 THEN show% = (MaxScrCols% * MaxScrRows%) * (TheFactor% - 1) ELSE show% = (MaxScrCols% * MaxScrRows%) * TheFactor% END IF IF LocateCol% <= 1 THEN CurrentCol% = TableULCol% END IF END IF END IF IF CurrentCol% < TableULCol% THEN CurrentCol% = TableULCol% + ((LocateCol% - 1) * (ItemWidth% + TweenSpace%)) END IF bring.in.display: FOR Display% = TableULRow% TO TableULRow% + MaxScrRows% - 1 COLOR RegColrFG%, RegColrBG% LOCATE Display%, TableULCol% show% = show% + 1 IF show% <= Count% THEN PRINT M$(show%) + SPACE$(TweenSpace%); ELSE PRINT SPACE$(ItemWidth% + TweenSpace%); END IF FOR ExecuteNext% = 1 TO MaxScrCols% - 1 IF show% + (ExecuteNext% * MaxScrRows%) <= Count% THEN IF LEN(M$(show% + (ExecuteNext% * MaxScrRows%))) = ItemWidth% THEN PRINT M$(show% + (ExecuteNext% * MaxScrRows%)) + SPACE$(TweenSpace%); ELSEIF LEN(M$(show% + (ExecuteNext% * MaxScrRows%))) = 0 THEN PRINT SPACE$(ItemWidth% + TweenSpace%); END IF ELSE IF Count% > (MaxScrRows% * MaxScrCols%) THEN PRINT SPACE$(ItemWidth% + TweenSpace%); END IF END IF NEXT NEXT COLOR HiLiteFG%, HiLiteBG% LOCATE CurrentRow%, CurrentCol%, 0 PRINT M$(ItemNum%) loopdeloop: DO DO HitKey$ = INKEY$ LOOP UNTIL LEN(HitKey$) > 0 Hit% = CVI(HitKey$ + CHR$(0)) LOCATE CurrentRow%, CurrentCol% COLOR RegColrFG%, RegColrBG% PRINT M$(ItemNum%); IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB ELSEIF Hit% = 13 THEN ' ExitCode% = 13 EXIT SUB ELSEIF Hit% = 20480 THEN ' IF LeftOver% = 0 AND ItemNum% = Count% THEN CurrentRow% = TableULRow% - 1 ItemNum% = Count% - MaxScrRows% END IF IF ItemNum% < Count% THEN CurrentRow% = CurrentRow% + 1 ItemNum% = ItemNum% + 1 IF CurrentRow% = TableULRow% + MaxScrRows% THEN CurrentRow% = TableULRow% ItemNum% = ItemNum% - MaxScrRows% END IF ELSE CurrentRow% = TableULRow% ItemNum% = Count% - LeftOver% + 1 END IF ELSEIF Hit% = 18432 THEN ' CurrentRow% = CurrentRow% - 1 ItemNum% = ItemNum% - 1 IF CurrentRow% = TableULRow% - 1 THEN CurrentRow% = TableULRow% + MaxScrRows% - 1 ItemNum% = ItemNum% + MaxScrRows% IF ItemNum% > Count% THEN ItemNum% = Count% CurrentRow% = TableULRow% + LeftOver% - 1 END IF END IF ELSEIF Hit% = 19712 THEN ' IF ItemNum% <= Count% - LeftOver% THEN CurrentCol% = CurrentCol% + TweenSpace% + ItemWidth% ItemNum% = ItemNum% + MaxScrRows% ColumnPointer% = ColumnPointer% + 1 IF ItemNum% > Count% THEN ItemNum% = Count% IF LeftOver% = 0 THEN CurrentCol% = CurrentCol% - (TweenSpace% + ItemWidth%) CurrentRow% = TableULRow% + MaxScrRows% - 1 ItemNum% = Count% ColumnPointer% = ColumnPointer% - 1 ELSEIF LeftOver% > 0 THEN CurrentRow% = TableULRow% + LeftOver% - 1 END IF END IF END IF IF ColumnPointer% > MaxScrCols% THEN Start% = ItemNum% show% = 0 ColumnPointer% = 0 GOTO subtop END IF ELSEIF Hit% = 19200 THEN ' IF ColumnPointer% <= 0 THEN ColumnPointer% = 1 END IF IF ColumnPointer% > 1 THEN CurrentCol% = CurrentCol% - (TweenSpace% + ItemWidth%) ItemNum% = ItemNum% - MaxScrRows% ColumnPointer% = ColumnPointer% - 1 END IF IF ColumnPointer% >= MaxScrCols% THEN ColumnPointer% = 0 Start% = ItemNum% show% = 0 GOTO subtop END IF ELSEIF Hit% = 18176 THEN ' CurrentRow% = 0 CurrentCol% = 0 show% = 0 ItemNum% = 1 Start% = 1 GOTO subtop ELSEIF Hit% = 20224 THEN ' show% = 0 ItemNum% = Count% Start% = Count% CurrentCol% = 0 GOTO subtop ELSEIF Hit% = 20736 THEN ' ItemNum% = ItemNum% + (MaxScrRows% * MaxScrCols%) IF ItemNum% > Count% THEN ItemNum% = Count% END IF Start% = ItemNum% CurrentCol% = 0 show% = 0 GOTO subtop ELSEIF Hit% = 18688 THEN ' ItemNum% = ItemNum% - (MaxScrRows% * MaxScrCols%) IF ItemNum% <= 0 THEN ItemNum% = 1 END IF Start% = ItemNum% CurrentCol% = 0 show% = 0 GOTO subtop ELSEIF Hit% = 32 THEN ' ExitCode% = 32 EXIT SUB 'PRESS: Letters A - Z (or a - z), Numbers 0 - 9, ' Exclamation , or Underline <_>. ELSEIF Hit% > 64 AND Hit% < 91 OR Hit% > 96 AND Hit% < 123 OR Hit% > 47 AND Hit% < 58 OR Hit% = 33 OR Hit% = 95 THEN IF Hit% > 96 AND Hit% < 123 THEN Hit% = Hit% - 32 END IF FOR XYZ% = 1 TO Count% Letr$ = LEFT$(M$(XYZ%), 1) IF XYZ% = Count% AND ASC(Letr$) <> Hit% THEN show% = 0 GOTO subtop ELSEIF ASC(Letr$) = Hit% THEN EXIT FOR END IF NEXT FOR YYY% = 1 TO Count% CurrentLetr$ = LEFT$(M$(ItemNum%), 1) IF CurrentLetr$ <> FindLetr$ THEN TryLetters% = 0 END IF NEXT TryLetters% = TryLetters% + 1 FOR zzz% = TryLetters% TO Count% FindLetr$ = LEFT$(M$(zzz%), 1) IF ASC(FindLetr$) = Hit% THEN Start% = zzz% TryLetters% = zzz% ItemNum% = Start% ColumnPointer% = 0 show% = 0 CurrentCol% = 0 IF zzz% = Count% THEN ItemNum% = Count% TryLetters% = 0 END IF GOTO subtop END IF IF zzz% = Count% THEN zzz% = 0 END IF NEXT ELSEIF Hit% > 15103 AND Hit% < 17409 THEN 'F1 - F10 IdentKey$ = STR$(((Hit% - 15104) \ 256) + 1) IdentKey$ = LTRIM$(RTRIM$(IdentKey$)) IF IdentKey$ = "10" THEN IdentKey$ = "0" END IF IF INSTR(FKey$, IdentKey$) > 0 THEN IF IdentKey$ = "0" THEN ExitCode% = 10 EXIT SUB ELSE ExitCode% = VAL(IdentKey$) EXIT SUB END IF END IF END IF LOCATE CurrentRow%, CurrentCol% COLOR HiLiteFG%, HiLiteBG% PRINT M$(ItemNum%); LOOP END SUB SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%) '+----------------------------------------------------------------------+ '| SUB written by Don Smith on 03/25/02 - Public Domain FreeWare. | '| No need to name Don as the author. EMail: smithdonb@earthlink.net | '+----------------------------------------------------------------------+ '+----------------------------------------------------------------------+ '| 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 program | '| | 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 program please! | '+-----------------------------+----------------------------------------+ 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.da.screen ELSEIF SaveOrRest% = 2 THEN GOSUB restore.da.screen END IF EXIT SUB save.da.screen: 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.da.screen: 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 SUB TinyBox (ULRow, ULCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub) ' +----------------------------------------------------------------------+ ' | SUB TinyBox | ' +----------------------------------------------------------------------+ ' | ULRow = Upper Left Row. ULCol = Upper Left Column. | ' | LRRow = Lower Right Row. LRCol = Lower Right Column. | ' | BoxFGColr = The Foreground Color The Box. | ' | BoxBGColr = The Back Ground Color Of The Box. | ' | SingOrDoub = 1 (Single Line Box). SingOrDoub = 2 (Double Line Box). | ' +----------------------------------------------------------------------+ COLOR BoxFGColr, BoxBGColr IF SingOrDoub = 1 THEN LOCATE ULRow, ULCol PRINT CHR$(218) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(191); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(179) + STRING$(LRCol - ULCol, " ") + CHR$(179); NEXT LOCATE LRRow, ULCol PRINT CHR$(192) + STRING$(LRCol - ULCol, CHR$(196)) + CHR$(217); ELSEIF SingOrDoub = 2 THEN LOCATE ULRow, ULCol PRINT CHR$(201) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(187); FOR BoxY = ULRow + 1 TO LRRow - 1 LOCATE BoxY, ULCol PRINT CHR$(186) + STRING$(LRCol - ULCol, " ") + CHR$(186); NEXT LOCATE LRRow, ULCol PRINT CHR$(200) + STRING$(LRCol - ULCol, CHR$(205)) + CHR$(188); END IF END SUB