Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / xbase / library / clipper / debug / prg_help / menuproc.prg < prev next >

Wrap

Text File | 1987-04-07 | 11.9 KB | 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 ************************************* **********************************************************************