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