set procedure to menutest
public secok, retval, nf, nf1, word, colstr
set color to rgb(0,0,0,192,192,192)
modify window screen font 'courier', 8
dimension mnu(15)
store 'rgb(0,0,0,255,255,255),rgb(0,0,0,192,192,192)' to colstr
store 'W' to word
clear
do while .t.
do clrmenu
store 'Login To System ' to mnu(1)
store 'File Maintenance Menu ' to mnu(2)
store 'Reporting Menus ' to mnu(3)
store 'Software Tech Support ' to mnu(4)
store 'Administrator Menu ' to mnu(5)
store 'Utilities Menu ' to mnu(6)
store 'Graphic/Logo Selection' to mnu(7)
store 'Quit This Screen ' to mnu(8)
store 8 to numel
store 2 to xcoord
store 2 to ycoord
store ' Master Menu ' to mtitle
do cmenu with xcoord, ycoord, numel, mtitle, mnu
store substr(mchoice,1,1) to nf
wait window ' Choice is '+nf+' '
if nf = 'Q'
return
endif nf = 'Q'
enddo while .t.
procedure cmenu
parameter xcoord, ycoord, numel, mtitle, mnu
public mchoice, mchoice1
store 1 to zctr
store 0 to longest
do while zctr <= numel
if len(rtrim(mnu(zctr))) > longest
store len(rtrim(mnu(zctr))) to longest
endif len(rtrim(mnu(zctr))) > longest
zctr = zctr + 1
enddo while zctr <= numel
if ycoord > 12
adder = -9
else
adder = 0
endif ycoord<10
zxadd = val(str((numel * 1.25)+1,5,0))
zysub = val(str(longest *.2,5,0))
define window menuwin;
from xcoord,ycoord+adder;
to xcoord+3+zxadd,ycoord+longest+adder-zysub+11;
title mtitle;
color &colstr;
system;
float;
font 'Arial'
activate window menuwin
if word = 'W'
store 'N' to mchoice1
store '*' to base
store ' ' to addl1
store ' ' to addl2
store 1 to zctr
store 1 to zctr
do while zctr <= numel
@ zctr,2 say mnu(zctr)
zctr = zctr + 1
enddo while zctr <= numel
store 1 to zctr
do while zctr <= numel .and. zctr <= 8
store substr(mnu(zctr),1,1) to zxc
store addl1+'\<&zxc;' to addl1
zctr = zctr + 1
enddo while zctr <= numel
do while zctr <= numel .and. zctr <= 16
store substr(mnu(zctr),1,1) to zxc
store addl2+'\<&zxc;' to addl2
zctr = zctr + 1
enddo while zctr <= numel
store len(addl1) to ad1
store len(addl2) to ad2
store base+substr(addl1,1,ad1-1) to mprompt1
store base+substr(addl2,1,ad2-1) to mprompt2
@ 1,longest+7 get mchoice1 function mprompt1 size 1, 5 color &colstr font 'arial' style 'bi'
if numel > 8
@ 9,longest+7 get mchoice1 function mprompt2 size 1, 5 color &colstr font 'arial' style 'bi'
endif numel > 8
read
deactivate window menuwin
release window menuwin
store substr(mchoice1,1,1) to mchoice
return
endif word = 'W'
store 1 to cursel
store 0 to invar
do while .t.
store 1 to zctr
do while zctr <= numel
@ zctr,2 say mnu(zctr)
zctr = zctr + 1
enddo while zctr <= numel
@ cursel,2 say padr(mnu(cursel),longest,' ')
if invar = 5
cursel = cursel - 1
if cursel = 0
store numel to cursel
endif cursel = 0
endif invar = 5
if invar = 24
cursel = cursel + 1
if cursel = numel + 1
store 1 to cursel
endif cursel = numel + 1
endif invar = 24
store ' ' to lookup
do getlet
store 'N' to validlet
if lookup <> ' '
store 1 to zctr
do while zctr <= numel
if lookup = substr(mnu(zctr),1,1)
store 'Y' to validlet
exit
endif lookup = substr(mnu(zctr),1,1)
zctr = zctr + 1
enddo while zctr <= numel
endif lookup <> ' '
if validlet = 'Y'
store zctr to cursel
endif validlet = 'Y'
@ cursel,2 say padr(mnu(cursel),longest,' ') color i
if invar = 13
exit
endif invar = 13
invar = inkey(0,'H')
enddo .t.
deactivate window menuwin
release window menuwin
store substr(mnu(cursel),1,1) to mchoice
return
procedure getlet
if invar = 97 .or. invar = 65
store 'A' to lookup
endif invar = 97 .or. invar = 65
if invar = 98 .or. invar = 66
store 'B' to lookup
endif invar = 98 .or. invar = 66
if invar = 99 .or. invar = 67
store 'C' to lookup
endif invar = 99 .or. invar = 67
if invar = 100 .or. invar = 68
store 'D' to lookup
endif invar = 100 .or. invar = 68
if invar = 101 .or. invar = 69
store 'E' to lookup
endif invar = 101 .or. invar = 69
if invar = 102 .or. invar = 70
store 'F' to lookup
endif invar = 102 .or. invar = 70
if invar = 103 .or. invar = 71
store 'G' to lookup
endif invar = 103 .or. invar = 71
if invar = 104 .or. invar = 72
store 'H' to lookup
endif invar = 104 .or. invar = 72
if invar = 105 .or. invar = 73
store 'I' to lookup
endif invar = 105 .or. invar = 73
if invar = 106 .or. invar = 74
store 'J' to lookup
endif invar = 106 .or. invar = 74
if invar = 107 .or. invar = 75
store 'K' to lookup
endif invar = 107 .or. invar = 75
if invar = 108 .or. invar = 76
store 'L' to lookup
endif invar = 108 .or. invar = 76
if invar = 109 .or. invar = 77
store 'M' to lookup
endif invar = 109 .or. invar = 77
if invar = 110 .or. invar = 78
store 'N' to lookup
endif invar = 110 .or. invar = 78
if invar = 111 .or. invar = 79
store 'O' to lookup
endif invar = 111 .or. invar = 79
if invar = 112 .or. invar = 80
store 'P' to lookup
endif invar = 112 .or. invar = 80
if invar = 113 .or. invar = 81
store 'Q' to lookup
endif invar = 113 .or. invar = 81
if invar = 114 .or. invar = 82
store 'R' to lookup
endif invar = 114 .or. invar = 82
if invar = 115 .or. invar = 83
store 'S' to lookup
endif invar = 115 .or. invar = 83
if invar = 116 .or. invar = 84
store 'T' to lookup
endif invar = 116 .or. invar = 84
if invar = 117 .or. invar = 85
store 'U' to lookup
endif invar = 117 .or. invar = 85
if invar = 118 .or. invar = 86
store 'V' to lookup
endif invar = 118 .or. invar = 86
if invar = 119 .or. invar = 87
store 'W' to lookup
endif invar = 119 .or. invar = 87
if invar = 120 .or. invar = 88
store 'X' to lookup
endif invar = 120 .or. invar = 88
if invar = 121 .or. invar = 89
store 'Y' to lookup
endif invar = 121 .or. invar = 89
if invar = 122 .or. invar = 90
store 'Z' to lookup
endif invar = 122 .or. invar = 90
if invar >= 48 .and. invar <=57
store str(invar-48,1,0) to lookup
endif invar >= 48 .and. invar <=57
return
procedure clrmenu
store 1 to ctr
do while ctr <= 15
store ' ' to mnu(ctr)
store ctr + 1 to ctr
enddo while ctr <= 30
return