home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol10n19.zip / DATEPL.PRG < prev    next >
Text File  |  1991-10-15  |  3KB  |  101 lines
  1. ********************************************************************
  2. * DATEPL.PRG
  3. * Incrementing and Decrementing Dates, Clipper 5.01 version
  4. ********************************************************************
  5. #include "inkey.ch"
  6. #define K_PLUS  43                        && Plus key
  7. #define K_MINUS 45                        && Minus key
  8. SET ECHO OFF
  9. SET TALK OFF
  10. SET STATUS OFF
  11. SET SCOREBOARD OFF
  12. CLEAR
  13. SETBLINK(.F.)
  14. oldcolor = SETCOLOR("B/W")
  15. y = MAXCOL()
  16. pc = "PC Magazine "
  17. i = LEN(pc)
  18. pcmag = REPLICATE(pc, IIF(y % i > 0, 1+(y/i), y/i))
  19. i = 0
  20. x = MAXROW()
  21. DO WHILE i < x
  22.    @ i, 0 SAY pcmag
  23.    i = i + 1
  24. ENDDO
  25. oldcolor = SETCOLOR("W+/B")
  26. @ 2,3 CLEAR TO 12,64
  27. @ 2,3 TO 12,64
  28. @ 2,30 say "Employees"
  29.  
  30. mdate = CTOD("  /  /  ")
  31. mlast = PADR("American",43)
  32. mfirst = PADR("Joe",43)
  33. mtitle = PADR("Software Engineer",43)
  34.  
  35. DO WHILE .T.
  36.    @ 4,  7 SAY "Last name: "
  37.    @ 4, 18 GET mlast WHEN WinMsg(11,6,58,"Enter last name")
  38.    @ 5,  6 SAY "First name: "
  39.    @ 5, 18 GET mfirst WHEN WinMsg(11,6,58,"Enter first name")
  40.    @ 7,  6 SAY "Start date: "
  41.    @ 7, 18 GET mdate COLOR "N/W,N/BG" ;
  42.      WHEN dstart() .AND. WinMsg(11,6,58,"Press + to increment, - to
  43. decrement") ;
  44.      VALID !EMPTY(mdate) .AND. dstop()
  45.    @ 9,11 SAY "Title: "
  46.    @ 9,18 GET mtitle WHEN WinMsg(11,6,58,"Enter title")
  47.    READ
  48.    IF READKEY()==268 .OR. READKEY()==12    && Escape key pressed?
  49.      EXIT
  50.    ENDIF
  51. ENDDO
  52. SETCOLOR(oldcolor)
  53. RETURN
  54.  
  55. ***********************************************************************
  56. * FUNCTION dstart
  57. * Turn on special handling of the Plus and Minus keys
  58. ***********************************************************************
  59. FUNCTION dstart
  60. SET KEY K_PLUS  TO dmove          && Assign procedure to plus key
  61. SET KEY K_MINUS TO dmove          && Assign procedure to minus key
  62. RETURN .T.
  63.  
  64. ***********************************************************************
  65. * FUNCTION dstop
  66. * Turn off special handling of the Plus and Minus keys
  67. ***********************************************************************
  68. FUNCTION dstop
  69. SET KEY K_PLUS  TO                && Change plus key back to normal
  70. SET KEY K_MINUS TO                && Change minus key back to normal
  71. RETURN .T.
  72.  
  73. *******************************************************************
  74. * PROCEDURE dmove
  75. * Increment or decrement the passed variable if it is of date type
  76. * If it's an empty date, set it to today's date
  77. *******************************************************************
  78. PROCEDURE dmove
  79. PARAMETER cProc, nLine, cVar
  80. IF TYPE(cVar) == "D"              && If it is a date field
  81.   IF EMPTY(&cVar)                 && If it is empty
  82.     &cVar = DATE()                && Set to today's date
  83.   ELSE                            && Otherwise
  84.     IF LASTKEY() == K_PLUS        && If the plus key was hit
  85.       &cVar = &cVar + 1           && Increment the date field
  86.     ELSE                          && Else
  87.       &cVar = &cVar - 1           && Decrement the date field
  88.     ENDIF
  89.   ENDIF
  90. ENDIF
  91. RETURN
  92.  
  93. *******************************************************************
  94. * FUNCTION WinMsg
  95. * Display a centered message.
  96. *******************************************************************
  97. FUNCTION WinMsg
  98. PARAMETER nRow, nCol, nWidth, cText
  99. @ nRow, nCol SAY PADC(cText, nWidth)
  100. RETURN .T.
  101.