home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol10n19.zip / FPDATE.ZIP / FPDATE.PRG
Text File  |  1991-06-24  |  3KB  |  92 lines
  1. ********************************************************************
  2. *  Incrementing and Decrementing Dates, FoxPro version
  3. ********************************************************************
  4. SET ECHO OFF
  5. SET TALK OFF
  6. SET STATUS OFF
  7. CLEAR
  8. y = SCOLS()
  9. pc = "PC Magazine "
  10. pcmag = REPLICATE(pc, CEILING(y/LEN(pc)))
  11. i = 0
  12. x = SROWS()
  13. DO WHILE i < x
  14.    @ i, 0 SAY pcmag
  15.    i = i + 1
  16. ENDDO
  17.  
  18. DEFINE WINDOW test FROM 2,5 TO 13,64 TITLE "Employees"
  19. ACTIVATE WINDOW test
  20. msdate = {}
  21. mlast = PADR("American",43)
  22. mfirst = PADR("Joe",43)
  23. mtitle = PADR("Software Engineer",43)
  24. DO WHILE .T.
  25.    @ 1,2 SAY "Last name:"
  26.    @ 2,1 SAY "First name:"
  27.    @ 4,1 SAY "Start date:"
  28.    @ 6,6 SAY "Title:"
  29.    @ 1,13 GET mlast MESSAGE WinMsg("Enter last name")
  30.    @ 2,13 GET mfirst
  31.    @ 4,13 GET msdate WHEN dstart() ;
  32.          VALID !EMPTY(msdate) .AND. dstop() ;
  33.          MESSAGE WinMsg("Press + to increment, - to decrement")
  34.    @ 6,13 GET mtitle MESSAGE WinMsg("Enter title")
  35.    READ
  36.    IF READKEY()==268 .OR. READKEY()==12
  37.      EXIT
  38.    ENDIF
  39. ENDDO
  40.  
  41. RELEASE WINDOW test
  42. RETURN
  43.  
  44. ***********************************************************************
  45. * FUNCTION dstart
  46. * Turn on special handling of the plus and minus keys
  47. ***********************************************************************
  48. FUNCTION dstart
  49. ON KEY LABEL + DO dmove
  50. ON KEY LABEL - DO dmove
  51. RETURN .T.
  52.  
  53. ***********************************************************************
  54. * FUNCTION dstop
  55. * Turn off special handling of the plus and minus keys
  56. ***********************************************************************
  57. FUNCTION dstop
  58. ON KEY LABEL +
  59. ON KEY LABEL -
  60. RETURN .T.
  61.  
  62. ***********************************************************************
  63. * PROCEDURE dmove
  64. * Increment or decrement the passed variable if it is of date type
  65. * If it's an empty date, set it to todays date
  66. ***********************************************************************
  67. PROCEDURE dmove
  68. PRIVATE dv
  69. dv = VARREAD()              && Get the variable
  70. IF TYPE(dv) == "D"          && If it is of date type
  71.   IF EMPTY(&dv)
  72.     &dv = DATE()
  73.   ELSE
  74.     IF CHR(LASTKEY()) == '+'
  75.        &dv = &dv + 1        && Increment it
  76.     ELSE
  77.        &dv = &dv - 1        && Decrement it
  78.     ENDIF
  79.   ENDIF
  80. ENDIF
  81. RETURN
  82.  
  83. *******************************************************************
  84. * FUNCTION WinMsg
  85. * Display a centered message on the last line of the active
  86. * window.  For use with the MESSAGE option on @...GET.
  87. *******************************************************************
  88. FUNCTION WinMsg
  89. PARAMETER TEXT
  90. @ WROWS()-1, 0 SAY PADC(TEXT,WCOLS())
  91. RETURN ""
  92.