home *** CD-ROM | disk | FTP | other *** search
- ;****************************************************************************
- ; Dropdown Menu Procedures
- ;
- ; Author: Michael P. Lakeman
- ; Date : July 25, 1991
- ;
- ; This script contains several procedures which you can modify to customize
- ; a dropdown menu for your application. The areas for you to customize are
- ; contained with start and finish comment lines below.
-
- ; The following is a brief description of each these procedures:
- ;
- ; Optiongo() - This top-level proc displays the menu on the screen and it
- ; controls the execution of application procs or submenus.
- ; Create a case statement for each possible menu choice in
- ; your application. When a proc is executed, all memory
- ; variables are "cleaned up" and the Optiongo() proc is the
- ; only proc left in the calling chain.
-
- ; Dropmain() - This proc builds the top-level menu array and displays
- ; the main menu.
-
- ; Optn999() - Create one proc for each submenu in your application.
- ; See below for examples and more information.
-
- ; Rlsoptns() - This proc releases the array menu procs. Modify it to
- ; include all of your defined array menu procs.
-
-
- PROC Optiongo()
-
- WHILE (TRUE)
- Dropmain()
- WHILE (TRUE)
- Dropkey()
-
- IF z=27 THEN
- Cleanup()
- QUIT
- ENDIF
-
- IF lvl > 1 THEN
- s = SUBSTR(option[sel],4,18)
- ELSE
- s = SUBSTR(mmenu[msel],3,10)
- ENDIF
-
- ;(start)*********************************************************************
- ;Update the following SWITCH/CASE statement to execute the appropriate logic
- ;based on the selection that the user makes.
-
- SWITCH
-
- CASE s = "AMain " :
- Cleanup()
- BEEP ;<--Replace these statements with
- MESSAGE "THIS IS AMAIN" ;<--the name of the proc that you
- SLEEP 2000 ;<--wish to execute.
- RETURN ;<--see below for example\/
-
- ; CASE s = "AOptionAMain " : <--
- ; Cleanup() <-- EXAMPLE execution of proc
- ; Custentry() <--
-
- CASE s = "BOptionBMain " :
- Rlsoptns()
- ltv = y + 1
- lth = x + 5
- sel = 1
- Dropdown("optn221") ;<--To display a submenu, change this line
- LOOP ; to call Dropdown with the appropriate
- ; submenu array proc name.
- CASE s = "Quit " :
- Cleanup()
- RETURN
-
- ENDSWITCH
- ;(finish)********************************************************************
- ENDWHILE
- ENDWHILE
- ENDPROC
- WRITELIB libname.a Optiongo
- RELEASE PROCS Optiongo
-
- PROC Dropmain()
-
- PRIVATE dl
-
- CLEAR
-
- ;(start)*********************************************************************
- ;This array defines the selections for the main menu. You can have up
- ;to 7 choices on the main menu. The array value is made up of the following:
- ; Position Definition
- ; -------- ---------------------------------------
- ; 1 The unique letter used to access this option.
- ; 2 The position in the option name of the unique letter.
- ; 3-12 The option name to appear on the top line of the screen.
- ; 13-72 Option description to appear on line 24 of the screen.
-
- ARRAY mmenu[7]
- mmenu[1] = "A1AMain AMain Menu Selection "
- mmenu[2] = "B1BMain BMain Menu Selection "
- mmenu[3] = "C1CMain CMain Menu Selection "
- mmenu[4] = "D1DMain DMain Menu Selection "
- mmenu[5] = "E1EMain EMain Menu Selection "
- mmenu[6] = "F1FMain FMain Menu Selection "
- mmenu[7] = "Q1Quit Exit the System "
-
-
- IF MONITOR() = "Color" THEN
- mnuclr = 31
- mnuhigh = 95
- mnultr = 30
- dropclr = 63 ;You can modify this code to
- drophigh = 95 ;change the menu colors.
- dropltr = 62
- ELSE
- mnuclr = 7
- mnuhigh = 112
- mnultr = 15
- dropclr = 7
- drophigh = 112
- dropltr = 15
- ENDIF
-
- ;(finish)********************************************************************
-
- CURSOR OFF
- CANVAS OFF
- PAINTCANVAS ATTRIBUTE mnuclr 0,0,0,79
- STYLE ATTRIBUTE mnuclr
-
- msize = ARRAYSIZE(mmenu)
-
- lvl = 1
- msel = 1
- sel = 0
- y = 0
- x = 0
-
- FOR w FROM 1 TO msize
- @y,x ?? SUBSTR(mmenu[w],3,10)
- dl = NUMVAL(SUBSTR(mmenu[w],2,1))
- PAINTCANVAS ATTRIBUTE mnultr 0,(x+dl-1),0,(x+dl-1)
- x = x + 10
- ENDFOR
- x = 0
-
- Mpaintafter(y,x)
-
- IF MONITOR() = "Color" THEN
- STYLE ATTRIBUTE 31
- ELSE
- STYLE REVERSE
- ENDIF
- @4,10 ?? "╔════════════════════════════════════════════════════════════╗"
- @5,10 ?? "║ Put Your System Name Here ║"
- @6,10 ?? "╚════════════════════════════════════════════════════════════╝"
-
- IF MONITOR() = "Color" THEN
- STYLE ATTRIBUTE 113
- ELSE
- STYLE
- ENDIF
- @9,5 ?? "╔══════════════════════════════════════════════════════════════════════╗"
- @10,5 ?? "║ NOTE: Never turn off your computer while using this system ║"
- @11,5 ?? "║ A power failure may damage data files. Use the Fix Files ║"
- @12,5 ?? "║ selection on the Utilities menu to rebuild files. ║"
- @13,5 ?? "║ ║"
- @14,5 ?? "║ Use arrow keys to move around menu. Press ┘ to make ║"
- @15,5 ?? "║ selection. Or, press highlighted letter of menu choice ║"
- @16,5 ?? "║ to make selection. ║"
- @17,5 ?? "╚══════════════════════════════════════════════════════════════════════╝"
- STYLE
-
- CANVAS ON
-
- ENDPROC
- WRITELIB libname.a Dropmain
- RELEASE PROCS Dropmain
-
-
- ;(START)*********************************************************************
- ;Set up a proc as follows for each set of menu options. The last three
- ;numbers in the proc name are significant.
- ; First Number - Main Menu Selection (1-7)
- ; Second Number - Level (1-7)
- ; Third Number - Submenu Selection (1-n)
-
- ;The array value is made up of the following:
- ; Position Definition
- ; -------- ---------------------------------------
- ; 1 The unique letter used to access this option.
- ; 2-3 The position in the option name of the unique letter.
- ; 4-21 The option name to appear on the top line of the screen.
- ; 22-81 Option description to appear on line 24 of the screen.
-
-
- PROC optn110()
-
- ARRAY optn110[1]
- optn110[1] = "A01AOptionAMain AOptionAMain Menu Selection "
- osize = ARRAYSIZE(optn110)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn110[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn110
- RELEASE PROCS Optn110
-
- PROC Optn210()
-
- ARRAY optn210[4]
- optn210[1] = "A01AOptionBMain AOptionBMain Menu Selection "
- optn210[2] = "B01BOptionBMain BOptionBMain Menu Selection "
- optn210[3] = "C01COptionBMain COptionBMain Menu Selection "
- optn210[4] = "D01DOptionBMain DOptionBMain Menu Selection "
- osize = ARRAYSIZE(optn210)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn210[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn210
- RELEASE PROCS Optn210
-
- PROC Optn310()
-
- ARRAY optn310[4]
- optn310[1] = "A01AOptionCMain AOptionCMain Menu Selection "
- optn310[2] = "B01BOptionCMain BOptionCMain Menu Selection "
- optn310[3] = "C01COptionCMain COptionCMain Menu Selection "
- optn310[4] = "D01DOptionCMain DOptionCMain Menu Selection "
- osize = ARRAYSIZE(optn310)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn310[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn310
- RELEASE PROCS Optn310
-
- PROC Optn410()
-
- ARRAY optn410[4]
- optn410[1] = "A01AOptionDMain AOptionDMain Menu Selection "
- optn410[2] = "B01BOptionDMain BOptionDMain Menu Selection "
- optn410[3] = "C01COptionDMain COptionDMain Menu Selection "
- optn410[4] = "D01DOptionDMain DOptionDMain Menu Selection "
- osize = ARRAYSIZE(optn410)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn410[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn410
- RELEASE PROCS Optn410
-
- PROC Optn510()
-
- ARRAY optn510[4]
- optn510[1] = "A01AOptionEMain AOptionEMain Menu Selection "
- optn510[2] = "B01BOptionEMain BOptionEMain Menu Selection "
- optn510[3] = "C01COptionEMain COptionEMain Menu Selection "
- optn510[4] = "D01DOptionEMain DOptionEMain Menu Selection "
- osize = ARRAYSIZE(optn510)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn510[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn510
- RELEASE PROCS Optn510
-
- PROC Optn610()
-
- ARRAY optn610[4]
- optn610[1] = "A01AOptionFMain AOptionFMain Menu Selection "
- optn610[2] = "B01BOptionFMain BOptionFMain Menu Selection "
- optn610[3] = "C01COptionFMain COptionFMain Menu Selection "
- optn610[4] = "D01DOptionFMain DOptionFMain Menu Selection "
- osize = ARRAYSIZE(optn610)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn610[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn610
- RELEASE PROCS Optn610
-
- PROC Optn710()
-
- ARRAY optn710[1]
- optn710[1] = "Quit Quit "
- osize = ARRAYSIZE(optn710)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn710[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn710
- RELEASE PROCS Optn710
-
- PROC Optn221()
-
- ARRAY optn221[4]
- optn221[1] = "A01AOptionGMain AOptionGMain Menu Selection "
- optn221[2] = "B01BOptionGMain BOptionGMain Menu Selection "
- optn221[3] = "C01COptionGMain COptionGMain Menu Selection "
- optn221[4] = "D01DOptionGMain DOptionGMain Menu Selection "
- osize = ARRAYSIZE(optn221)
- ARRAY option[osize]
- FOR w FROM 1 TO osize
- option[w] = optn221[w]
- ENDFOR
-
- ENDPROC
- WRITELIB libname.a Optn221
- RELEASE PROCS Optn221
-
- PROC Rlsoptns()
-
- RELEASE VARS option,optn110,optn210,optn310,optn410,optn510,
- optn610,optn710,optn810,optn221
-
- ENDPROC
- WRITELIB libname.a Rlsoptns
- RELEASE PROCS Rlsoptns
-
- ;(finish)********************************************************************
-
- ;****************************************************************************
- ;*******************Do Not Change the Following Procedures*******************
- ;****************************************************************************
-
- PROC Dropkey()
-
- WHILE (TRUE)
-
- z = getchar()
-
- SWITCH
-
- CASE lvl = 1 :
-
- SWITCH
- ;Letter selection in top menu
- CASE ((z > 64 AND z < 91) OR
- (z > 96 AND z < 123)) OR
- (z > 47 AND z < 58) :
- MLtrsrch()
- IF retval = False THEN
- ltv = 1
- lth = x
- sel = 1
- Dropdown("Optn"+STRVAL(msel)+STRVAL(lvl)+STRVAL(sel-1))
- IF retval = False THEN
- RETURN
- ENDIF
- lvl = 2
- ENDIF
-
- ;Right
- CASE z = -77 :
- Horzright("1")
- IF retval = False THEN
- LOOP
- ENDIF
-
- ;Left
- CASE z = -75 :
- Horzleft("1")
- IF retval = False THEN
- LOOP
- ENDIF
-
- ;Down from Top Menu OR Enter from Top Menu
- CASE (z = -80 OR z = 13) :
-
- ltv = 1
- lth = x
- sel = 1
- @1,0 CLEAR EOS
- Dropdown("Optn"+STRVAL(msel)+STRVAL(lvl)+STRVAL(sel-1))
- IF retval = False THEN
- RETURN
- ENDIF
- lvl = 2
-
- ;Home
- CASE z = -71 :
- RELEASE VARS option,option0,option1,option2,option3,option4,
- option5,option6,option7
- @1,0 CLEAR EOS
- @y,x
- Mpaintbefore(y,x)
- msel = 1
- x = 0
- Mpaintafter(y,x)
-
- ;End
- CASE z = -79 :
- RELEASE VARS option,option0,option1,option2,option3,option4,
- option5,option6,option7
- @1,0 CLEAR EOS
- @y,x
- Mpaintbefore(y,x)
- msel = msize
- x = (msize - 1) * 10
- Mpaintafter(y,x)
-
- ;Esc to exit
- CASE z = 27 :
- BEEP
-
- ENDSWITCH
-
- CASE lvl > 1 :
- SWITCH
-
- ;Letter selection in drop menu
- CASE ((z > 64 AND z < 91) OR
- (z > 96 AND z < 123)) OR
- (z > 47 AND z < 58) :
- DLtrsrch()
- IF retval = False THEN
- RETURN
- ENDIF
-
- ;Right
- CASE z = -77 :
- Horzright("2")
- IF retval = False THEN
- LOOP
- ENDIF
-
- ;Left
- CASE z = -75 :
- Horzleft("2")
- IF retval = False THEN
- LOOP
- ENDIF
-
- ;Enter to select an option
- CASE z = 13 :
- QUITLOOP
-
- ;Down in Drop Menu
- CASE z = -80 :
- Vertdown()
- IF retval = False THEN
- LOOP
- ENDIF
-
- ;Esc from Drop Menu
- CASE (z = 27) :
- Rlsoptns()
- @1,0 CLEAR EOS
- y = 0
- x = (msel - 1) * 10
- lvl = 1
- IF lvl = 1 THEN
- sel = 0
- ELSE
- sel = 1
- ENDIF
- PAINTCANVAS ATTRIBUTE mnuclr 24,0,24,79
- STYLE ATTRIBUTE mnuclr
- @24,0 ?? SUBSTR(mmenu[msel],13,60)
- @y,x
-
- ;Up in Drop Menu
- CASE z = -72 :
- Vertup()
- IF retval = False THEN
- LOOP
- ENDIF
-
- ENDSWITCH
- ENDSWITCH
-
- ENDWHILE
-
- ENDPROC
- WRITELIB libname.a Dropkey
- RELEASE PROCS Dropkey
-
- PROC Horzright(a)
- IF msel = msize THEN
- BEEP
- RETURN False
- ENDIF
- Rlsoptns()
- @1,0 CLEAR EOS
- lvl = 1
- sel = 0
- y = 0
- x = (msel - 1) * 10
- @y,x
- Mpaintbefore(y,x)
- msel = msel + 1
- x = (msel - 1) * 10
- Mpaintafter(y,x)
- IF a = "2" THEN
- sel = 1
- ltv = 1
- lth = x
- Dropdown("Optn"+STRVAL(msel)+STRVAL(lvl)+STRVAL(sel-1))
- IF retval = False THEN
- RETURN
- ENDIF
- lvl = 2
- ENDIF
- RETURN True
-
- ENDPROC
- WRITELIB libname.a Horzright
- RELEASE PROCS Horzright
-
- PROC Horzleft(a)
-
- IF msel = 1 THEN
- BEEP
- RETURN False
- ENDIF
- Rlsoptns()
- @1,0 CLEAR EOS
- lvl = 1
- sel = 0
- y = 0
- x = (msel - 1) * 10
- @y,x
- Mpaintbefore(y,x)
- msel = msel - 1
- x = (msel - 1) * 10
- Mpaintafter(y,x)
- IF a = "2" THEN
- sel = 1
- ltv = 1
- lth = x
- Dropdown("Optn"+STRVAL(msel)+STRVAL(lvl)+STRVAL(sel-1))
- IF retval = False THEN
- RETURN
- ENDIF
- lvl = 2
- ENDIF
- RETURN True
-
- ENDPROC
- WRITELIB libname.a Horzleft
- RELEASE PROCS Horzleft
-
- PROC Dropdown(optionname)
-
- EXECPROC optionname
-
- IF osize = 1 THEN
- RETURN False
- ENDIF
-
- Dropbox()
- RETURN True
-
- ENDPROC
- WRITELIB libname.a Dropdown
- RELEASE PROCS Dropdown
-
- PROC Dropbox()
-
- PRIVATE dl
-
- STYLE ATTRIBUTE dropclr
- CANVAS OFF
- @ltv,lth ?? "╔══════════════════╗"
- FOR w FROM (ltv+1) TO (ltv+osize)
- @w,lth ?? "║"+SUBSTR(option[w-ltv],4,18)+"║"
- dl = NUMVAL(SUBSTR(option[w-ltv],2,2))
- PAINTCANVAS ATTRIBUTE dropltr w,(lth+dl),w,(lth+dl)
- ENDFOR
- @(ltv+osize+1),lth ?? "╚══════════════════╝"
- STYLE
- FOR w FROM (ltv+1) TO (ltv+osize+2)
- @w,(lth+20) ?? "█"
- ENDFOR
- @(ltv+osize+2),(lth+1) ?? "▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀"
- CANVAS ON
- @3,(lth+1)
- y = ltv + 1
- x = lth
- Dpaintafter(y,x)
-
- ENDPROC
- WRITELIB libname.a Dropbox
- RELEASE PROCS Dropbox
-
- PROC Vertdown()
-
- IF sel = (osize) THEN
- BEEP
- RETURN False
- ENDIF
- Dpaintbefore(y,x)
- y = y + 1
- sel = sel + 1
- Dpaintafter(y,x)
- RETURN True
-
- ENDPROC
- WRITELIB libname.a Vertdown
- RELEASE PROCS Vertdown
-
- PROC Vertup()
-
- IF sel = 1 THEN
- BEEP
- RETURN False
- ENDIF
- Dpaintbefore(y,x)
- y = y - 1
- sel = sel - 1
- Dpaintafter(y,x)
- RETURN True
-
- ENDPROC
- WRITELIB libname.a Vertup
- RELEASE PROCS Vertup
-
- PROC MLtrsrch()
-
- PRIVATE vsave
-
- z = CHR(z)
- z = UPPER(z)
- vctr = 0
- FOR w FROM 1 TO msize
- IF SUBSTR(mmenu[w],1,1) = z THEN
- IF NOT ISASSIGNED(vsave) THEN
- vsave = w
- ENDIF
- vctr = vctr + 1
- ENDIF
- ENDFOR
- SWITCH
- CASE vctr = 0 :
- RETURN True
-
- CASE vctr = 1 :
- @1,0 CLEAR EOS
- Mpaintbefore(y,x)
- x = (vsave - 1) * 10
- msel = vsave
- Mpaintafter(y,x)
- Rlsoptns()
- RETURN False
-
- OTHERWISE :
- Mpaintbefore(y,x)
- x = (vsave - 1) * 10
- msel = vsave
- Mpaintafter(y,x)
- Rlsoptns()
- RETURN True
-
- ENDSWITCH
-
- ENDPROC
- WRITELIB libname.a MLtrsrch
- RELEASE PROCS MLtrsrch
-
- PROC DLtrsrch()
-
- PRIVATE vsave
-
- z = CHR(z)
- z = UPPER(z)
- vctr = 0
- FOR w FROM 1 TO osize
- IF SUBSTR(option[w],1,1) = z THEN
- IF NOT ISASSIGNED(vsave) THEN
- vsave = w
- ENDIF
- vctr = vctr + 1
- ENDIF
- ENDFOR
- SWITCH
- CASE vctr = 0 :
- RETURN True
-
- CASE vctr = 1 :
- Dpaintbefore(y,x)
- y = ltv + vsave
- sel = vsave
- Dpaintafter(y,x)
- RETURN False
-
- OTHERWISE :
- Dpaintbefore(y,x)
- y = ltv + vsave
- sel = vsave
- Dpaintafter(y,x)
- RETURN True
-
- ENDSWITCH
-
- ENDPROC
- WRITELIB libname.a DLtrsrch
- RELEASE PROCS DLtrsrch
-
- PROC Dpaintbefore(dy,dx)
-
- PAINTCANVAS ATTRIBUTE dropclr dy,(dx+1),dy,(dx+18)
- dl = NUMVAL(SUBSTR(option[sel],2,2))
- PAINTCANVAS ATTRIBUTE dropltr dy,(dx+dl),dy,(dx+dl)
-
- ENDPROC
- WRITELIB libname.a Dpaintbefore
- RELEASE PROCS Dpaintbefore
-
- PROC Mpaintbefore(dy,dx)
-
- PAINTCANVAS ATTRIBUTE mnuclr dy,dx,dy,dx+9
- dl = NUMVAL(SUBSTR(mmenu[msel],2,1))
- PAINTCANVAS ATTRIBUTE mnultr dy,(dx+dl-1),dy,(dx+dl-1)
-
- ENDPROC
- WRITELIB libname.a Mpaintbefore
- RELEASE PROCS Mpaintbefore
-
- PROC Dpaintafter(dy,dx)
-
- PAINTCANVAS ATTRIBUTE drophigh dy,(dx+1),dy,(dx+18)
- PAINTCANVAS ATTRIBUTE mnuclr 24,0,24,79
- STYLE ATTRIBUTE mnuclr
- @24,0 ?? SUBSTR(option[sel],22,60)
-
- ENDPROC
- WRITELIB libname.a Dpaintafter
- RELEASE PROCS Dpaintafter
-
- PROC Mpaintafter(dy,dx)
-
- PAINTCANVAS ATTRIBUTE mnuhigh dy,dx,dy,dx+9
- PAINTCANVAS ATTRIBUTE mnuclr 24,0,24,79
- STYLE ATTRIBUTE mnuclr
- @24,0 ?? SUBSTR(mmenu[msel],13,60)
-
- ENDPROC
- WRITELIB libname.a Mpaintafter
- RELEASE PROCS Mpaintafter
-
- PROC Cleanup()
-
- Rlsoptns()
-
- RELEASE VARS mmenu,y,x,z,w,s,mnuclr,mnuhigh,mnultr,dropclr,drophigh,
- dropltr,osize,msize,vsave,vctr,dl,dy,dx,sel,msel,lvl,
- lvl,sel,msel,ltv,lth
-
- ENDPROC
- WRITELIB libname.a Cleanup
- RELEASE PROCS Cleanup
-