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

* CLOSET.PRG - Skeletons in my closet
* Skeleton code for pulldown menu system
* (c) 1990 BERNATH COMPUTER
* 07/20/1990

* This code segment acts as a skelton for you to "flesh out" to produce
* your own pulldown menu system. You'll need to change the menu item
* text, colors, coordinates, the number of menu items, routines to call,
* etc, as desired.
* This code segment will not execute as shown, but acts as a guide.



mNUMHORZ=4 && put # of horizontal menu items here
EXITNOW=.F.
HCHOICE=1
VCHOICE=0
mHKPROC="HKMAIN" && name of hotkey processor

DO WHILE .NOT. EXITNOW
DO DRAWBG && a routine to create a backdrop. See below
VCHOICE=0
mMENUSTR="9,Y,"+STR(HCHOICE,2)+",1,2,14,1,15,0, 1. HMENU option 1 , 2. HMENU option 2 , 3. HMENU option 3 , QUIT ,@"
CALL DBTOOLS WITH mMENUSTR
HCHOICE=VAL(mMENUSTR)
DO CASE
CASE HCHOICE=1 && --------HMENU Option 1------------------
VCHOICE = 1
* Code for popup menu off of HMENU first option:
DO WHILE VCHOICE<>0
CALL DBTOOLS WITH "21,13,2,5,6,20,1,7,1,1"
mPARM="20,Y,"+STR(VCHOICE,2)+",13,15,0,2,First choice,Second choice,Third choice,@" mPARM="20,Y,"+STR(VCHOICE,2)+",13,15,0,2,First choice,Second choice,Third choice,@"
CALL DBTOOLS WITH mPARM
VCHOICE=VAL(mPARM)
DO CASE
CASE VCHOICE=1
* Put DO program to call when option 1 selected
CASE VCHOICE=2
* DO
CASE VCHOICE=3
* DO
CASE VCHOICE=99
* hotkey and control key processing
DO TRAPIT WITH mPARM,HCHOICE,mNUMHORZ,"HKMAIN" ENDCASE
EXIT
ENDCASE
CALL DBTOOLS WITH "19,13" && unpop window
ENDDO

CASE HCHOICE=2 && -------HMENU Option 2-------------------

* Code for popup menu off of HMENU second option:
DO WHILE VCHOICE<>0
CALL DBTOOLS WITH "21,13,2,29,7,44,1,7,15,0,1,1"
mPARM="20,Y,"+STR(VCHOICE,2)+",13,15,0,2,First choice,Second choice,Third choice,Fourth choice,@"
mPARM="20,Y,"+STR(VCHOICE,2)+",13,
CALL DBTOOLS WITH mPARM
VCHOICE=VAL(mPARM)
DO CASE
CASE VCHOICE=1
* Put DO program to call when option 1 selected
CASE VCHOICE=2
* DO
CASE VCHOICE=3
* DO
CASE VCHOICE=4
* DO
CASE VCHOICE=99
* hotkey and control key processing
DO TRAPIT WITH mPARM,HCHOICE,mNUMHORZ,"HKMAIN" ENDCASE
EXIT
ENDCASE
CALL DBTOOLS WITH "19,13" && unpop window
ENDDO
CASE HCHOICE=3 && -------HMENU Option 3---------------

* Code for popup menu off of HMENU third option:
DO WHILE VCHOICE<>0
CALL DBTOOLS WITH "21,13,2,49,6,64,1,7,15,0,1,1"
mPARM="20,Y,"+STR(VCHOICE,2)+",13,15,0,2,First choice,Second choice,Third choice,@"
CALL DBTOOLS WITH mPARM
VCHOICE=VAL(mPARM)
DO CASE
CASE VCHOICE=0 && ESC pressed
CASE VCHOICE=1
* Put DO program to call when option 1 selected
CASE VCHOICE=2
* DO
CASE VCHOICE=3
* DO
CASE VCHOICE=99
* hotkey and control key processing
DO TRAPIT WITH mPARM,HCHOICE,mNUMHORZ,"HKMAIN" ENDCASE
EXIT
ENDCASE
CALL DBTOOLS WITH "19,13" && unpop window
ENDDO
CASE HCHOICE=mNUMHORZ && ----------Last HMENU choice-------------
CALL DBTOOLS WITH "21,13,3,65,6,76,7,4,1,1"
VCHOICE = 1
mPARM="20,Y,"+STR(VCHOICE,2)+",3,15,0,1,Main Menu,Dot Prompt,@"
CALL DBTOOLS WITH mPARM
VCHOICE = VAL(mPARM)
DO CASE
CASE VCHOICE = 1
EXITNOW = .T.
CASE VCHOICE = 2
CALL DBTOOLS WITH "19,13"
CLEAR
CANCEL
CASE VCHOICE = 99
DO TRAPIT WITH mPARM,HCHOICE,mNUMHORZ,"HKMAIN"
ENDCASE
CALL DBTOOLS WITH "19,13"

CASE HCHOICE=99 && ----------HMENU hotkey processing-------
mKEY=ASC(SUBSTR(mMENUSTR,4,1))-1
mSCAN=ASC(SUBSTR(mMENUSTR,5,1))-1
HCHOICE=ASC(SUBSTR(mMENUSTR,6,1))
DO &mHKPROC WITH mKEY,mSCAN,HCHOICE
ENDCASE && HMENU case
ENDDO
RETURN

* NOTES:
* When you call another .PRG file off of a VMENU option, use function 15
* to save the screen at the beginning of the program, and function 14 to
* restore the screen right before the RETURN.
*
* OPTION.PRG
* CALL DBTOOLS WITH "15,3" && save screen in slot 3
* .
*
* .
* CALL DBTOOLS WITH "14,3,0" && restore screen
* RETURN && return to main menu


*|===================================================================
*| PROCEDURES - you'll need to put these in a procedure file
*|===================================================================


* -------------------------------------------------------------------
* TRAPIT - extracts scancodes and processes keys for VMENU
* This code can remain as is.
* -------------------------------------------------------------------
PROCEDURE TRAPIT
PARAMETERS mPARMSTR,HCHOICE,mMAXOPT,mHKPROC
mKEY=ASC(SUBSTR(mMENUSTR,4,1))-1
mSCAN=ASC(SUBSTR(mMENUSTR,5,1))-1
mCUROPT=ASC(SUBSTR(mMENUSTR,6,1))
mRETVAL = 0
DO CASE
CASE mKEY=0 .AND. mSCAN=75 && west
IF HCHOICE = 1
mRETVAL = mMAXOPT
ELSE
mRETVAL = HCHOICE - 1
ENDIF
CASE mKEY=0 .AND. mSCAN=77 && east
IF HCHOICE = mMAXOPT
mRETVAL = mMAXOPT
ELSE
mRETVAL = HCHOICE - 1
ENDIF
CASE mKEY=0 .AND. mSCAN=35 && Alt-h for Help
DO DISPHELP WITH HCHOICE,mCUROPT
mRETVAL = -HCHOICE
CASE mKEY=27 .AND. mSCAN=0 && ESC
mRETVAL = -HCHOICE && hotkey
OTHERWISE
DO &mHKPROC WITH mKEY,mSCAN,HCHOICE
ENDCASE
HCHOICE = -mRETVAL
RETURN


* ----------------------------------------------------------------
* HKMAIN - Hot key processor. You will have to change this to
* reflect your own choices.
* See Appendix E for scancodes for hotkeys.
* ----------------------------------------------------------------

PROCEDURE HKMAIN
PARAMETERS mKEY,mSCAN,HCHOICE
DO CASE
CASE mKEY=0 .AND. mSCAN=120 && Alt-1
mRETVAL = 1
CASE mKEY=0 .AND. mSCAN=121 && Alt-2
mRETVAL = 2
CASE mKEY=0 .AND. mSCAN=122 && Alt-3
mRETVAL = 3
CASE mKEY=17 .AND. mSCAN=0 && Cntrl-q
mRETVAL = 7
OTHERWISE
?? CHR(7) && beep for invalid
mRETVAL = -HCHOICE
ENDCASE
HCHOICE = -mRETVAL
RETURN
* --------------------------------------------------------------------
* DISPHELP - This routine can be modified to be as simple or complex
* as desired. Use of the mCURHMENU and mCURVMENU parameters tell you
* exactly where you were when you entered the routine, so you can
* produce context sensitive help.
* ---------------------------------------------------------------------
PROCEDURE DISPHELP
PARAMETERS mCURHMENU,mCURVMENU
CALL DBTOOLS WITH "21,12,8,40,12,75,0,3,2,1"
CALL DBTOOLS WITH "1,9,42,15,3,0,This is popup help for:"
CALL DBTOOLS WITH "1,10,45,0,3,0,HMENU option "+STR(mCURHMENU,2)
IF mCURVMENU>0
* If you press the help key while up on HMENU, you'll have VCHOICE=0
CALL DBTOOLS WITH "1,11,45,0,3,0,VMENU option "+STR(mCURVMENU,2)
ENDIF
CALL DBTOOLS WITH "10,12,43,15,3"
CALL DBTOOLS WITH "19,12"
RETURN


* ---------------------------------------------------------------------
* DRAWBG - draws screen backdrop for main menu.
* ---------------------------------------------------------------------
PROCEDURE DRAWBG

* Flavor to taste.
* SIMPLE:
CALL DBTOOLS WITH "7,2,1,7,0"
CALL DBTOOLS WITH "5,1,0,1,79,1"

* FANCY:
* Use function 12 to read a fancy screen image into a memory slot, then
* use a FADE from function 8 to display it in your startup initialization
* program. Assuming you saved the image in slot 1:

CALL DBTOOLS WITH "14,1,0" && display your image
* recolor your image to dark grey on white (makes it a little less obtrusive)
CALL DBTOOLS WITH "13,0,0,24,79,8,7"
CALL DBTOOLS WITH "5,1,0,1,79,1" && erase menu bar area
CALL DBTOOLS WITH "5,24,0,24,79,1" && erase status line
CALL DBTOOLS WITH "1,24,25,14,1,0,MAIN SYSTEM MENU"

RETURN