$CPU 8086          ' make compatible with XT systems
$LIB ALL OFF       ' turn off all PowerBASIC libraries
$ERROR ALL OFF     ' turn off all PowerBASIC error checking
$OPTIMIZE SIZE     ' optimize for smaller code
 $COMPILE UNIT      ' compile to a UNIT (.PBU)
'$COMPILE EXE       ' compile to a UNIT (.PBU)

DEFINT A-Z         ' Required for all numeric functions, forces PB to not
                   ' include floating point in UNIT (makes it smaller)
'/*------------------------------------------------------------------*/
DECLARE FUNCTION GETKEY() AS STRING
DECLARE SUB SAY(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Text AS STRING, BYVAL Attr AS INTEGER)
DECLARE FUNCTION SCRREAD(BYVAL XROW AS INTEGER, BYVAL XCOL AS INTEGER, BYVAL LTH AS INTEGER, BYVAL OPT AS STRING) AS STRING
DECLARE FUNCTION STRIP(BYVAL X AS STRING, BYVAL OPT AS STRING, BYVAL CHAR AS STRING) AS STRING
'/*------------------------------------------------------------------*/
$CODE SEG "MLIB4"
'/*------------------------------------------------------------------*/
' BMENU(ROW,COL,OPT,NBR,ATTR)
'     Bar menu.
'     Allows you to use screen contents as a moving bar menu starting at
'     SROW/SCOL for NBR menu items.  Use the up/down arrows to highlite a
'     choice and press ENTER to select or press the key corresponding to
'     the 1st letter of the choice.
'
'     ROW   = Top (starting) row of menu lines.
'     COL   = Left most column of menu lines.
'     OPT   = Number of lines between each menu line.
'     NBR   = Number of menu lines not including blank lines between
'             choices.
'     ATTR  = Color of menu bar
'     Returns -27 if ESC is pressed.
'     Any function key will return as a -nbr.
'     EXAMPLE:  RTRN = BMENU(4,23,1,9,30)
'               IF RTRN = -27 THEN RTRN = 0
'               IF RTRN = 9 THEN GOTO EEXIT
'               IF RTRN = 1 THEN EFILE "DMENU10.MEM","UNITS.DAT"
'               IF RTRN = 2 THEN EFILE "DMENU20.MEM","OTHER2.TXT"
'               IF RTRN = 3 THEN EFILE "DMENU30.MEM","OTHER.TXT"
'
'      1 +-------------------------------------------------------+
'      2 |                     Main Menu                         |
'      3 |                                                       |
'      4 |                 1. Menu choice 1                      |
'      5 |                                                       |
'      6 |                 2. Menu choice 2                      |
'      7 |                                                       |
'      8 |                 3. Menu choice 3                      |
'      9 |                                                       |
'      10|                 4. Menu choice 4                      |
'      11|                                                       |
'      12|                 0. Exit program                       |
'      13|                                                       |
'        +-------------------------------------------------------+
'
'     EXAMPLE: RTRN = BMENU(4,23,1,9,30)
'                           | |  | |  +--- Use Yellow on Blue Bar
'                           | |  | +------ There are 9 menu choices
'                           | |  +-------- There is one blank line in between
'                           | +----------- Start at Col 23
'                           +------------- Start at Row 4
'
'/*------------------------------------------------------------------*/
   FUNCTION BMENU(SROW,SCOL,OPT,NBR,HATTR) PUBLIC AS INTEGER
     SP = SROW
     RL = 1
     AH$ = ""
'/*  --- Determine Hot Keys ---
     FOR CNT = 1 TO NBR
       AH$ = AH$ + CHR$(SCREEN(SP,SCOL,0))
       SP = SP + OPT + 1
     NEXT CNT
     SP = SROW
     DO
       CATTR = SCREEN(SP,SCOL,1)
       TH$ = STRIP(SCRREAD(SP,SCOL,80-SCOL,"T"),"B"," ")
       SAY SP,SCOL,TH$,HATTR
       Y$ = GETKEY
       SAY SP,SCOL,TH$,CATTR
'/*    --- ENTER? ---
       IF Y$ = CHR$(13) THEN Y$ = CHR$(SCREEN(SP,SCOL,0))
'/*    --- Down Arrow ---
       IF Y$ = CHR$(0,80) THEN
         Y$ = ""
         IF RL+1 > NBR THEN
           ITERATE
         ELSE
           INCR RL
           SP = SP + OPT +1
           ITERATE
         END IF
       END IF
'/*    --- Up Arrow ---
       IF Y$ = CHR$(0,72) THEN
         Y$ = ""
         IF RL-1 < 1 THEN
           ITERATE
         ELSE
           SP = SP - OPT -1
           DECR RL
           ITERATE
         END IF
       END IF
       S = INSTR(1,AH$,Y$)
     LOOP UNTIL S > 0 OR Y$ = CHR$(27) OR Y$ = CHR$(13)
     IF Y$ = CHR$(13) THEN FUNCTION = S
     IF LEN(Y$) > 1 OR Y$ = CHR$(27) THEN FUNCTION = -ASC(RIGHT$(Y$,1))
     IF LEN(Y$) = 1 THEN FUNCTION = S
   END FUNCTION
'/*------------------------------------------------------------------*/
'  $INCLUDE "C:\CODE\MLIB\MLIB.INC"
'      PUTSCREEN GETMEM("C:\CODE\LDS\DMENU01.MEM")
'      SAY 25,1,CENTER("ESC=Exit",80," "),7
'      RTRN = BMENU(4,23,1,9,30)