DP Tool Club 24/CD_ASCQ_24_0995.iso/vrac/homonlib.zip/GENMEN.BAS

BASIC Source File | 1995-04-13 | 6KB | 159 lines

DEFINT A-Z

' $INCLUDE: 'PARM.INC'
' $INCLUDE: 'SETCURS.INC'
' $INCLUDE: 'TRUEFALS.INC'

DECLARE FUNCTION GenMen (choice$(), ok(), parm())
DECLARE FUNCTION GenMen2 (choice$(), parm())

'External procedures:

DECLARE SUB Center (row, text$)
DECLARE FUNCTION GetKey$ (parm())
DECLARE FUNCTION Istr$ (i)

FUNCTION GenMen (choice$(), ok(), parm())
'****************************************************************************
'GenMen() is a general vertical lightbar menu function.  It will return the
' element number of the selected item or zero if the user presses ESC.
'
'The ok() array is used to specify which choices are available:
'
'                      0=Not available  Non-zero=Ok
'
'The ok() array must have subscripts equal to those of choice$() or those
' specified by parm(6 and 7) - See below.
'
'    parm(1)  =  top row
'    parm(2)  =  left column  0=Center
'    parm(3)  =  # blank lines between choices  >=0
'    parm(4)  =  allow number keys if < 10 choices?  0=No  Non-zero=Yes
'    parm(5)  =  initial selected choice
'    parm(6)  =  minimum choice$() subscript  0=Use actual minimum (LBOUND)
'    parm(7)  =  maximum choice$() subscript  0=Use actual maximum (UBOUND)
'
'If a combination of any of the above parameters cause one or more menu items
' to be placed outside the actual screen area, a run-time error will occur.
'
'parm(4) indicates whether the user can press a number key (1-9) to select an
' option when there are 9 or less choices.  Identifying the choices by number
' is the programmer's responsibility if this option is desired.  Note: this
' option can only be selected when all the choice$() subscripts are positive.
'
'    Example:  choice$(1) = " 1) Do this      "
'              choice$(2) = " 2) Do that      "
'              choice$(3) = " 3) Do the other "
'
'parm(6 and 7) can specify minimum and maximum elements of the array to use
' if the actual array contains more elements than you want on the menu.
'
'    Example:  DIM choice$(-10 to 30)              This example would create
'              (assign values to choice$()...)     a lightbar menu using only
'              parm(6) = 1                         choices 1 through 5,
'              parm(7) = 5                         ignoring any element below
'              picked = GenMen(...)                1 or over 5.
'
'Note: It is not recommended to include subscript zero in the choices sent to
' GenMen().  You will be unable to tell the difference between the user
' selecting element zero and the user pressing ESC.  Exception: When element
' zero is some sort of quit or exit option this might be acceptable.
'
'****************************************************************************

min = parm(6)                           'Determine minimum & maximum elements
IF min = 0 THEN min = LBOUND(choice$)   'to use.
max = parm(7)
IF max = 0 THEN max = UBOUND(choice$)

numok = parm(4)                         'See if it's ok to use number keys.
IF min < 0 THEN numok = FALSE           'This is only available when all
IF numok THEN                           'elements are greater than zero and
     sel = 0                            'there are nine or less choices.
     FOR x = min TO max
          sel = sel + 1
          nums$ = nums$ + Istr$(x)      'Create a string of eligible numbers.
     NEXT x
     IF sel > 9 THEN numok = FALSE
END IF

sel = parm(5)                           'Determine initial selection
IF sel < min THEN sel = min
IF sel > max THEN sel = max

oldcursor = SetCursor(SCNONE)           'Turn off the cursor

DO

     row = parm(1)                      'Show the menu options
     FOR x = min TO max
          IF ok(x) = 0 THEN COLOR parm(FGD)
          IF x = sel THEN
               COLOR parm(FGS), parm(BGS)
               IF ok(x) = 0 THEN COLOR parm(FGDS)
          END IF
          IF parm(2) = 0 THEN
               Center row, choice$(x)
          ELSE
               LOCATE row, parm(2): PRINT choice$(x);
          END IF
          COLOR parm(FGN), parm(BGN)
          row = row + 1 + parm(3)
     NEXT x

     k$ = GetKey$(parm())               'Get keyboard input
     SELECT CASE k$
          CASE CHR$(27)                                     'ESC
               GenMen = 0
               EXIT DO
          CASE CHR$(13)                                     'Enter
               IF ok(sel) THEN
                    GenMen = sel
                    EXIT DO
               END IF
          CASE CHR$(0) + CHR$(72)                           'Up arrow
               sel = sel - 1
          CASE CHR$(0) + CHR$(80)                           'Down arrow
               sel = sel + 1
          CASE ELSE                                         'Number key?
               IF numok AND (INSTR(nums$, k$) > 0) THEN
                    sel = VAL(k$)
                    IF ok(sel) THEN
                         GenMen = sel
                         EXIT DO
                    END IF
               END IF
     END SELECT

     IF sel < min THEN sel = max
     IF sel > max THEN sel = min

LOOP

x = SetCursor(oldcursor)                'Restore the cursor

END FUNCTION

FUNCTION GenMen2 (choice$(), parm())
'****************************************************************************
'GenMen2() is identical to GenMen() except that you need not pass the ok()
' array.  All elements default to available.
'
'See GenMen() for more information.  The parm() settings are identical.
'
'****************************************************************************

min = LBOUND(choice$)
max = UBOUND(choice$)
REDIM ok(min TO max)                    'Create an ok() array and make all
FOR x = min TO max                      'its elements non-zero.
     ok(x) = TRUE
NEXT x

GenMen2 = GenMen(choice$(), ok(), parm())

ERASE ok

END FUNCTION