* =====================================================================
*  DBTVMENU.PRG - Vertical Bar Menu demo   V 1.23S
*               (c) 1990 BERNATH COMPUTER
*               07/20/1990
* =====================================================================
CALL DBTOOLS WITH "15,3"
CALL DBTOOLS WITH "7,1,7,0,0"
CALL DBTOOLS WITH "3,3,5,14,53,0,7,2,0,1"
CALL DBTOOLS WITH "1,4,7,15,7,0,Vertical Bar Menu - function 20"
SET COLOR TO N/W
@  5,9 SAY "VMENU provides a vertical moving bar menu"
@  6,9 SAY "in either a popup or non-popup style. The"
@  7,9 SAY "menus are inside a framed and optionally"
@  8,9 SAY "shadowed box. The arrow keys, or Home and"
@  9,9 SAY "End highlight the desired menu item, and"
@ 10,9 SAY "Enter selects it.  Alternatively, you may"
@ 11,9 SAY "press the first letter of the menu item"
@ 12,9 SAY "without pressing Enter."
CALL DBTOOLS WITH "10,13,12,8,7"

CALL DBTOOLS WITH "3,5,10,22,75,15,0,2,0,0"
CALL DBTOOLS WITH "1,6,20,0,7,0,NON-POPUP STYLE"
mPARM = "CALL DBTOOLS WITH "+CHR(34)+"20,choice,0,ULR,ULC,LRR,LRC,LowFG,LowBG,"

set color to +w/n
@ 7,12 say "Syntax:"
@ 8,12 say mPARM
mPARM = "frame,shadow,HighFG,HighBG,jus,"
@ 9,31 SAY mPARM
mPARM = "item1,item2,item3,....,@"+CHR(34)
@ 10,31 say mPARM
SET COLOR TO W/N
@ 11,12 SAY "where: Choice is the initial choice to highlight."
@ 12,12 SAY "       LowFG & LowBG are the colors for the non-highlighted"
@ 13,12 SAY "       menu items, and HighFG & HighBG are the colors for"
@ 14,12 SAY "       the highlighted menu items."
@ 15,12 SAY "       Jus stands for Justification; Jus = 1, left justi-"
@ 16,12 SAY "       fied, Jus = 2, text is centered."
@ 17,12 SAY "       The other parameters are similar to those in Box,"
@ 18,12 SAY "       function 3."
CALL DBTOOLS WITH "10,21,28,0,7"
CALL DBTOOLS WITH "7,1,7,0,0"
CALL DBTOOLS WITH "3,1,5,6,70,15,7,1,0,1"
SET COLOR TO +W/W
@ 2,8 say "A string variable must be used to pass the parameters to"
@ 3,8 say "the function, since the selected choice is returned in it."
@ 4,8 SAY "Note that pressing ESC returns a value of 0."
CALL DBTOOLS WITH "1,5,8,0,7,0,The example below illustrates how to use VMENU:"
set color to +w/n
CALL DBTOOLS WITH "3,8,13,15,74,15,0,1,0,0"
@ 9,15 say "mCHOICE = 1"
@ 10,15 SAY "mPARM = "+CHR(34)+"20,"+CHR(34)+"+STR(mCHOICE,2)+"+CHR(34)+"0,16,14,21,30,15,1,"+CHR(34)
@ 11,15 SAY "mPARM=mPARM+"+CHR(34)+"1,1,1,3,1,Data Entry,Reports,Utilities,Quit,@"+CHR(34)
@ 12,15 SAY "CALL DBTOOLS WITH mPARM"
@ 13,15 SAY "mCHOICE = VAL(mPARM)"
@ 14,15 SAY "DO CASE mCHOICE...... etc"
mCHOICE = 1
set color to W/N
DO WHILE mCHOICE <> 0
   CALL DBTOOLS WITH "1,18,3,14,0,0,Centered"
   mPARM = "20,"+STR(mCHOICE,2)+",0,16,14,21,30,15,1,1,1,1,3,2,Data Entry,Reports,Utilities,Quit,@"
   CALL DBTOOLS WITH mPARM
   mCHOICE = VAL(mPARM)
   @ 23,15 SAY "°"
   CALL DBTOOLS WITH "5,23,15,23,37,2"
   DO CASE
      CASE mCHOICE = 1
         CALL DBTOOLS WITH "1,23,15,15,2,0,Data Entry selected"
      CASE mCHOICE = 2
         CALL DBTOOLS WITH "1,23,15,15,2,0,Reports selected"
      CASE mCHOICE = 3
         CALL DBTOOLS WITH "1,23,15,15,2,0,Utilities selected"
      CASE mCHOICE = 0 .OR. mCHOICE = 4
         Mchoice = 0
   ENDCASE
ENDDO
CALL DBTOOLS WITH "1,18,61,14,0,0,Left Justified"
mPARM = "20,"+STR(mCHOICE,2)+",0,16,44,21,57,15,4,3,1,12,0,1,Data Entry,Reports,Utilities,Quit,@"
CALL DBTOOLS WITH mPARM

CALL DBTOOLS WITH "21,3,8,25,19,72,14,5,1,1"
CALL DBTOOLS WITH "1,9,40,14,5,0,POPUP Menus"
SET COLOR TO +W/RB
@ 11,27 SAY "To make a popup menu, first use the WINDOW"
@ 12,27 SAY "function 21 to specify the coordinates of"
@ 13,27 SAY "the box and save the screen data underneath."
@ 14,27 SAY "Then use function 20 with the reduced param-"
@ 15,27 SAY "eter set to activate the menu. The screen is"
@ 16,27 SAY "restored with the UNPOP function 19."
CALL DBTOOLS WITH "1,17,27,14,5,0,See the Main Demo Menu for a good example."
CALL DBTOOLS WITH "10,18,35,7,4"
CALL DBTOOLS WITH "19,3"

CALL DBTOOLS WITH "13,0,0,24,79,8,0"
CALL DBTOOLS WITH "3,8,15,22,70,11,5,1,0,0"
CALL DBTOOLS WITH "1,S,9,18,15,4,0,Function Key Trapping"
SET COLOR TO +gb/RB
@ 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,15,5,0,Press F1 to change colors"
mCHOICE = -1
mFG = 15
DO WHILE mCHOICE <> 0
   IF mCHOICE = -1
      mCHOICE = 1
   ENDIF
   mMENUSTR = "20,Y,"+STR(mCHOICE,2)+",0,17,25,21,40,"+STR(mFG,2)+",0,3,1,0,7,1,"
   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
         CALL DBTOOLS WITH "1,15,26,14,5,0,Option 1 chosen."
      CASE mCHOICE = 2
         CALL DBTOOLS WITH "1,15,26,14,5,0,Option 2 chosen."
      CASE mCHOICE = 99
         mKEY=ASC(SUBSTR(mMENUSTR,4,1))-1
         mSCAN=ASC(SUBSTR(mMENUSTR,5,1))-1
         DO CASE
            CASE mKEY=27 .AND. mSCAN=0               && ESC
                mCHOICE = 0
            CASE mKEY=0 .AND. mSCAN=59               && F1 pressed
                mFG = mFG + 1
                IF mFG > 15
                   mFG = 0
                ENDIF
            OTHERWISE                           && Fkey other than F1
                mSTUFF="Scancodes are: "+STR(mKEY,3)+","+STR(mSCAN,3)
                CALL DBTOOLS WITH "1,15,26,14,5,0,"+mSTUFF
         ENDCASE                                && mSCAN
         mCHOICE = ASC(SUBSTR(mMENUSTR,6,1))
   ENDCASE                                      && mCHOICE
   IF mCHOICE = 0
      EXIT
   ENDIF

ENDDO
CALL DBTOOLS WITH "14,3,0"
RETURN