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