home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / baswind8.zip / FULLMENU.SUB < prev    next >
Text File  |  1990-09-14  |  6KB  |  163 lines
  1. '
  2. '
  3. '******************************************************************************
  4. '                    Function : FULLMENU                                      *
  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    FULLMENU(WIN.TITLE$,MENU$(1),MAIN%,CHOICES%,SELECT.%,RETURN.CODE%) STATIC
  24.  
  25.        DEFINT A-Z                               'make all short interger by default
  26.  
  27.        RETURN.CODE%=0
  28.        VIDEO.RETURN.CODE%=0
  29.        TITLE.RETURN.CODE=0
  30.        ROW25.RETURN.CODE=0
  31.  
  32.        MENU.MIN=LBOUND(MENU$)                   'adjust for callers "OPTION BASE"
  33.        MENU.MAX=UBOUND(MENU$)                   'how many choices defined in the array
  34.  
  35.        MENU.BASE=1-MENU.MIN
  36.  
  37.        CALL TITLE(WIN.TITLE$,TITLE.RETURN.CODE%)      'display the menu title
  38.  
  39.        SELECT.%=0                               'assume nothing selected
  40.  
  41.        ROW=8                                    'this is where the selection list starts
  42.        COL=10
  43.  
  44.        IF CHOICES%>(MENU.MAX+(1-MENU.MIN)) THEN 'cant be more choices then items in the array
  45.           CHOICES%=MENU.MAX+(1-MENU.MIN)
  46.        END IF
  47.  
  48.        IF CHOICES% <5 THEN                      'if we have fewer than 5 choices start here
  49.            ROW=9
  50.        END IF
  51.  
  52.        ATTR=&h17                                'blue on white
  53.        MSG$="Select from the following options:"
  54.        CALL FASTPRT(MSG$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  55.  
  56.        COL=20
  57.        ATTR=&h70                                'black on white
  58.        BEGIN=ROW
  59.        ROW=ROW+3
  60.  
  61.  
  62. '
  63. '
  64. ' Display a number for each of the choices
  65. '
  66.        FOR I=1 TO CHOICES%
  67.            MSG$="[ "+RIGHT$(STR$(I),1)+" ]"
  68.            CALL FASTPRT(MSG$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  69.            ROW=ROW+2
  70.        NEXT
  71.  
  72.        ROW=ROW+2
  73.        MSG$="[ESC]"
  74.        CALL FASTPRT(MSG$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  75.  
  76.        ROW=ROW+2
  77.        COL=27
  78.        ATTR=&h17                                'blue on white
  79.        ROW=BEGIN+3
  80.  
  81. '
  82. ' Display each of the choices
  83. '
  84.        FOR I=MENU.MIN TO MENU.MIN+CHOICES%
  85.            MSG$=MENU$(I)
  86.            CALL FASTPRT(MSG$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  87.            ROW=ROW+2
  88.        NEXT
  89.  
  90.        ROW=ROW+2
  91.  
  92. '
  93. ' Is this the main menu, being displayed
  94. '
  95.        IF MAIN%=0 THEN
  96.            MSG$="Return to previous menu."
  97.        ELSE
  98.            MSG$="Exit Program"
  99.        END IF
  100.  
  101.        COL=27
  102.        ATTR=&h17                                'blue on white
  103.        CALL FASTPRT(MSG$,ROW,COL,ATTR,VIDEO.RETURN.CODE%)
  104.  
  105.        COLOR 7,1                                'white on blue
  106.  
  107.        MSG$="Select desired option by pressing the appropriate key"
  108.  
  109.        GOSUB FULLMENU.ROW25                     'display on line 25
  110.  
  111. '
  112. FULLMENU.CHECK.KEY:
  113.        Q$=INKEY$
  114.        IF Q$=""  THEN                          'wait until a key pressed
  115.            GOTO FULLMENU.CHECK.KEY
  116.        END IF
  117.  
  118.        IF LEN(Q$)<>1 THEN                      'was an extended function key pressed
  119.             GOSUB FULLMENU.SOUNDOFF            'YES, an error
  120.           GOTO FULLMENU.CHECK.KEY
  121.        END IF
  122.  
  123.        IF Q$=CHR$(27) THEN                      'ESC aborts this function
  124.             SELECT.%=-1                         'indicate nothing selected
  125.             RETURN.CODE=-1
  126.           GOTO FULLMENU.DONE
  127.        END IF
  128.  
  129. '
  130. ' was a key in the range of options pressed
  131. '
  132.        IF Q$<"1" OR Q$>RIGHT$(STR$(CHOICES%),1) THEN
  133.             GOSUB FULLMENU.SOUNDOFF             'invalid key pressed
  134.           GOTO FULLMENU.CHECK.KEY
  135.        END IF
  136.  
  137.        SELECT.%=VAL(Q$)                         'return the value of the key pressed
  138.        GOTO FULLMENU.DONE
  139.  
  140. '
  141. FULLMENU.ROW25:
  142.        CALL ROW25(MSG$,ROW25.RETURN.CODE%)
  143.  
  144.        IF MSG$="" THEN                           'clear line 25 if nothing to display
  145.            COLOR 7,1                             'white on blue
  146.            LOCATE 25,1
  147.            PRINT STRING$(79," ");
  148.        END IF
  149.  
  150.        RETURN
  151.  
  152. '
  153. FULLMENU.SOUNDOFF:
  154.        SOUND 1000,1
  155.        SOUND 1500,2
  156.        SOUND 500,1
  157.        RETURN
  158.  
  159. '
  160. FULLMENU.DONE:
  161.        MSG$=""
  162. END SUB
  163.