home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / disk_20.zip / DB3-GKEY.ZIP / TIMEPROC.PRG < prev   
Text File  |  1986-05-20  |  3KB  |  93 lines
  1. **    Last revision: May 20, 1986 at 10:23
  2.  
  3. ** by: H.M. Van Tassell
  4.  
  5. *
  6. * NOTE: if not using dBASEIII Plus, pls remove the && comments
  7. *
  8.       
  9. PROCEDURE T_GetKey
  10. *
  11. * Called with a list of acceptable choices in values
  12. * If values = "*" then ANY key press will be accepted
  13. * Returns the acceptable character in choice
  14. * prints time while waiting for the right key press
  15. *
  16. PARAMETER choice,values
  17. PRIVATE bad_choice, key, t_row, t_col, dl_row, dl_col, dl_i, dl_j, do_colon
  18. *
  19.      t_row = trow    && row/colm to print time 
  20.      t_col = tcol    && could be passed as parameters
  21.      bad_choice = .T.
  22.      dl_row = ROW()  && row/colm to print ?
  23.      dl_col = COL()  && subtract 1 if calling pgm printed a ?
  24.      dl_j = 0
  25. *
  26. DO WHILE bad_choice
  27. **   @ dl_row,dl_col SAY "?"   && print a ? at present colm position  
  28.    CALL CursOff   && not needed if calling pgm controls cursor
  29.    SET COLOR TO &RevVideo          
  30.    DO CASE
  31.     CASE (VAL(TIME())<10)
  32.        @ t_row,t_col+1 SAY " " + SUBSTR(TIME(),2,4) + " am "
  33.       CASE (VAL(TIME())<12)
  34.        @ t_row,t_col SAY " " + SUBSTR(TIME(),1,5) + " am "
  35.     CASE (VAL(TIME())=12)
  36.        @ t_row,t_col SAY " " + SUBSTR(TIME(),1,5) + " pm "
  37.     OTHERWISE
  38.        dl_i=2
  39.        IF (VAL(TIME())<20)
  40.           dl_i=1
  41.        ENDIF
  42.        @ t_row,t_col+2-dl_i SAY " " + STR(VAL(TIME())-12, dl_i) +;
  43.           SUBSTR(TIME(),3,3) + " pm "
  44.   ENDCASE      
  45.    @ dl_row,dl_col SAY ""     
  46.    CALL CursOn   && not needed if calling pgm controls cursor
  47.    SET COLOR TO &StdVideo
  48.    *
  49.    * Wait for a keypress or the time to change.
  50.    do_colon = .T.
  51.    dl_tm = SUBSTR(TIME(),4,2)
  52.    DO WHILE dl_tm = SUBSTR(TIME(),4,2) .AND. bad_choice
  53.       CALL CursOff
  54.       SET COLOR TO &RevVideo          
  55.       IF do_colon
  56.         @ t_row,t_col+3 SAY ":"
  57.         do_colon = .F.
  58.       ELSE
  59.         @ t_row,t_col+3 SAY " "
  60.         do_colon = .T.
  61.       ENDIF
  62.       @ dl_row,dl_col SAY ""     
  63.       CALL CursOn
  64.       SET COLOR TO &StdVideo
  65.       dl_ts = SUBSTR(TIME(),7,2)
  66.       DO WHILE dl_ts = SUBSTR(TIME(),7,2) .AND. bad_choice
  67.         key = INKEY()
  68.         choice = UPPER( CHR( key ) )
  69.         IF values = "*"   && allow any key choice if values = "*"
  70.           bad_choice = (key = 0)
  71.         ELSE
  72.           bad_choice = .NOT.(choice $ values)
  73.         ENDIF
  74.         *
  75.         ** check for a help request if  in Clipper
  76.         IF clipper                    
  77.           IF LASTKEY() = 28  && F1 key for help
  78.             DO help WITH PROCNAME(), PROCLINE(), "CHOICE"
  79.           ENDIF
  80.         ENDIF
  81.       ENDDO
  82.    ENDDO
  83.    *
  84.    * Time out after <n> seconds, use to turn off screen etc.
  85.    dl_j = dl_j+1
  86.    IF dl_j = 180
  87.       RETURN
  88.    ENDIF
  89. ENDDO
  90. RETURN
  91. * EOP T_GetKey *******************************************************
  92.  
  93.