home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
homonlib.zip
/
GENMEN.BAS
< prev
next >
Wrap
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