SUB LongMenu (LM$(), ULRowLM%, ULColLM%, LRRowLM%, LRColLM%, LMColrFG%, LMColrBG%, LMHiLiteFG%, LMHiLiteBG%, FKey$, MaxNum%, Selection%, ExitCode%, CurrentRow%) ' +--------------------------------------------------------------------+ ' | - S U B L o n g M e n u - | ' | | ' | Public Domain - FreeWare | ' +--------------------------------------------------------------------+ ' | Author: Donald B. "Don" Smith | ' | Email : smithdonb@earthlink.net | ' | Date : 08/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. | ' +--------------------------------------------------------------------+ ' +--------------------------------------------------------------------+ ' | SUB LongMenu | ' +--------------------------------------------------------------------+ ' | The SUB LongMenu was written by Don Smith on 08/01/2002. It is | ' | Public Domain FreeWare. LongMenu is a one-column menu with a | ' | block cursor. To move the cursor, use: , , | ' | , , , , , , | ' | or . SUB is 169 lines long not counting REM (') lines. | ' +--------------+-----------------------------------------------------+ ' | LM$() | These are menu items which should be REDIMed in | ' | | the main program. | ' +--------------+-----------------------------------------------------+ ' | ULRowLM% | (U)Upper (L)left (R)row to place (L)long (M)menu. | ' +--------------+-----------------------------------------------------+ ' | ULColLM% | (U)Upper (L)left (C)column to place (L)long (M)menu.| ' +--------------+-----------------------------------------------------+ ' | LRRowLM% | (L)Lower (R)right (R)row to place (L)long (M)menu. | ' +--------------+-----------------------------------------------------+ ' | LRColLM% | (L)Lower (R)right (C)column to place (L)long (M)menu| ' +--------------+-----------------------------------------------------+ ' | LMColrFG% | (L)Long (M)menu (F)fore (G)ground color. | ' +--------------+-----------------------------------------------------+ ' | LMColrBG% | (L)Long (M)menu (B)back (G)ground color. | ' +--------------+-----------------------------------------------------+ ' | LMHiLiteFG% | (L)Long (M)menu Hilite (F)fore (G)ground color. | ' +--------------+-----------------------------------------------------+ ' | LMHiLiteBG% | (L)Long (M)menu Hilite (B)back (G)ground color. | ' +--------------+-----------------------------------------------------+ ' | FKey$ | FKey$ is set to reflect to keys. | ' | | ExitCode% is set by programs as follows: | ' | | is ExitCode% = 1 TO is ExitCode% = 10 | ' | | | ' | | Example how to set in main program: | ' | | ---------------------------------- | ' | | Example: FKey$ = "150". This means that | ' | | and are "turned on" such that if the user | ' | | presses one of these keys, the program will | ' | | exit with the appropriate ExitCode% number. By | ' | | the way, the "0" in FKey$ = "150" is used for | ' | | , and if is pressed, the SUB will exit | ' | | with ExitCode% = 10. Also read ExitCode% below. | ' +--------------+-----------------------------------------------------+ ' | MaxNum% | The maximum number of menu items. | ' +--------------+-----------------------------------------------------+ ' | Selection% | The selection which the cursor is resting on. | ' | | In main program, set Selection% = 1 | ' +--------------+-----------------------------------------------------+ ' | CurrentRow% | The current row the cursor is resting on. | ' | | In main program, set CurrentRow% = ULRowLM% | ' +--------------+-----------------------------------------------------+ ' | ExitCode% | The ExitCode% is a unique number set by the | ' | | programmer. The SUB LongMenu will exit the SUB on | ' | | three occasions, when the user presses: , | ' | | , , , or . In the main program | ' | | just below the SUB, you must write the code to take | ' | | care of these key presses. The ExitCode% may be | ' | | any number the programmer wishes. In most cases, | ' | | I prefer to use the same number as the unique | ' | | number set by the CVI command. Below find | ' | | the double DO:LOOP and Hit% = CVI(Hit$ + CHR$(0)) | ' | | | ' | | do.loop: | ' | | DO | ' | | DO | ' | | Hit$ = INKEY$ | ' | | LOOP UNTIL LEN(Hit$) > 0 | ' | | Hit% = CVI(Hit$ + CHR$(0)) | ' | | - - - - - - - - | ' | | (more code here) | ' | | - - - - - - - - | ' | | LOOP | ' | | | ' | | This double DO:LOOP sets up the special CVI | ' | | numbers; if fact, just about any key or key | ' | | combination may be trapped using the CVI code. | ' | | See KEYCODE.BAS program below. | ' | | | ' | | For the key numbers, I prefer to use | ' | | ExitCode% 1-10; this is easier than using hugh | ' | | CVI numbers like 15103 . | ' | | | ' | | I like to use the double DO:LOOP (see above), | ' | | followed by a series of IFs and ELSEIFs. | ' | | If you would like to use a special key, like | ' | | Q (4096) for example, the attached | ' | | KEYCODE.BAS will give you the CVI numbers you | ' | | need for your program. In this case Q | ' | | would be set up like this: | ' | | | ' | | (This is inside the SUB) | ' | | DO | ' | | DO | ' | | Hit$ = INKEY$ | ' | | LOOP UNTIL LEN(Hit$) > 0 | ' | | Hit% = CVI(Hit$ + CHR$(0)) | ' | | IF Hit% = 27 THEN ' | ' | | ExitCode% = 27 | ' | | ELSEIF Hit% = 4096 THEN ' Q | ' | | ExitCode% = 4096 | ' | | END IF | ' | | LOOP | ' | | | ' | | Once the SUB is exited, the code would look | ' | | something like this: | ' | | | ' | | CALL LongMenu(- - - - -stuff goes here- - - - -) | ' | | | ' | | IF ExitCode% = 27 THEN ' | ' | | LOCATE , , 1, 6, 7: END | ' | | ELSEIF ExitCode% = 4096 THEN ' Q | ' | | COLOR 15, 2: CLS | ' | | PRINT "Help Screen" | ' | | DO: LOOP WHILE INKEY$ = "" | ' | | END IF | ' | | | ' | | The CVI numbers used in the SUB LongMenu are: | ' | | -------------------------------------------- | ' | | Hit% = 18176 | ' | | Hit% = 20224 | ' | | Hit% = 20480 | ' | | Hit% = 20736 | ' | | Hit% = 19712 | ' | | Hit% = 18432 | ' | | Hit% = 18688 | ' | | Hit% = 19200 | ' | | Hit% = 65-90 Letters To | ' | | Hit% = 48-57 Numbers <0> To <9> | ' | | | ' | | Use KEYCODE.BAS program below to find the CVI | ' | | code for keys you need for your program. | ' | | | ' +--------------+-----------------------------------------------------+ ' | 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 | ' | 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 | ' +--------------------------------------------------------------------+ SetPage% = LRRowLM% - ULRowLM% + 1 IF Selection% = 1 THEN Foxy% = 0 ELSEIF Selection% > 1 THEN Foxy% = Selection% - (CurrentRow% - ULRowLM%) - 1 END IF subtop: COLOR LMColrFG%, LMColrBG% FOR BringItems% = ULRowLM% TO LRRowLM% Foxy% = Foxy% + 1 LOCATE BringItems%, ULColLM%, 0 PRINT SPACE$(LRColLM% - ULColLM% + 1) IF Foxy% <= MaxNum% THEN LOCATE BringItems%, ULColLM% PRINT LM$(Foxy%) END IF NEXT Foxy% = Foxy% - (LRRowLM% - ULRowLM%) - 1 LOCATE CurrentRow%, ULColLM%, 0 COLOR LMHiLiteFG%, LMHiLiteBG% PRINT LM$(Selection%) do.loop: DO DO Hit$ = INKEY$ LOOP UNTIL LEN(Hit$) > 0 Hit% = CVI(Hit$ + CHR$(0)) LOCATE CurrentRow%, ULColLM%, 0 COLOR LMColrFG%, LMColrBG% PRINT LM$(Selection%) IF Hit% = 27 THEN ' ExitCode% = 27 EXIT SUB ELSEIF Hit% = 13 THEN ' ExitCode% = 13 EXIT SUB ELSEIF Hit% = 18176 THEN ' Selection% = 1 Foxy% = 0 CurrentRow% = ULRowLM% GOTO subtop ELSEIF Hit% = 20224 THEN ' Selection% = MaxNum% GOSUB end.james ELSEIF Hit% = 20480 THEN ' IF Selection% = MaxNum% THEN GOTO subtop END IF Selection% = Selection% + 1 SetCurrSel% = Selection% IF CurrentRow% > LRRowLM% - 1 THEN CurrentRow% = LRRowLM% Foxy% = Foxy% + 1 GOTO subtop END IF IF CurrentRow% <= LRRowLM% AND Selection% <= MaxNum% THEN CurrentRow% = CurrentRow% + 1 ELSEIF Selection% > MaxNum% THEN Selection% = MaxNum% END IF ELSEIF Hit% = 20736 OR Hit% = 19712 THEN ' Foxy% = Selection% + (LRRowLM% - CurrentRow%) SetCurrSel% = Selection% TempRow% = CurrentRow% Selection% = Selection% + SetPage% IF Selection% >= MaxNum% THEN Selection% = MaxNum% CurrentRow% = TempRow% + (MaxNum% - SetCurrSel%) IF CurrentRow% > LRRowLM% THEN CurrentRow% = LRRowLM% END IF Foxy% = Selection% - SetPage% + (LRRowLM% - CurrentRow%) GOTO subtop GOTO do.loop END IF GOTO subtop ELSEIF Hit% = 18432 THEN ' Selection% = Selection% - 1 IF CurrentRow% > ULRowLM% THEN CurrentRow% = CurrentRow% - 1 ELSEIF CurrentRow% = ULRowLM% THEN CurrentRow% = ULRowLM% IF Selection% >= 1 THEN Foxy% = Foxy% - 1 GOTO subtop ELSE Selection% = 1 END IF END IF ELSEIF Hit% = 18688 OR Hit% = 19200 THEN ' Selection% = Selection% - SetPage% Foxy% = Selection% - SetPage% + (LRRowLM% - CurrentRow%) IF Selection% < 1 THEN Selection% = 1 Foxy% = 0 CurrentRow% = ULRowLM% GOTO subtop END IF IF Foxy% < 0 THEN Selection% = 1 CurrentRow% = ULRowLM% Foxy% = 0 END IF GOTO subtop '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 MaxNum% Letr$ = LEFT$(LM$(XYZ%), 1) IF XYZ% = MaxNum% AND ASC(Letr$) <> Hit% THEN GOTO subtop ELSEIF ASC(Letr$) = Hit% THEN EXIT FOR END IF NEXT TryLetters% = TryLetters% + 1 FOR ZZZ% = TryLetters% TO MaxNum% FindLetr$ = LEFT$(LM$(ZZZ%), 1) IF ASC(FindLetr$) = Hit% THEN Selection% = ZZZ% TryLetters% = ZZZ% CurrentRow% = ULRowLM% Foxy% = Selection% - 1 IF ZZZ% = MaxNum% THEN Selection% = MaxNum% TryLetters% = 0 END IF GOTO subtop END IF IF ZZZ% = MaxNum% 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%, ULColLM%, 0 COLOR LMHiLiteFG%, LMHiLiteBG% PRINT LM$(Selection%) LOOP end.james: CurrentRow% = LRRowLM% Selection% = MaxNum% Foxy% = MaxNum% - (LRRowLM% - ULRowLM%) - 1 GOTO subtop RETURN END SUB