Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DBT123S.ZIP
Filename : DBTVMENU.PRG

* =====================================================================
* 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