Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB3-GKEY.ZIP
Filename : TIMEPROC.PRG

** Last revision: May 20, 1986 at 10:23

** by: H.M. Van Tassell

*
* NOTE: if not using dBASEIII Plus, pls remove the && comments
*

PROCEDURE T_GetKey
*
* Called with a list of acceptable choices in values
* If values = "*" then ANY key press will be accepted
* Returns the acceptable character in choice
* prints time while waiting for the right key press
*
PARAMETER choice,values
PRIVATE bad_choice, key, t_row, t_col, dl_row, dl_col, dl_i, dl_j, do_colon
*
t_row = trow && row/colm to print time
t_col = tcol && could be passed as parameters
bad_choice = .T.
dl_row = ROW() && row/colm to print ?
dl_col = COL() && subtract 1 if calling pgm printed a ?
dl_j = 0
*
DO WHILE bad_choice
** @ dl_row,dl_col SAY "?" && print a ? at present colm position
CALL CursOff && not needed if calling pgm controls cursor
SET COLOR TO &RevVideo
DO CASE
CASE (VAL(TIME())<10)
@ t_row,t_col+1 SAY " " + SUBSTR(TIME(),2,4) + " am "
CASE (VAL(TIME())<12)
@ t_row,t_col SAY " " + SUBSTR(TIME(),1,5) + " am "
CASE (VAL(TIME())=12)
@ t_row,t_col SAY " " + SUBSTR(TIME(),1,5) + " pm "
OTHERWISE
dl_i=2
IF (VAL(TIME())<20)
dl_i=1
ENDIF
@ t_row,t_col+2-dl_i SAY " " + STR(VAL(TIME())-12, dl_i) +;
SUBSTR(TIME(),3,3) + " pm "
ENDCASE
@ dl_row,dl_col SAY ""
CALL CursOn && not needed if calling pgm controls cursor
SET COLOR TO &StdVideo
*
* Wait for a keypress or the time to change.
do_colon = .T.
dl_tm = SUBSTR(TIME(),4,2)
DO WHILE dl_tm = SUBSTR(TIME(),4,2) .AND. bad_choice
CALL CursOff
SET COLOR TO &RevVideo
IF do_colon
@ t_row,t_col+3 SAY ":"
do_colon = .F.
ELSE
@ t_row,t_col+3 SAY " "
do_colon = .T.
ENDIF
@ dl_row,dl_col SAY ""
CALL CursOn
SET COLOR TO &StdVideo
dl_ts = SUBSTR(TIME(),7,2)
DO WHILE dl_ts = SUBSTR(TIME(),7,2) .AND. bad_choice
key = INKEY()
choice = UPPER( CHR( key ) )
IF values = "*" && allow any key choice if values = "*"
bad_choice = (key = 0)
ELSE
bad_choice = .NOT.(choice $ values)
ENDIF
*
** check for a help request if in Clipper
IF clipper
IF LASTKEY() = 28 && F1 key for help
DO help WITH PROCNAME(), PROCLINE(), "CHOICE"
ENDIF
ENDIF
ENDDO
ENDDO
*
* Time out after seconds, use to turn off screen etc.
dl_j = dl_j+1
IF dl_j = 180
RETURN
ENDIF
ENDDO
RETURN
* EOP T_GetKey *******************************************************