ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/BASIC/BASWIND8.ZIP/MENU123.SUB

Text File | 1990-09-14 | 14.2 KB | 392 lines

'
'
'******************************************************************************
'                    Function : MENU123                                       *
'                                                                             *
' Purpose:                                                                    *
'                                                                             *
'                                                                             *
' Results:                                                                    *
'                                                                             *
' Usage  :                                                                    *
'                                                                             *
'                                                                             *
' Date Written : 09/01/90 - Date Tested: 09/01/90 - Author: James P Morgan    *
' Date Modified:          -            :          -       :                   *
'-----------------------------------------------------------------------------*
' NOTE:                                                                       *
'******************************************************************************
'                                                                             *
'     SUB PROGRAM NAME          (PARAMETERS)                 STATIC/RECURSIVE *
'-----------------------------------------------------------------------------*
'                                                                             *
SUB    MENU123(MENULINE$,MENUROW%,MENUFG%,MENUBG%,ITEMNUM%,ITEMDESC$(1),ITEMSLCT%,RETURN.CODE%) STATIC

       DEFINT A-Z                               'make all short intergers by default

       RETURN.CODE%=0
       VIDEO.RETURN.CODE=0

       ITEMDESC.MIN=LBOUND(ITEMDESC$)           'adjust to callers "OPTION BASE"
       ITEMDESC.MAX=UBOUND(ITEMDESC$)

       ITEM.BASE=1-ITEMDESC.MIN                 'normalize

REM    $DYNAMIC
       DIM ITEMS%(80,2)                         'starting-ending screen locations for each option
REM    $STATIC

       MENUCOL=1
       DESCROW=MENUROW%+1                       'option description is on line just below options
       DESCCOL=2

       BUTTONS%=0                               'assume no mouse support avail

       CLICK=0

       CALL MMCHECK(BUTTONS%)                   'see if mouse support avail

       MOUSECOL=0                               'locate the mouse cursor in upper
       MOUSEROW=0                               'left top corner of screen

       CALL MMSETLOC(MOUSECOL,MOUSEROW)

       CALL MMCURSORON                          'turn on  mouse cursor for now

       FIRST.TIME=-1

'MAKE SURE MENULINE$ HAS SPACES AT BEGINNING AND END

       MENULINE$=LTRIM$(MENULINE$)              'remove leading and trailing spaces
       MENULINE$=RTRIM$(MENULINE$)

       IF LEN(MENULINE$)>78 THEN                'if menu line too long, make it the right size
           MENULINE$=LEFT$(MENULINE$,78)
       END IF

       MENULINE$=" "+MENULINE$+" "              'delimit menu line with a space

       GOSUB MENU123.OFFWORD                    'PRINT TOP MENU BAR LINE

'
'
' locate  each unique option on the menu line

       COUNT=0
       I=1
MENU123.NEXT.ITEM:
       FOR I=I TO LEN(MENULINE$)                'scan over spaces
           IF MID$(MENULINE$,I,1)=" " THEN
               GOTO MENU123.NEXT.CHAR
           END IF

           COUNT=COUNT+1                        'keep track of number of menu items
           ITEMS%(COUNT,1)=I                    'record the screen column where this option started
           FOR J=I TO LEN(MENULINE$)            'look for space to terminate this option
               IF MID$(MENULINE$,J,1)=" " THEN
                   ITEMS%(COUNT,2)=J-1
                   I=J+1                        'record the screen column where this option ended
                 GOTO MENU123.NEXT.ITEM
               END IF

           NEXT

           ITEMS%(COUNT,2)=J

MENU123.NEXT.CHAR:
       NEXT

       IF ITEMNUM%<>COUNT THEN                  'make number items agree with what we found
           ITEMNUM%=COUNT
       END IF

'SET FIRST MENU ITEM TO REVERSE VIDEO & DISPLAY FIRST DESCRIPTION

       IF ITEMSLCT%<1 OR ITEMSLCT%>ITEMNUM% THEN
          ITEMSLCT%=1
       END IF

       ITEM%=ITEMSLCT%                           'start with the item the user wants

       ITEMSLCT%=0
'
'ENTER MENU LOOP AND WAIT FOR SELECTION OR [ESCAPE]
MENU123.LOOP:
       GOSUB MENU123.DISPLAY           'Update Position of Selection Marker
       GOSUB MENU123.PRESS             'Get KeyPress

       IF KP$=CHR$(13) THEN            'an option selected if enter pressed
          GOTO MENU123.DONE
       END IF

       IF KP$=CHR$(27) THEN            'this function aborted if ESC pressed
           ITEM%=0
           RETURN.CODE%=-1
         GOTO MENU123.DONE
       END IF

       GOTO MENU123.LOOP

'
'GIVEN ITEM NUMBER, TURN ASSOCIATED WORD IN MENU BAR TO REVERSE VIDEO AND DISPLAY ASSOCIATED DESCRIPTION
MENU123.DISPLAY:
       GOSUB MENU123.FINDWORD           'Find word associated with Item Number
       GOSUB MENU123.OFFWORD            'Turn off old word
       GOSUB MENU123.ONWORD             'Turn on new word
       GOSUB MENU123.DESCRIPT           'Print Description
       RETURN

'
'Find position of selected word in Menu Bar
MENU123.FINDWORD:
       BEGWORD=ITEMS%(ITEM%,1)            'get the starting and ending position of item on menu line
       ENDWORD=ITEMS%(ITEM%,2)

       RETURN

'
'RESTORE ENTIRE MENU LINE TO NORMAL VIDEO
MENU123.OFFWORD:
       CALL MMCURSOROFF

       ATTR=(MENUBG% * 16)+MENUFG%
       CALL FASTPRT(MENULINE$,MENUROW%,MENUCOL,ATTR,VIDEO.RETURN.CODE)

       CALL MMCURSORON

       RETURN

'
MENU123.ONWORD:
       CALL MMCURSOROFF

       WORDLEN=(ENDWORD-BEGWORD)+1               'calculate length of menu item
       DAT$=MID$(MENULINE$,BEGWORD,WORDLEN)      'and get it out of the menu line
       ATTR=(MENUFG% * 16)+MENUBG%               'display the menu item as highlighted
       CALL FASTPRT(DAT$,MENUROW%,BEGWORD,ATTR,VIDEO.RETURN.CODE)

       IF FIRST.TIME THEN
           MOUSEROW=(MENUROW%-1)*8                   'if so, put the mouse cursor on the new selection
           MOUSECOL=(BEGWORD-1)*8
           CALL MMSETLOC(MOUSECOL,MOUSEROW)
'          FIRST.TIME=0
       END IF

       CALL MMCURSORON

       OLD.ITEM%=ITEM%                              'remember which item is the current highlighted item

       RETURN

'
'Print Associated Description Underneath Menu Line
MENU123.DESCRIPT:
       CALL MMCURSOROFF

       ATTR=(MENUBG% * 16)+MENUFG%
       ITEM.SUB=ITEM%-ITEM.BASE                   'get the current items associated description
       DAT$=STRING$(80," ")
       MID$(DAT$,2,78)=ITEMDESC$(ITEM.SUB)        'delimit it with spaces
       CALL FASTPRT(DAT$,DESCROW,1,ATTR,VIDEO.RETURN.CODE)          'display it under the menu line

       CALL MMCURSORON

       DAT$=""                                    'free up the string space
       RETURN

'
'Check for KeyPress and sound error if not LEFT ARROW, RIGHT ARROW, ESCAPE or RETURN
MENU123.PRESS:
       GOSUB MENU123.GET.PRESS

       IF KP$="" THEN                             'wait for a keypress or mouse click
           GOTO MENU123.PRESS
       END IF

       IF LEN(KP$)=2 THEN                         'was an extended fucnction key pressed
           GOTO MENU123.PRESS.EXTENDED
       END IF

       IF KP$=CHR$(13) THEN                       'was the ENTER key pressed
           RETURN
       END IF

       IF KP$=CHR$(27) THEN                       'was the ESC key pressed
           ITEM%=0                                 'indicate that selection was Aborted
         RETURN
       END IF

       GOSUB MENU123.FIND.OPTION                  'see if keypress matches any menu item

       IF ITEM%<>SAVE.ITEM THEN                    'did we finf a new matching item
          RETURN
       END IF

       GOSUB MENU123.SOUNDOFF                     'NO, let user know
       GOTO MENU123.PRESS

'
'Process RIGHT ARROW KeyPress
MENU123.PRESS.EXTENDED:
       IF ASC(RIGHT$(KP$,1))=77 THEN              'cursor right key pressed
            ITEM%=ITEM%+1                           'point to next item
          IF ITEM% > ITEMNUM% THEN                 'are we past the end of the items
              ITEM% = 1                            'yes, loop back to the first item
            RETURN
          ELSE
            RETURN
          END IF
       END IF

'Process LEFT ARROW KeyPress
       IF ASC(RIGHT$(KP$,1))=75 THEN               'cursor left key pressed
            ITEM%=ITEM%-1                            'look at the previous item in the menu
          IF ITEM% < 1 THEN                         'are we part the start of the forst menu item
              ITEM% = ITEMNUM%                      'yes, loop to the last item in the menu
            RETURN
          ELSE
            RETURN
          END IF
       END IF

       GOSUB MENU123.SOUNDOFF                      'let user know an invalid key was pressed
       GOTO MENU123.PRESS

'
MENU123.FIND.OPTION:
       SAVE.ITEM=ITEM%                              'remember which item is the current one
       IF KP$<" " OR KP$>CHR$(126) THEN            'only look for printable characters
           RETURN
       END IF

       FIRST.CHAR$=KP$                             'this is the character user wants a matching menu item

' make comparison test case in-sensative
'
       FIRST.CHAR$=UCASE$(FIRST.CHAR$)

       TEMP.ITEM=ITEM%+1                            'start with next item in the menu list

       COUNT=0                                     'keep track of number of menu items we have checked
MENU123.FIND.OPTION.CONT:
       IF TEMP.ITEM>ITEMNUM% THEN                  'are we past the end of the items
          TEMP.ITEM=1                              'so start back with the first item in the list
       END IF

       COUNT=COUNT+1                               'keep track of the number of items we have looked at
       IF COUNT>ITEMNUM% THEN                      'have we looked at all the items
          RETURN                                   'YES, no match was found
       END IF

'
'Does the first character of this item match the one the user wants
'
' make the test case in-sensative

       IF UCASE$(MID$(MENULINE$,ITEMS%(TEMP.ITEM,1),1))=FIRST.CHAR$ THEN
           ITEM%=TEMP.ITEM%                         'we found a match!
         RETURN
       END IF

       TEMP.ITEM=TEMP.ITEM+1                        'no match, look at the next item

       GOTO MENU123.FIND.OPTION.CONT

'
MENU123.GET.PRESS:
       IF BUTTONS%=0 THEN                       'mouse supported
          GOTO MENU123.GET.INKEY                'no
       END IF

       CALL MMGETLOC(MOUSECOL,MOUSEROW)         'get the current mouse cursor location

       MOUSECOL=(MOUSECOL\8)+1                  'convert to 80x25 text screen co-ordinates
       MOUSEROW=(MOUSEROW\8)+1

       IF MOUSEROW<>MENUROW% THEN               'are we on the menu line
          GOTO MENU123.NOT.ON.MENU.LINE         'NO
       END IF

       FOR I=1 TO ITEMNUM%                      'yes, are we on one of the menu options
       IF MOUSECOL>=ITEMS%(I,1) AND MOUSECOL<=ITEMS%(I,2) THEN
          GOTO MENU123.GET.PRESS.FOUND          'yes
       END IF

       NEXT

       CALL MMCLICK(LFT%,RGT%)                  'throw away any clicks

       GOTO MENU123.GET.INKEY                   'no, on menu line , but not on an option

'
MENU123.NOT.ON.MENU.LINE:
       CALL MMCLICK(LFT%,RGT%)                  'see if user clicked on this menu item

       CLICK=LFT%+RGT%                          'any button pressed?
       IF CLICK THEN                            'YES
           KP$=CHR$(27)                         'simualate ESC key being pressed
         RETURN
       END IF

       GOTO MENU123.GET.INKEY

'
MENU123.GET.PRESS.FOUND:
       TEMP.ITEM=I                              'what menu item location are we at
       IF TEMP.ITEM>ITEMNUM% THEN               'are we past the end of the menu items
           GOTO MENU123.GET.INKEY
       END IF

       IF TEMP.ITEM<>OLD.ITEM THEN              'are we on a new option (moved mouse cursor)
           GOTO MENU123.GET.PRESS.FOUND.NEW
       END IF

       CALL MMCLICK(LFT%,RGT%)                  'NO same one, did user click on it
       CLICK=LFT%+RGT%                          'any button
       IF CLICK THEN
           KP$=CHR$(13)                         'YES, simulate Enter key press
         RETURN
       END IF

       GOTO MENU123.GET.INKEY

'
MENU123.GET.PRESS.FOUND.NEW:
       ITEM%=TEMP.ITEM                           'this is now the menu item we want highlighted
       GOSUB MENU123.FINDWORD                   'Find word associated with Item Number
       GOSUB MENU123.OFFWORD                    'Turn off old word
       GOSUB MENU123.ONWORD                     'Turn on new word
       GOSUB MENU123.DESCRIPT                   'Print Description

       CALL MMCURSORON

       CALL MMCLICK(LFT%,RGT%)                  'throw away button clicks

MENU123.GET.INKEY:
       KP$=INKEY$                               'was a keyboard key pressed

       IF LEN(KP$)=0 THEN                       'NO ,keep looking for keypress or mouse action
          GOTO MENU123.GET.PRESS
       END IF

       RETURN                                   'YES a key pressed, return it.

'
MENU123.SOUNDOFF:
       SOUND 1000,1
       SOUND 1500,2
       SOUND 500,1
       RETURN

'
MENU123.DONE:                                   'return the menu option selected
       ERASE ITEMS%                             'free memory allocated to array
       DAT$=""                                  'free string space allocated

       ITEMSLCT%=ITEM%                          'item relative to OPTION BASE 1

'      ITEMSLCT%=ITEMDESC.MIN%+(ITEMSLCT%-1)    'adjust to callers exact array element selected

       CALL MMCURSOROFF                         'turn off the mouse cursor
END SUB