home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / baswind8.zip / MENU123.SUB < prev    next >
Text File  |  1990-09-14  |  15KB  |  392 lines
  1. '
  2. '
  3. '******************************************************************************
  4. '                    Function : MENU123                                       *
  5. '                                                                             *
  6. ' Purpose:                                                                    *
  7. '                                                                             *
  8. '                                                                             *
  9. ' Results:                                                                    *
  10. '                                                                             *
  11. ' Usage  :                                                                    *
  12. '                                                                             *
  13. '                                                                             *
  14. ' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan    *
  15. ' Date Modified:          -            :          -       :                   *
  16. '-----------------------------------------------------------------------------*
  17. ' NOTE:                                                                       *
  18. '******************************************************************************
  19. '                                                                             *
  20. '     SUB PROGRAM NAME          (PARAMETERS)                 STATIC/RECURSIVE *
  21. '-----------------------------------------------------------------------------*
  22. '                                                                             *
  23. SUB    MENU123(MENULINE$,MENUROW%,MENUFG%,MENUBG%,ITEMNUM%,ITEMDESC$(1),ITEMSLCT%,RETURN.CODE%) STATIC
  24.  
  25.        DEFINT A-Z                               'make all short intergers by default
  26.  
  27.        RETURN.CODE%=0
  28.        VIDEO.RETURN.CODE=0
  29.  
  30.        ITEMDESC.MIN=LBOUND(ITEMDESC$)           'adjust to callers "OPTION BASE"
  31.        ITEMDESC.MAX=UBOUND(ITEMDESC$)
  32.  
  33.        ITEM.BASE=1-ITEMDESC.MIN                 'normalize
  34.  
  35. REM    $DYNAMIC
  36.        DIM ITEMS%(80,2)                         'starting-ending screen locations for each option
  37. REM    $STATIC
  38.  
  39.        MENUCOL=1
  40.        DESCROW=MENUROW%+1                       'option description is on line just below options
  41.        DESCCOL=2
  42.  
  43.        BUTTONS%=0                               'assume no mouse support avail
  44.  
  45.        CLICK=0
  46.  
  47.        CALL MMCHECK(BUTTONS%)                   'see if mouse support avail
  48.  
  49.        MOUSECOL=0                               'locate the mouse cursor in upper
  50.        MOUSEROW=0                               'left top corner of screen
  51.  
  52.        CALL MMSETLOC(MOUSECOL,MOUSEROW)
  53.  
  54.        CALL MMCURSORON                          'turn on  mouse cursor for now
  55.  
  56.        FIRST.TIME=-1
  57.  
  58. 'MAKE SURE MENULINE$ HAS SPACES AT BEGINNING AND END
  59.  
  60.        MENULINE$=LTRIM$(MENULINE$)              'remove leading and trailing spaces
  61.        MENULINE$=RTRIM$(MENULINE$)
  62.  
  63.        IF LEN(MENULINE$)>78 THEN                'if menu line too long, make it the right size
  64.            MENULINE$=LEFT$(MENULINE$,78)
  65.        END IF
  66.  
  67.        MENULINE$=" "+MENULINE$+" "              'delimit menu line with a space
  68.  
  69.        GOSUB MENU123.OFFWORD                    'PRINT TOP MENU BAR LINE
  70.  
  71. '
  72. '
  73. ' locate  each unique option on the menu line
  74.  
  75.        COUNT=0
  76.        I=1
  77. MENU123.NEXT.ITEM:
  78.        FOR I=I TO LEN(MENULINE$)                'scan over spaces
  79.            IF MID$(MENULINE$,I,1)=" " THEN
  80.                GOTO MENU123.NEXT.CHAR
  81.            END IF
  82.  
  83.            COUNT=COUNT+1                        'keep track of number of menu items
  84.            ITEMS%(COUNT,1)=I                    'record the screen column where this option started
  85.            FOR J=I TO LEN(MENULINE$)            'look for space to terminate this option
  86.                IF MID$(MENULINE$,J,1)=" " THEN
  87.                    ITEMS%(COUNT,2)=J-1
  88.                    I=J+1                        'record the screen column where this option ended
  89.                  GOTO MENU123.NEXT.ITEM
  90.                END IF
  91.  
  92.            NEXT
  93.  
  94.            ITEMS%(COUNT,2)=J
  95.  
  96. MENU123.NEXT.CHAR:
  97.        NEXT
  98.  
  99.        IF ITEMNUM%<>COUNT THEN                  'make number items agree with what we found
  100.            ITEMNUM%=COUNT
  101.        END IF
  102.  
  103. 'SET FIRST MENU ITEM TO REVERSE VIDEO & DISPLAY FIRST DESCRIPTION
  104.  
  105.        IF ITEMSLCT%<1 OR ITEMSLCT%>ITEMNUM% THEN
  106.           ITEMSLCT%=1
  107.        END IF
  108.  
  109.        ITEM%=ITEMSLCT%                           'start with the item the user wants
  110.  
  111.        ITEMSLCT%=0
  112. '
  113. 'ENTER MENU LOOP AND WAIT FOR SELECTION OR [ESCAPE]
  114. MENU123.LOOP:
  115.        GOSUB MENU123.DISPLAY           'Update Position of Selection Marker
  116.        GOSUB MENU123.PRESS             'Get KeyPress
  117.  
  118.        IF KP$=CHR$(13) THEN            'an option selected if enter pressed
  119.           GOTO MENU123.DONE
  120.        END IF
  121.  
  122.        IF KP$=CHR$(27) THEN            'this function aborted if ESC pressed
  123.            ITEM%=0
  124.            RETURN.CODE%=-1
  125.          GOTO MENU123.DONE
  126.        END IF
  127.  
  128.        GOTO MENU123.LOOP
  129.  
  130. '
  131. 'GIVEN ITEM NUMBER, TURN ASSOCIATED WORD IN MENU BAR TO REVERSE VIDEO AND DISPLAY ASSOCIATED DESCRIPTION
  132. MENU123.DISPLAY:
  133.        GOSUB MENU123.FINDWORD           'Find word associated with Item Number
  134.        GOSUB MENU123.OFFWORD            'Turn off old word
  135.        GOSUB MENU123.ONWORD             'Turn on new word
  136.        GOSUB MENU123.DESCRIPT           'Print Description
  137.        RETURN
  138.  
  139. '
  140. 'Find position of selected word in Menu Bar
  141. MENU123.FINDWORD:
  142.        BEGWORD=ITEMS%(ITEM%,1)            'get the starting and ending position of item on menu line
  143.        ENDWORD=ITEMS%(ITEM%,2)
  144.  
  145.        RETURN
  146.  
  147. '
  148. 'RESTORE ENTIRE MENU LINE TO NORMAL VIDEO
  149. MENU123.OFFWORD:
  150.        CALL MMCURSOROFF
  151.  
  152.        ATTR=(MENUBG% * 16)+MENUFG%
  153.        CALL FASTPRT(MENULINE$,MENUROW%,MENUCOL,ATTR,VIDEO.RETURN.CODE)
  154.  
  155.        CALL MMCURSORON
  156.  
  157.        RETURN
  158.  
  159. '
  160. MENU123.ONWORD:
  161.        CALL MMCURSOROFF
  162.  
  163.        WORDLEN=(ENDWORD-BEGWORD)+1               'calculate length of menu item
  164.        DAT$=MID$(MENULINE$,BEGWORD,WORDLEN)      'and get it out of the menu line
  165.        ATTR=(MENUFG% * 16)+MENUBG%               'display the menu item as highlighted
  166.        CALL FASTPRT(DAT$,MENUROW%,BEGWORD,ATTR,VIDEO.RETURN.CODE)
  167.  
  168.        IF FIRST.TIME THEN
  169.            MOUSEROW=(MENUROW%-1)*8                   'if so, put the mouse cursor on the new selection
  170.            MOUSECOL=(BEGWORD-1)*8
  171.            CALL MMSETLOC(MOUSECOL,MOUSEROW)
  172. '          FIRST.TIME=0
  173.        END IF
  174.  
  175.        CALL MMCURSORON
  176.  
  177.        OLD.ITEM%=ITEM%                              'remember which item is the current highlighted item
  178.  
  179.        RETURN
  180.  
  181. '
  182. 'Print Associated Description Underneath Menu Line
  183. MENU123.DESCRIPT:
  184.        CALL MMCURSOROFF
  185.  
  186.        ATTR=(MENUBG% * 16)+MENUFG%
  187.        ITEM.SUB=ITEM%-ITEM.BASE                   'get the current items associated description
  188.        DAT$=STRING$(80," ")
  189.        MID$(DAT$,2,78)=ITEMDESC$(ITEM.SUB)        'delimit it with spaces
  190.        CALL FASTPRT(DAT$,DESCROW,1,ATTR,VIDEO.RETURN.CODE)          'display it under the menu line
  191.  
  192.        CALL MMCURSORON
  193.  
  194.        DAT$=""                                    'free up the string space
  195.        RETURN
  196.  
  197. '
  198. 'Check for KeyPress and sound error if not LEFT ARROW, RIGHT ARROW, ESCAPE or RETURN
  199. MENU123.PRESS:
  200.        GOSUB MENU123.GET.PRESS
  201.  
  202.        IF KP$="" THEN                             'wait for a keypress or mouse click
  203.            GOTO MENU123.PRESS
  204.        END IF
  205.  
  206.        IF LEN(KP$)=2 THEN                         'was an extended fucnction key pressed
  207.            GOTO MENU123.PRESS.EXTENDED
  208.        END IF
  209.  
  210.        IF KP$=CHR$(13) THEN                       'was the ENTER key pressed
  211.            RETURN
  212.        END IF
  213.  
  214.        IF KP$=CHR$(27) THEN                       'was the ESC key pressed
  215.            ITEM%=0                                 'indicate that selection was Aborted
  216.          RETURN
  217.        END IF
  218.  
  219.        GOSUB MENU123.FIND.OPTION                  'see if keypress matches any menu item
  220.  
  221.        IF ITEM%<>SAVE.ITEM THEN                    'did we finf a new matching item
  222.           RETURN
  223.        END IF
  224.  
  225.        GOSUB MENU123.SOUNDOFF                     'NO, let user know
  226.        GOTO MENU123.PRESS
  227.  
  228. '
  229. 'Process RIGHT ARROW KeyPress
  230. MENU123.PRESS.EXTENDED:
  231.        IF ASC(RIGHT$(KP$,1))=77 THEN              'cursor right key pressed
  232.             ITEM%=ITEM%+1                           'point to next item
  233.           IF ITEM% > ITEMNUM% THEN                 'are we past the end of the items
  234.               ITEM% = 1                            'yes, loop back to the first item
  235.             RETURN
  236.           ELSE
  237.             RETURN
  238.           END IF
  239.        END IF
  240.  
  241. 'Process LEFT ARROW KeyPress
  242.        IF ASC(RIGHT$(KP$,1))=75 THEN               'cursor left key pressed
  243.             ITEM%=ITEM%-1                            'look at the previous item in the menu
  244.           IF ITEM% < 1 THEN                         'are we part the start of the forst menu item
  245.               ITEM% = ITEMNUM%                      'yes, loop to the last item in the menu
  246.             RETURN
  247.           ELSE
  248.             RETURN
  249.           END IF
  250.        END IF
  251.  
  252.        GOSUB MENU123.SOUNDOFF                      'let user know an invalid key was pressed
  253.        GOTO MENU123.PRESS
  254.  
  255. '
  256. MENU123.FIND.OPTION:
  257.        SAVE.ITEM=ITEM%                              'remember which item is the current one
  258.        IF KP$<" " OR KP$>CHR$(126) THEN            'only look for printable characters
  259.            RETURN
  260.        END IF
  261.  
  262.        FIRST.CHAR$=KP$                             'this is the character user wants a matching menu item
  263.  
  264. ' make comparison test case in-sensative
  265. '
  266.        FIRST.CHAR$=UCASE$(FIRST.CHAR$)
  267.  
  268.        TEMP.ITEM=ITEM%+1                            'start with next item in the menu list
  269.  
  270.        COUNT=0                                     'keep track of number of menu items we have checked
  271. MENU123.FIND.OPTION.CONT:
  272.        IF TEMP.ITEM>ITEMNUM% THEN                  'are we past the end of the items
  273.           TEMP.ITEM=1                              'so start back with the first item in the list
  274.        END IF
  275.  
  276.        COUNT=COUNT+1                               'keep track of the number of items we have looked at
  277.        IF COUNT>ITEMNUM% THEN                      'have we looked at all the items
  278.           RETURN                                   'YES, no match was found
  279.        END IF
  280.  
  281. '
  282. 'Does the first character of this item match the one the user wants
  283. '
  284. ' make the test case in-sensative
  285.  
  286.        IF UCASE$(MID$(MENULINE$,ITEMS%(TEMP.ITEM,1),1))=FIRST.CHAR$ THEN
  287.            ITEM%=TEMP.ITEM%                         'we found a match!
  288.          RETURN
  289.        END IF
  290.  
  291.        TEMP.ITEM=TEMP.ITEM+1                        'no match, look at the next item
  292.  
  293.        GOTO MENU123.FIND.OPTION.CONT
  294.  
  295. '
  296. MENU123.GET.PRESS:
  297.        IF BUTTONS%=0 THEN                       'mouse supported
  298.           GOTO MENU123.GET.INKEY                'no
  299.        END IF
  300.  
  301.        CALL MMGETLOC(MOUSECOL,MOUSEROW)         'get the current mouse cursor location
  302.  
  303.        MOUSECOL=(MOUSECOL\8)+1                  'convert to 80x25 text screen co-ordinates
  304.        MOUSEROW=(MOUSEROW\8)+1
  305.  
  306.        IF MOUSEROW<>MENUROW% THEN               'are we on the menu line
  307.           GOTO MENU123.NOT.ON.MENU.LINE         'NO
  308.        END IF
  309.  
  310.        FOR I=1 TO ITEMNUM%                      'yes, are we on one of the menu options
  311.        IF MOUSECOL>=ITEMS%(I,1) AND MOUSECOL<=ITEMS%(I,2) THEN
  312.           GOTO MENU123.GET.PRESS.FOUND          'yes
  313.        END IF
  314.  
  315.        NEXT
  316.  
  317.        CALL MMCLICK(LFT%,RGT%)                  'throw away any clicks
  318.  
  319.        GOTO MENU123.GET.INKEY                   'no, on menu line , but not on an option
  320.  
  321. '
  322. MENU123.NOT.ON.MENU.LINE:
  323.        CALL MMCLICK(LFT%,RGT%)                  'see if user clicked on this menu item
  324.  
  325.        CLICK=LFT%+RGT%                          'any button pressed?
  326.        IF CLICK THEN                            'YES
  327.            KP$=CHR$(27)                         'simualate ESC key being pressed
  328.          RETURN
  329.        END IF
  330.  
  331.        GOTO MENU123.GET.INKEY
  332.  
  333. '
  334. MENU123.GET.PRESS.FOUND:
  335.        TEMP.ITEM=I                              'what menu item location are we at
  336.        IF TEMP.ITEM>ITEMNUM% THEN               'are we past the end of the menu items
  337.            GOTO MENU123.GET.INKEY
  338.        END IF
  339.  
  340.        IF TEMP.ITEM<>OLD.ITEM THEN              'are we on a new option (moved mouse cursor)
  341.            GOTO MENU123.GET.PRESS.FOUND.NEW
  342.        END IF
  343.  
  344.        CALL MMCLICK(LFT%,RGT%)                  'NO same one, did user click on it
  345.        CLICK=LFT%+RGT%                          'any button
  346.        IF CLICK THEN
  347.            KP$=CHR$(13)                         'YES, simulate Enter key press
  348.          RETURN
  349.        END IF
  350.  
  351.        GOTO MENU123.GET.INKEY
  352.  
  353. '
  354. MENU123.GET.PRESS.FOUND.NEW:
  355.        ITEM%=TEMP.ITEM                           'this is now the menu item we want highlighted
  356.        GOSUB MENU123.FINDWORD                   'Find word associated with Item Number
  357.        GOSUB MENU123.OFFWORD                    'Turn off old word
  358.        GOSUB MENU123.ONWORD                     'Turn on new word
  359.        GOSUB MENU123.DESCRIPT                   'Print Description
  360.  
  361.        CALL MMCURSORON
  362.  
  363.        CALL MMCLICK(LFT%,RGT%)                  'throw away button clicks
  364.  
  365. MENU123.GET.INKEY:
  366.        KP$=INKEY$                               'was a keyboard key pressed
  367.  
  368.        IF LEN(KP$)=0 THEN                       'NO ,keep looking for keypress or mouse action
  369.           GOTO MENU123.GET.PRESS
  370.        END IF
  371.  
  372.        RETURN                                   'YES a key pressed, return it.
  373.  
  374. '
  375. MENU123.SOUNDOFF:
  376.        SOUND 1000,1
  377.        SOUND 1500,2
  378.        SOUND 500,1
  379.        RETURN
  380.  
  381. '
  382. MENU123.DONE:                                   'return the menu option selected
  383.        ERASE ITEMS%                             'free memory allocated to array
  384.        DAT$=""                                  'free string space allocated
  385.  
  386.        ITEMSLCT%=ITEM%                          'item relative to OPTION BASE 1
  387.  
  388. '      ITEMSLCT%=ITEMDESC.MIN%+(ITEMSLCT%-1)    'adjust to callers exact array element selected
  389.  
  390.        CALL MMCURSOROFF                         'turn off the mouse cursor
  391. END SUB
  392.