home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
prg_hlp.zip
/
MENUPROC.PRG
< prev
next >
Wrap
Text File
|
1987-04-07
|
12KB
|
566 lines
**********************************************************************
* *
* S. Robert Davidoff *
* MENUPROC.PRG *
* *
* *
**********************************************************************
*...This is a procedure file
*Banner
*choice
*center
*F1
*Lightbar
*print_set
*first_cap
*no_zero
**********************************************************************
* *
* LIGHTBAR PROCEDURE *
* This procedure creates verticle lightbar menus *
* *
**********************************************************************
procedure lightbar
parameters items,x1,y1,width,entry1,entry2,entry3,entry4,entry5,entry6,entry7,entry8,entry9,entry10
answer = space(1)
store x1 to x1m
store y1 to y1m
store "N/W" to frm_colorm && Inverse
store "W/N" to mnu_colorm && normal
store "N/W" to bar_colorm && inverse
CALL CURSW WITH "OFF"
* display menu and process the keys pressed *
set color to &frm_colorm
@ x1m,y1m to (x1m+1+items),(y1m+width+1) double
set color to &mnu_colorm
* Enter menu lines to screen *
for n=1 to items && FOR-NEXT LOOP
nstring = iif(n = 10,str(n,2),str(n,1))
menu_line = iif(entry&nstring = "XXXX",space(width),entry&nstring)
@ x1+n,y1+1 say menu_line
next
n=x1+1
k=1
control= .T.
do while control=.T.
kstring = iif(k = 10,str(k,2),str(k,1))
store entry&kstring to menu_line
* display current inverse lightbar *
set color to &bar_colorm
@ n,y1+1 say upper(menu_line)
* wait for key to be pressed *
selection = 0
do while selection=0
selection=inkey()
enddo
* redisplay hilite area back to normal *
if selection<>13
set color to &mnu_colorm
@ n,y1+1 say upper(menu_line)
endif
do case
* down arrow was pressed *
case selection=24
k=k+1
n=n+1
if k>items
n=x1+1
k=1
endif
loop
* up arrow was pressed *
case selection=5
k=k-1
n=n-1
if k<1
n=x1+items
k=items
endif
loop
* Home or page up was pressed *
case selection = 1 .or. selection = 18
k=1
n=x1+1
loop
* End or page down was pressed *
case selection = 6 .or. selection = 3
k = items
n = x1+items
loop
* F1 was pressed *
case selection = 28
do help with A, B, C
loop
* F2 was pressed *
case selection = -1
do prg_hlp with A, B, C
loop
case selection = 48 && 0 key pressed
k=0
control=.F.
loop
case selection = 49 && 1 key pressed
k=1
control=.F.
loop
case selection = 50 && 2 key pressed
k=2
control=.F.
loop
case selection = 51 && 3 key pressed
IF 3 > items
loop
endif
k=3
control=.F.
loop
case selection = 52 && 4 key pressed
IF 4 > items
loop
endif
k=4
control=.F.
loop
case selection = 53 && 5 key pressed
IF 5 > items
loop
endif
k=5
control=.F.
loop
case selection = 54 && 6 key pressed
IF 6 > items
loop
endif
k=6
control=.F.
loop
case selection = 55 && 7 key pressed
IF 7 > items
loop
endif
k=7
control=.F.
loop
case selection = 56 && 8 key pressed
IF 8 > items
loop
endif
k=8
control=.F.
loop
case selection = 57 && 9 key pressed
IF 9 > items
loop
endif
k=9
control=.F.
loop
* <cr> was pressed *
case selection=13
control=.F.
loop
case (selection = 121) .or. (selection = 89) && Y key pressed
answer = "Y"
exit
case (selection = 110) .or. (selection = 78) && N key pressed
answer = "N"
exit
endcase
enddo
if k >= items
selection = 0
else
selection=k
endif
* return video attributes to normal *
set color to w/n
CALL CURSW WITH "ON"
return
**********************************************************************
* *
* This procedure creates horizontal light bar menus *
* *
**********************************************************************
PROCEDURE H_LIGHT
parameters items,x1,y1,width,entry1,entry2,entry3,entry4,entry5,entry6,entry7,entry8,entry9,entry10,lstring
answer = space(1)
width = width + 4
mlength = items *width
y1 = (78-mlength)/2
set color to
* Enter menu lines to screen *
CALL CURSW
N = 1
DO WHILE N <= items
nstring = iif(n = 10,str(n,2),str(n,1))
menu_line = iif(entry&nstring = "XXXX",space(width),entry&nstring)
@ x1,y1+(N*WIDTH)-width say menu_line
N = N + 1
ENDDO
n=1
k=1
control= .T.
do while control
kstring = iif(k = 10,str(k,2),str(k,1))
store entry&kstring to menu_line
* display current inverse lightbar *
set color to I
@ X1,y1+(N*width)-width say trim(upper(menu_line))
* wait for key to be pressed *
selection = 0
do while selection=0
selection=inkey()
enddo
* redisplay hilite area back to normal *
if selection<>13
set color to
@ X1,y1+(N*width)-width say trim(upper(menu_line))
endif
do case
* right arrow was pressed *
case selection=4
k=k+1
n=n+1
if k>items
n=1
k=1
endif
loop
* left arrow was pressed *
case selection=19
k=k-1
n=n-1
if k<1
n=items
k=items
endif
loop
* Home was pressed *
case selection = 1
k=1
n=1
loop
* End was pressed *
case selection = 6
k = items
n = items
loop
* F1 was pressed *
case selection = 28
do help with A, B, C
loop
* F2 was pressed *
case selection = -1
do prg_hlp with A, B, C
loop
case selection = 48 && 0 key pressed
k=0
control=.F.
loop
case selection = 49 && 1 key pressed
k=1
control=.F.
loop
case selection = 50 && 2 key pressed
k=2
control=.F.
loop
case selection = 51 && 3 key pressed
IF 3 > items
loop
endif
k=3
control=.F.
loop
case selection = 52 && 4 key pressed
IF 4 > items
loop
endif
k=4
control=.F.
loop
case selection = 53 && 5 key pressed
IF 5 > items
loop
endif
k=5
control=.F.
loop
case selection = 54 && 6 key pressed
IF 6 > items
loop
endif
k=6
control=.F.
loop
case selection = 55 && 7 key pressed
IF 7 > items
loop
endif
k=7
control=.F.
loop
case selection = 56 && 8 key pressed
IF 8 > items
loop
endif
k=8
control=.F.
loop
case selection = 57 && 9 key pressed
IF 9 > items
loop
endif
k=9
control=.F.
loop
* <cr> was pressed *
case selection=13
control=.F.
loop
case upper(chr(selection)) $ lstring
mpos = AT((upper(chr(selection))),lstring)
k = mpos
exit
endcase
enddo
if k >= items
selection = 0
else
selection=k
endif
* return video attributes to normal *
set color to
CALL CURSW
return
*********************************************************************
Procedure F1 && help box
parameter string
private mlen
string = "F1- " + string
mlen = len(trim(string))
@ 19,(37 - (mlen/2)) to 21,(42 + (mlen/2))
set color to I
@ 20,(39-(mlen/2)) say space(mlen+2)
@ 20,(40-(mlen/2)) say string
set color to
return
**********************************************************************
procedure print_set
do clearit with 4,1,23,78
mvar = iif(isprinter(),"ON","OFF")
@ 8,20 to 17,60 double
if mvar = "ON"
set color to I
do center with 12, "PRINTER IS ON-LINE "
else
set color to I*
do center with 11, "THE PRINTER IS OFF "
do center with 12, "TURN PRINTER ON NOW "
endif
if .not. tof()
eject
endif
set color to
@ 23,5
wait
return
**********************************************************************
procedure BANNER
Parameter BANNER
clear
@ 2,2 say cdow(date())
@ 2,(78-len(banner))/2 say banner
@ 2,78-len(cdate) say cdate
@ 3,1 say BAR
return
**********************************************************************
procedure CENTER
Parameters row, string
@ row,(78-len(string))/2 say string
return
**********************************************************************
procedure CHOICE
Parameters INSTRUCTION, RANGE
@ 22,1 SAY BAR
choice = " "
do while .not. choice $ RANGE
@23,2
wait INSTRUCTION to choice
enddo
return
**********************************************************************
function first_cap
parameters fstring
ms_len = len(fstring)
if ms_len = 0
return(" ")
else
a = upper(substr(fstring,1,1))
b = lower(substr(fstring,2,ms_len))
fstring = a + b
endif
return(fstring)
**********************************************************************
procedure five_dig
parameter mdigit
mdigit = alltrim(mdigit)
do case
case len(mdigit) = 1
mdigit = "0000" + mdigit
case len(mdigit) = 2
mdigit = "000" + mdigit
case len(mdigit) = 3
mdigit = "00" + mdigit
case len(mdigit) = 4
mdigit = "0" + mdigit
endcase
return
**********************************************************************
function no_zero
* strips leading zeros off a character string *
parameters mstring
mstring = ltrim(mstring)
mlength = 0
mlength = len(trim(mstring))
if mlength = 0
return("0")
endif
counter = 1
do while counter < mlength
if substr(mstring,1,1) = "0"
mstring = substr(mstring,2,(mlength-(counter-1)))
counter = counter + 1
else
exit
endif
enddo
return(mstring)
**********************************************************************
FUNCTION DBF
* Syntax: DBF()
* Return: The alias of the currently selected database.
* Note..: Supposed to return the name of the currently selected database file.
*
RETURN ALIAS()
**********************************************************************
FUNCTION ALLTRIM
PARAMETERS cl_string
RETURN LTRIM(TRIM(cl_string))
**********************************************************************
procedure print
do clearit with 4,1,23,78
mvar = iif(isprinter(),"ON","OFF")
@ 8,20 to 17,60 double
if mvar = "ON"
set color to I
do center with 12, "PRINTER IS ON-LINE "
else
set color to I*
do center with 11, "THE PRINTER IS OFF "
do center with 12, "TURN PRINTER ON NOW "
endif
if .not. tof()
eject
endif
set color to
@ 23,5
wait
return
**********************************************************************
function TOF
if pcol() = 0 .and. prow() = 0
return(.T.)
else
return(.F.)
endif
procedure hlp_mes
parameters mstring
@ 0,0 clear
do center with 12, mstring
set color to I*
@ 0,0 to 24,79 double
@ 1,1 to 23,78 double
set color to
inkey(7)
return
**************************** EOF *************************************
**********************************************************************
