* =====================================================================
*  DBTHMENU.PRG - Horizontal Bar Menu demo    V1.23S
*               (c) 1990 BERNATH COMPUTER
*               07/21/1990
* =====================================================================
CALL DBTOOLS WITH "15,3"
CALL DBTOOLS WITH "7,1,7,0,0"
CALL DBTOOLS WITH "3,3,5,13,53,0,7,2,0,1"
CALL DBTOOLS WITH "1,4,7,8,7,0,Horizontal Bar Menu - function 9"
SET COLOR TO N/W
@ 5,9 SAY "HMENU provides a horizontal moving bar"
@ 6,9 SAY "menu in the style of Lotus 123. Use of"
@ 7,9 SAY "the arrow keys or Home and End highlights"
@ 8,9 SAY "the desired menu item, and Enter selects"
@ 9,9 SAY "it.  Alternatively, you may press the"
@ 10,9 say "first letter of the menu item without"
@ 11,9 SAY "pressing Enter."
CALL DBTOOLS WITH "10,12,12,8,7"

CALL DBTOOLS WITH "3,6,10,22,75,15,0,2,0,0"
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"9,<Y>,choice,row,col,LowFG,LowBG,"

set color to +w/n
@ 7,12 say "Syntax:"
@ 8,12 say mPARM
mPARM = "HighFG,HighBG,item1,item2,....,@"+CHR(34)
@ 9,31 SAY mPARM
SET COLOR TO W/N
@ 11,12 SAY "where: Choice is the initial choice to highlight"
@ 13,12 SAY "       LowFG & LowBG are the colors for the non-highlighted"
@ 14,12 SAY "       menu items."
@ 16,12 SAY "       HighFG & HighBG are the colors for the highlighted"
@ 17,12 SAY "       menu items."
@ 19,12 SAY "       There can be as many menu items as will fit across"
@ 20,12 SAY "       one screen line, terminated by the @ character."
CALL DBTOOLS WITH "10,21,28,0,7"
CALL DBTOOLS WITH "3,6,10,22,75,15,0,2,0,0"
@ 7,15 say "A string variable must be used to pass the parameters to"
@ 8,15 say "the function, since the selected choice is returned in it."
@ 9,15 SAY "Note that pressing ESC returns a value of 0."
@ 11,15 say "The example below illustrates how to use HMENU:"
set color to +w/n
@ 13,15 say "mCHOICE = 1"
@ 14,15 SAY "mPARM = "+CHR(34)+"9,"+CHR(34)+"+STR(mCHOICE,2)+"+CHR(34)+",20,25,7,1,1,7,"+CHR(34)
@ 15,15 SAY "mPARM=mPARM+"+CHR(34)+"Add,Change,Delete,Quit,@"+CHR(34)
@ 16,15 SAY "CALL DBTOOLS WITH mPARM"
@ 17,15 SAY "mCHOICE = VAL(mPARM)"
@ 18,15 SAY "DO CASE mCHOICE...... etc"
mCHOICE = 1
DO WHILE mCHOICE <> 0
   mPARM = "9,"+STR(mCHOICE,2)+",20,25,7,1,1,7,Add,Change,Delete,Quit,@"
   CALL DBTOOLS WITH mPARM
   mCHOICE = VAL(mPARM)
   @ 20,55 SAY " "
   CALL DBTOOLS WITH "5,20,55,20,70,0"
   DO CASE
      CASE mCHOICE = 1
         CALL DBTOOLS WITH "1,20,55,15,2,0,Add selected"
      CASE mCHOICE = 2
         CALL DBTOOLS WITH "1,20,55,15,2,0,Change selected"
      CASE mCHOICE = 3
         CALL DBTOOLS WITH "1,20,55,15,2,0,Delete selected"
      CASE mCHOICE = 0 .OR. mCHOICE = 4
         Mchoice = 0
   ENDCASE
ENDDO

CALL DBTOOLS WITH "13,0,0,24,79,8,0"
CALL DBTOOLS WITH "3,8,15,22,70,14,2,1,0,0"
CALL DBTOOLS WITH "1,S,9,18,10,1,0,Function Key Trapping"
SET COLOR TO +W/G
@ 11,18 SAY "Menus also have the ability to trap and return the"
@ 12,18 SAY "scancode values for Function Keys, by including the"
@ 13,18 SAY "optional Y parameter:"
CALL DBTOOLS WITH "1,14,26,0,2,0,Press F1 for popup help."
mCHOICE = -1
mFG = 15
DO WHILE mCHOICE <> 0
   IF mCHOICE = -1
       mCHOICE = 1
   ENDIF
   mMENUSTR = "9,Y,"+STR(mCHOICE,2)+",18,25,14,2,10,0,"
   mMENUSTR = mMENUSTR+"1. Option 1  ,2. Option 2  ,Quit,@"
   CALL DBTOOLS WITH mMENUSTR
   mCHOICE = VAL(mMENUSTR)
   DO CASE
      CASE mCHOICE = 0 .OR. mCHOICE = 3
         mCHOICE = 0
      CASE mCHOICE = 1
        * gNUMOPT = mCHOICE
         CALL DBTOOLS WITH "1,15,26,14,2,0,Option 1 chosen."
      CASE mCHOICE = 2
        * gNUMOPT = mCHOICE
         CALL DBTOOLS WITH "1,15,26,14,2,0,Option 2 chosen."
      CASE mCHOICE = 99                         && Fkey was pressed
         mKEY  = ASC(SUBSTR(mMENUSTR,4,1))-1    && 1st scancode
         mSCAN = ASC(SUBSTR(mMENUSTR,5,1))-1    && 2nd scancode
         mOPT = ASC(SUBSTR(mMENUSTR,6,1))    && highlighted option
         mCHOICE = mOPT
         DO CASE
            CASE mKEY=27 .AND. mSCAN=0          && ESC
                mCHOICE = 0
            CASE mKEY=0 .AND. mSCAN=59          && F1 pressed
                DO CASE
                   CASE mOPT = 1
                      CALL DBTOOLS WITH "21,8,7,45,13,76,0,3,4,1"
                      CALL DBTOOLS WITH "1,8,47,0,3,0,This is popup help for"
                      CALL DBTOOLS WITH "1,9,47,0,3,0,Option 1!"
                      CALL DBTOOLS WITH "10,12,47,0,3"
                      CALL DBTOOLS WITH "19,8"
                   CASE mOPT = 2
                      CALL DBTOOLS WITH "21,8,7,45,13,76,0,3,4,1"
                      CALL DBTOOLS WITH "1,8,47,0,3,0,This is popup help for"
                      CALL DBTOOLS WITH "1,9,47,0,3,0,Option 2!"
                      CALL DBTOOLS WITH "10,12,47,0,3"
                      CALL DBTOOLS WITH "19,8"
                   CASE mOPT = 3
                      CALL DBTOOLS WITH "21,8,7,45,13,76,0,3,4,1"
                      CALL DBTOOLS WITH "1,8,47,0,11,0,ABORT! ABORT! ABORT! ABORT!"
                      CALL DBTOOLS WITH "1,9,47,0,3,0,(Quit)"
                      CALL DBTOOLS WITH "10,12,47,0,3"
                      CALL DBTOOLS WITH "19,8"
                ENDCASE
            OTHERWISE                           && Fkey other than F1
                mSTUFF="Scancodes are: "+TRIM(STR(mKEY,3))+","+TRIM(STR(mSCAN,3))
                CALL DBTOOLS WITH "1,15,26,14,5,0,"+mSTUFF
         ENDCASE                                && mSCAN
   ENDCASE                                      && mCHOICE
ENDDO

CALL DBTOOLS WITH "14,3,0"
RETURN