home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / nan_news / vol2 / no2 / months.prg < prev    next >
Text File  |  1987-12-08  |  3KB  |  112 lines
  1. *        
  2. *****
  3. *  Program..: MONTHS.PRG
  4. *  Author...: Steve Hillbourne.
  5. *  Date.....: 08-19-87
  6. *  Notes....:
  7. *  Syntax...: TRANMNTH(<expD>,<expN>).
  8. *             This program illustrates a user defined function 
  9. *             which allows for addition and subtraction of months
  10. *             from a date.
  11. *
  12. *             The function requires two parameters:
  13. *                  1) a date variable to be manipulated
  14. *                  2) a numeric variable representing the number 
  15. *                     of months to be added or subtracted
  16. *
  17. *             Enter a negative number in order to subtract. 
  18. *
  19. *             Works with both SET CENTURY ON and OFF.
  20. *
  21. *  CAUTION:
  22. *  TRANMNTH() will round down to the last day of the current month.
  23. *  Example:
  24. *       If one month is added to 03/31/86 the result
  25. *       is 04/30/86.
  26. *       But subtracting one from 04/30/86 results
  27. *       in 03/30/86.
  28. *
  29. *  Concerning leap years:
  30. *       If 12 months is added to or subtracted from FEB 29 of a
  31. *       leap year the results will be FEB 28 of the resulting
  32. *       year.  If the year is the turn of the century
  33. *       (e.g. 1600,1800), and is divisible by 400, then THAT
  34. *       year is a LEAP year.  Otherwise, it is not.
  35. *        
  36. *    
  37. *    
  38.  
  39. CLEAR
  40. * The date variable passed to the functions.
  41. date = CTOD(SPACE(8))
  42. * The number of months to be subtracted or added.
  43. num = 000
  44. ch = 'Y'
  45. DO WHILE ch = 'Y'
  46.    CLEAR
  47.    @ 5,15 SAY  'ENTER A DATE:      ' GET date  
  48.    @ 6, 15 SAY 'NUMBER OF MONTHS : ' GET num
  49.    READ
  50.    results = TRANMNTH(date,num)
  51.    @ 8, 15 SAY 'TRANMNTH(): ' +DTOC(results)
  52.    @ 10 , 15 SAY 'TEST ANOTHER ? ' GET ch PICTURE '!'
  53.    READ
  54. ENDDO
  55. RETURN
  56.  
  57. *******************************************************************
  58. * This is the function.                                           *
  59. * Copy this to your source code.                                  *
  60. *******************************************************************
  61. FUNCTION TRANMNTH
  62. PARAMETERS olddate, month_num  
  63. iscent = .F.
  64. centoff = .F.
  65. IF LEN(DTOC(olddate)) = 8 
  66.   centoff = .T.
  67. ENDIF
  68. SET CENTURY ON
  69. month = VAL(SUBSTR(DTOC(olddate),1,2))
  70. day = VAL(SUBSTR(DTOC(olddate),4,2))
  71. year = VAL(SUBSTR(DTOC(olddate),7))
  72. month = month + (month_num % 12)
  73. year =  year + INT(month_num / 12)
  74. IF month <= 0
  75.    month = month + 12
  76.    year = year - 1
  77. ENDIF
  78. IF month > 12
  79.   month = month - 12
  80.   year = year + 1
  81. ENDIF
  82. IF day = 31 .AND. (month=04 .or. month=06 .or. month=09 .or. month=11)
  83.   day = 30
  84. ENDIF
  85. IF month = 02 .AND. day > 28 .AND. year % 100 = 0 
  86.   iscent = .T.
  87.   IF year % 400 = 0
  88.     day = 29
  89.   ELSE
  90.     day = 28
  91.   ENDIF
  92. ENDIF
  93. IF month = 02 .AND. day > 28  .AND. !(iscent)
  94.   IF year % 4 = 0
  95.     day = 29
  96.   ELSE
  97.     day = 28
  98.   ENDIF
  99. ENDIF
  100. month =  STR(month,2,0)
  101. day = STR(day,2,0)
  102. year = LTRIM(STR(year))  
  103. newdate = CTOD(month+'/'+day + '/'+year)
  104. IF centoff
  105.   SET CENTURY OFF
  106. ENDIF
  107. RETURN (newdate)
  108.  
  109. ****************************************************************
  110. * end of function                                              *
  111. ****************************************************************    
  112.