home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / SAMPLE.LIF / DATE.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  3.2 KB  |  147 lines
  1. /***
  2. *
  3. *     Date.prg
  4. *
  5. *     Sample user-defined functions for manipulating dates
  6. *     Copyright, Nantucket Corporation, 1990
  7. *
  8. *      NOTE: compile with /n/w/a/m
  9. */
  10.  
  11.  
  12. #include "Set.ch"
  13.  
  14.  
  15.  
  16. /***
  17. *  Mdy( <dDate> ) --> cDate
  18. *  Convert a date to a string in the format month dd, yyyy.
  19. *
  20. */
  21. FUNCTION Mdy( dDate )
  22.    LOCAL cYear
  23.    //
  24.    // Handle SET CENTURY
  25.    IF SUBSTR(SET(_SET_DATEFORMAT), -4) = "YYYY"
  26.       cYear := STR(YEAR(dDate))
  27.    ELSE
  28.       cYear := " " + SUBSTR(STR(YEAR(dDate)), 4, 2)
  29.    ENDIF
  30.    //
  31.    RETURN CMONTH(dDate) + " " + LTRIM(STR(DAY(dDate))) + "," + cYear
  32.  
  33.  
  34.  
  35. /***
  36. *  Dmy( <dDate> ) --> cDate
  37. *  Convert a date to string formatted as dd month yyyy.
  38. *
  39. */
  40. FUNCTION Dmy( dDate )
  41.    LOCAL cYear
  42.    //
  43.    // Handle SET CENTURY
  44.    IF SUBSTR(SET(_SET_DATEFORMAT), -4) = "YYYY"
  45.       cYear := STR(YEAR(dDate))
  46.    ELSE
  47.       cYear := " " + SUBSTR(STR(YEAR(dDate)), 4, 2)
  48.    ENDIF
  49.    //
  50.    RETURN LTRIM(STR(DAY(dDate))) + " " + CMONTH(dDate) + cYear
  51.  
  52.  
  53.  
  54. /***
  55. *  DateAsAge( <dDate> ) --> nAge
  56. *  Convert a date of birth to an age in years.
  57. *
  58. */
  59. FUNCTION DateAsAge( dDate ) 
  60.    LOCAL nAge := 0
  61.    //
  62.    IF YEAR(DATE()) > YEAR(dDate)
  63.       nAge := YEAR(DATE()) - YEAR(dDate)
  64.       IF MONTH(DATE()) < MONTH(dDate) .OR.;
  65.          ( MONTH(DATE()) = MONTH(dDate) .AND. DAY(DATE()) < DAY(dDate) )
  66.          
  67.          --nAge
  68.  
  69.       ENDIF
  70.    ENDIF
  71.    //
  72.    RETURN nAge
  73.  
  74.  
  75.  
  76. /***
  77. *  AddMonth( <dDate>, <nMonths> ) --> dNewDate
  78. *  Calculate a new date by adding a number of months to a given
  79. *  date.
  80. *
  81. */
  82. FUNCTION AddMonth( dDate, nMonths)
  83.    LOCAL nMonth, nDay, nYear, nLimit, nMonthAdd, nYearAdd
  84.    
  85.    // Break date up into its numeric components
  86.    nMonth := MONTH( dDate )
  87.    nDay   := DAY( dDate )
  88.    nYear  := YEAR( dDate )
  89.  
  90.    // nLimit determines the minimum number of months that will push the
  91.    // date into the next year.  If the number of months added to the date
  92.    // exceeds this limit, the year must be advanced by one
  93.    nLimit := 12 - nMonth + 1
  94.  
  95.    // Compute number of years to add
  96.    nYearAdd := INT( nMonths / 12 )
  97.    IF nMonths >= nLimit
  98.       nYearAdd++
  99.    ENDIF
  100.    nYear += nYearAdd
  101.  
  102.    // Compute number of months to add and normalize month
  103.    nMonthAdd := nMonths % 12 
  104.    nMonth := (nMonth + nMonthAdd) % 12
  105.  
  106.    // Convert numeric portions to new date
  107.    dNew := CTOD(STR(nMonth, 2) + "/" + STR(nDay, 2) + "/" + STR(nYear, 4))
  108.  
  109.    RETURN (dNew)
  110.  
  111.  
  112. /***
  113. *  DateAsArray( dDate ) --> aDate
  114. *  Convert a date to an array of year, month, and day
  115. *
  116. */
  117. FUNCTION DateAsArray( dDate )
  118.    LOCAL aDate := {}
  119.    IF VALTYPE( dDate ) != "D"
  120.       // CAUTION: Argument error
  121.       RETURN 
  122.    ELSE
  123.       aDate := { YEAR( dDate ), MONTH( dDate ), DAY( dDate ) }
  124.    ENDIF
  125.  
  126.    RETURN aDate
  127.  
  128.  
  129. /***
  130. *  ArrayAsDate( aDate ) --> dDate
  131. *  Convert an array of year, month, and day to a date value
  132. *
  133. */
  134. FUNCTION ArrayAsDate( aDate )
  135.    RETURN CTOD(STR(aDate[2], 2) + "/" + STR(aDate[3], 2) + "/" + STR(aDate[1], 4))
  136.  
  137.  
  138. /***
  139. *  DateIsLeap( <dDate> ) --> lLeap
  140. *  Determine if the year of a supplied date is a leap year
  141. *
  142. */
  143. FUNCTION DateIsleap( dDate )
  144.    LOCAL nYear := YEAR(dDate)
  145.    RETURN ((nYear % 4) == 0) .AND. ;
  146.           (((nYear % 100) != 0) .OR. ((nYear % 400) == 0))
  147.