Output of file : CLOSET.PRG contained in archive :
DBT123S.ZIP
* 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
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/