Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Difference between two dates as text... 3

Status
Not open for further replies.

GriffMG

Programmer
Mar 4, 2002
6,309
FR
A customer wants to have a countdown on his reports to a series of target dates - 2 years, 3 months, 5 days to whatever.

Sounds simple enough doesn't it?

The snag is, there are only two date based units that are actually fixed, days and weeks. Months and years are of variable length.

** edit ** To be fair, years are both fixed and variable - always twelve months, not always 365 days

So below is the code I'm using - anyone got something better to add?

Code:
FUNCTION DATEDIFFASWORDS
	LPARAMETERS m.DATE1,m.DATE2
	LOCAL m.YEARS,m.MONTHS,m.WEEKS,m.DAYS,m.TEMP,m.STRING
	m.YEARS = 0
	m.MONTHS = 0
	m.WEEKS =0
	m.DAYS = 0
	** swap dates if needs be m.date2 should be the greater
	IF m.DATE1 > m.DATE2
		m.TEMP = m.DATE1
		m.DATE1 = m.DATE2
		m.DATE2 = m.TEMP
	ENDIF
	** Determine No. Months beteen dates

	m.MONTHS = 0
	IF GOMONTH(m.DATE1, 1) <= m.DATE2
		**m.MONTHS = (YEAR(m.DATE2)*12+MONTH(m.DATE2))-(YEAR(m.DATE1)*12+MONTH(m.DATE1))
                ** Edit line changed after posting 
		m.MONTHS = (YEAR(m.DATE2+1)*12+MONTH(m.DATE2+1))-(YEAR(m.DATE1)*12+MONTH(m.DATE1))-1
	ENDIF
        ** advance earlier date on by that many months
	m.DATE1 = GOMONTH(m.DATE1,m.MONTHS)
	** determine the number of days left 
	m.DAYS = m.DATE2-m.DATE1
	** turn that into whole weeks
	m.WEEKS = INT(m.DAYS/7)
	** determine the number of days left if you take away that many weeks
	m.DAYS = m.DAYS - (m.WEEKS * 7)
	** use the months to calculate the number of whole years
	m.YEARS = INT(m.MONTHS/12)
	m.MONTHS = m.MONTHS - (m.YEARS * 12)
	** assemble your answer in words.
	m.STRING = ""
	IF m.YEARS > 0
		m.STRING = ALLTRIM(STR(m.YEARS)+ " Year"+IIF(m.YEARS>1,"s",""))
	ENDIF
	IF m.MONTHS > 0
		m.STRING = ALLTRIM( m.STRING +" "+ALLTRIM(STR(m.MONTHS))+" Month"+IIF(m.MONTHS>1,"s",""))
	ENDIF
	IF m.WEEKS > 0
		m.STRING = ALLTRIM( m.STRING +" "+ALLTRIM(STR(m.WEEKS))+" Week"+IIF(m.WEEKS>1,"s",""))
	ENDIF
	IF m.DAYS > 0
		m.STRING = ALLTRIM( m.STRING +" "+ALLTRIM(STR(m.DAYS))+" Day"+IIF(m.DAYS>1,"s",""))
	ENDIF

	RETURN(m.STRING)

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

There is no place like G28 X0 Y0 Z0
 
Thanks for that, Griff

Had a look at your post about the difference between two dates.

It works most of the time. I may have transcribed the code incorrectly, but when I tried the difference between 31-Jan-2022 and 30-Mar-2022, it came out as “2 months”. But there again, I am not sure how many months and days it should be!

On a completely different matter, I see that when I define a function I have usually shown the parameters in brackets , so :

Code:
FUNCTION DATEDIFFASWORDS (vDate1, vDate2)

Am I guilty of using outdated technology? Happy for guidance.

Andrew
 
No that is a good way to define a function, it is very clear and using the MyFunction(vDate AS Date) approach can implement strong typing.

Re the error, I think I have this line wrong

Code:
m.MONTHS = (YEAR(m.DATE2)*12+MONTH(m.DATE2))-(YEAR(m.DATE1)*12+MONTH(m.DATE1))

I had been using a do while loop

Code:
DO WHILE GOMONTH(m.DATE1, m.MONTHS+1) <= m.DATE2
	m.MONTHS = m.MONTHS + 1
ENDDO

But that could be lengthy for very large differences... not everyone likes loops B-)


Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

There is no place like G28 X0 Y0 Z0
 
Thank you Tamar

I think perhaps the calculated line (as opposed to the do while variant) should read like this:

Code:
m.MONTHS = ((YEAR(m.DATE2+1)*12)+MONTH(m.DATE2+1))-((YEAR(m.DATE1)*12)+MONTH(m.DATE1))-1



Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

There is no place like G28 X0 Y0 Z0
 
Hi Griff,

You may want have a look at the code snippet below

Code:
*!*	FUNCTION DATEDIFFASWORDS

*!*	Assumptions: this functions assumes that a year has 365.25 days 
*!*	(between 2001 and 2099 - see leap year on Wikipedia) and hence a month 30.4375 days

LPARAMETERS ldDATE1, ldDATE2

LOCAL liYEARS, liMONTHS, liDAYS, liWEEKS, lcSTRING
	
	liYEARS = 0
	liMONTHS = 0
	liWEEKS = 0
	liDAYS = 0

IF ldDATE2 > ldDATE1
	liYears = INT((ldDate2 - ldDate1) / 365.25)
	liMonths = INT((ldDate2 - ldDate1 - (liYears * 365.25)) / 30.4375)
	liWeeks = INT((ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375)) / 7)
	liDays = INT(ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375) - (liWeeks * 7))

ELSE 
	=MESSAGEBOX("Please check order of parameters", 48, "Difference in Y/M/W/D between dates")

ENDIF
	
	lcSTRING = ""
	
IF liYEARS > 0
	lcSTRING = ALLTRIM(STR(liYEARS)+ " Year" + IIF(liYEARS > 1,"s",""))
ENDIF
	
IF liMONTHS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liMONTHS))+" Month" + IIF(liMONTHS > 1,"s",""))
ENDIF

IF liWEEKS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liWEEKS))+" Week" + IIF(liWEEKS > 1,"s",""))
ENDIF

IF liDAYS != 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liDAYS))+" Day" + IIF(liDAYS>1,"s",""))
ENDIF

RETURN(lcSTRING)

hth

MarK
 
Thank you Mark

Would that be more of an approximation - using 365.25 approach?

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

There is no place like G28 X0 Y0 Z0
 
Hi Griff,

You're right but please check the level of accuracy between your function (DateDiffInWords) and mine (DateDiffAsWords).

Code:
CLOSE ALL
CLEAR ALL

LOCAL ldDate as Date, lnI as Integer


ldDate = {^2022-01-01}

CREATE CURSOR csrDateDifference (dSTDate D, dEDate D, cDDAsWord C(50),cDDInWords c(50))

FOR i = 1 TO 60
	lnI = INT(1461 * RAND(i))
	
	INSERT INTO csrDateDifference VALUES (ldDate, ldDate + lnI, DateDiffAsWords(ldDate, ldDate + lnI), DateDiffInWords(ldDate, ldDate + lni))
ENDFOR 

BROWSE 

CLOSE ALL
CLEAR ALL 
RETURN 

**********
FUNCTION DateDiffInWords()

LPARAMETERS ldDATE1, ldDATE2

LOCAL liYEARS, liMONTHS, liDAYS, liWEEKS, lcSTRING
	
	liYEARS = 0
	liMONTHS = 0
	liWEEKS = 0
	liDAYS = 0

	IF GOMONTH(ldDATE1, 1) <= ldDATE2
		liMONTHS = (YEAR(ldDATE2 + 1) * 12 + MONTH(ldDATE2 + 1)) - (YEAR(ldDATE1) * 12 + MONTH(ldDATE1)) - 1
	ENDIF
	
	** advance earlier date on by that many months
	ldDATE1 = GOMONTH(ldDATE1, liMONTHS)
	
	** determine the number of days left 
	liDAYS = ldDATE2 - ldDATE1
	
	** turn that into whole weeks
	liWEEKS = INT(liDAYS/7)
	
	** determine the number of days left if you take away that many weeks
	liDAYS = liDAYS - (liWEEKS * 7)
	
	** use the months to calculate the number of whole years
	liYEARS = INT(liMONTHS / 12)
	liMONTHS = liMONTHS - (liYEARS * 12)

	lcSTRING = ""
	
IF liYEARS > 0
	lcSTRING = ALLTRIM(STR(liYEARS)+ " Year" + IIF(liYEARS > 1,"s",""))
ENDIF
	
IF liMONTHS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liMONTHS))+" Month" + IIF(liMONTHS > 1,"s",""))
ENDIF

IF liWEEKS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liWEEKS))+" Week" + IIF(liWEEKS > 1,"s",""))
ENDIF

IF liDAYS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liDAYS))+" Day" + IIF(liDAYS>1,"s",""))
ENDIF

RETURN(lcSTRING) 

*********

FUNCTION DATEDIFFASWORDS

*!*	Assumptions: this functions assumes that a year has 365.25 days 
*!*	(between 2001 and 2099 - see leap year on Wikipedia) and hence a month 30.4375 days

LPARAMETERS ldDATE1, ldDATE2

LOCAL liYEARS, liMONTHS, liDAYS, liWEEKS, lcSTRING
	
	liYEARS = 0
	liMONTHS = 0
	liWEEKS = 0
	liDAYS = 0

IF ldDATE2 > ldDATE1
	liYears = INT((ldDate2 - ldDate1) / 365.25)
	liMonths = INT((ldDate2 - ldDate1 - (liYears * 365.25)) / 30.4375)
	liWeeks = INT((ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375)) / 7)
	liDays = INT(ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375) - (liWeeks * 7))
	

ELSE 
	=MESSAGEBOX("Please check order of parameters", 48, "Difference in Y/M/W/D between dates")

ENDIF
	
	lcSTRING = ""
	
IF liYEARS > 0
	lcSTRING = ALLTRIM(STR(liYEARS)+ " Year" + IIF(liYEARS > 1,"s",""))
ENDIF
	
IF liMONTHS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liMONTHS))+" Month" + IIF(liMONTHS > 1,"s",""))
ENDIF

IF liWEEKS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liWEEKS))+" Week" + IIF(liWEEKS > 1,"s",""))
ENDIF

IF liDAYS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liDAYS))+" Day" + IIF(liDAYS>1,"s",""))
ENDIF

RETURN(lcSTRING)

hth

MarK
 
That's interesting, the two functions certainly don't match ALL the time.

This is where the interpretation of the requirement is key - for example, back in 1961 was I one month old
on 23/08/1961 or 4 weeks and 3 days? They are both right, in fact the days before the turn of the month
the functions match.

I'm giving you a star for that.

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

There is no place like G28 X0 Y0 Z0
 
Hi Griff,

Thank you for the star

After tweaking the code of the function a little bit I was able to raise its level of accuracy to +- 1 day. It is not yet perfect - but I'm getting to it.

Code:
[indent]
liYears = INT((1 + ldDate2 - ldDate1) / 365.25)
liMonths = INT((1 + ldDate2 - ldDate1 - CEILING(liYears * 365.25)) / 30.4375)
liWeeks = INT((1 + ldDate2 - ldDate1 - CEILING(liYears * 365.25) - CEILING(liMonths * 30.4375)) / 7)
liDays = INT(1 + ldDate2 - ldDate1 - CEILING(liYears * 365.25) - CEILING(liMonths * 30.4375) - (liWeeks * 7))
[/indent]

hth

MarK
 
Hi Griff

Final version. It's not yet perfect, but it's fine for everyday use.

Code:
CLOSE ALL
CLEAR ALL

LOCAL ldDate as Date, lnI as Integer

ldDate = {^2000-01-01}

CREATE CURSOR csrDateDifference (dSTDate D, dEDate D, nDays I, cMDDAsWords C(50),cGDDAsWords c(50))

FOR i = 1 TO 60
*!*		lnI = INT(3650 * RAND(i))
	lnI = 5 * i
	
	INSERT INTO csrDateDifference VALUES (ldDate, ldDate + lnI, lnI, MKDateDiffAsWords(ldDate, ldDate + lnI), GRDateDiffAsWords(ldDate, ldDate + lni))
ENDFOR 

BROWSE 

CLOSE ALL
CLEAR ALL 
RETURN 

**********
FUNCTION GRDateDiffAsWords()

*!*	written by Griff

LPARAMETERS ldDATE1, ldDATE2

LOCAL liYEARS, liMONTHS, liDAYS, liWEEKS, lcSTRING
	
	liYEARS = 0
	liMONTHS = 0
	liWEEKS = 0
	liDAYS = 0

	IF GOMONTH(ldDATE1, 1) <= ldDATE2
		liMONTHS = (YEAR(ldDATE2 + 1) * 12 + MONTH(ldDATE2 + 1)) - (YEAR(ldDATE1) * 12 + MONTH(ldDATE1)) - 1
	ENDIF
	
	** advance earlier date on by that many months
	ldDATE1 = GOMONTH(ldDATE1, liMONTHS)
	
	** determine the number of days left 
	liDAYS = ldDATE2 - ldDATE1
	
	** turn that into whole weeks
	liWEEKS = INT(liDAYS/7)
	
	** determine the number of days left if you take away that many weeks
	liDAYS = liDAYS - (liWEEKS * 7)
	
	** use the months to calculate the number of whole years
	liYEARS = INT(liMONTHS / 12)
	liMONTHS = liMONTHS - (liYEARS * 12)

	lcSTRING = ""
	
IF liYEARS > 0
	lcSTRING = ALLTRIM(STR(liYEARS)+ " Year" + IIF(liYEARS > 1,"s",""))
ENDIF
	
IF liMONTHS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liMONTHS))+" Month" + IIF(liMONTHS > 1,"s",""))
ENDIF

IF liWEEKS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liWEEKS))+" Week" + IIF(liWEEKS > 1,"s",""))
ENDIF

IF liDAYS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liDAYS))+" Day" + IIF(liDAYS>1,"s",""))
ENDIF

RETURN(lcSTRING) 

*********

FUNCTION MKDATEDIFFASWORDS()

*!*	Assumptions: this functions assumes that a year has 365.25 days 
*!*	(between 2001 and 2099 - see leap year on Wikipedia) and hence a month 30.4375 days
*!*	written by marK

LPARAMETERS ldDATE1, ldDATE2

LOCAL liYEARS, liMONTHS, liDAYS, liWEEKS, liCheckDays, lcSTRING
	
	liYEARS = 0
	liMONTHS = 0
	liWEEKS = 0
	liDAYS = 0

IF ldDATE2 > ldDATE1
	liYears = INT((ldDate2 - ldDate1) / 365.25)
	liMonths = INT((ldDate2 - ldDate1 - (liYears * 365.25)) / 30.4375)
	liWeeks = INT((ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375)) / 7)
	liDays = INT(ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375) - (liWeeks * 7))

	liCheckDays = liDays + INT(liYears * 365.25) + INT(liMonths * 30.4375) + (liWeeks * 7)
	
	IF liCheckDays != ldDate2 - ldDate1

		liDays = liDays + ldDate2 - ldDate1 - liCheckDays

		IF liDays >= 7
			liDays = liDays - 7
			liWeeks = liWeeks + 1

		ENDIF 
	ENDIF  

ELSE 
	=MESSAGEBOX("Please check order of parameters", 48, "Difference in Y/M/W/D between dates")

ENDIF
	
	lcSTRING = ""
	
IF liYEARS > 0
	lcSTRING = ALLTRIM(STR(liYEARS)+ " Year" + IIF(liYEARS > 1,"s",""))
ENDIF
	
IF liMONTHS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liMONTHS))+" Month" + IIF(liMONTHS > 1,"s",""))
ENDIF

IF liWEEKS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liWEEKS))+" Week" + IIF(liWEEKS > 1,"s",""))
ENDIF

IF liDAYS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liDAYS))+" Day" + IIF(liDAYS>1,"s",""))
ENDIF

RETURN(lcSTRING)

Enjoy

MarK
 
I was interested to follow this discussion. The main issue seems to be in calculating the number of odd days once you have calculated the number of months. I believe that you (Mark) have striven for consistency in the length of periods, so that when you say a period is e.g. two years three months and 12 days, it will be the same total number of days whenever it starts.

I chose to work out the odd days as :

If the ‘day’ in date2 is greater than or equal to the ‘day’ in date1, it is the difference between these two values

If the ‘day’ in date2 is less than the ‘day’ in date1, it is the number of days remaining in the month at the start of the period added to the ‘day’ field from date2.

This means that my ‘two years three months and 12 days’ will be a slightly varying number of days, depending on the start date.
Code:
FUNCTION DateDiffAsWords(vDate1, vDate2)
LOCAL lFirst, lLast, lDay1, lDay2, lMonth1, lMonth2, lYear1, lYear2, lFirstNext
LOCAL lYears, lMonths, lWeeks, lDays, lAnswer
   *  Put the dates in order
   IF vDate1 < vDate2
      lFirst = vDate1
      lLast = vDate2
     ELSE
      lFirst = vDate2
      lLast = vDate1
      ENDIF
   
   lDay1 = DAY(lFirst)
   lMonth1 = MONTH(lFirst)
   lYear1 = YEAR(lFirst)
   lDay2 = DAY(lLast)
   lMonth2 = MONTH(lLast)
   lYear2 = YEAR(lLast)
   
   *  The 'Days' difference is the trickier one.  If lDay1 > lDay2, we calculate
   *  the number of days remaining in the start month (may be zero) and add it to lDay2
   IF lDay1 > lDay2
      IF lMonth1 = 12
         lFirstnext = CTOD("01/01/" + STR(lYear1 + 1,4))
        ELSE
         lFirstNext = CTOD("01/" + STR((lMonth1 + 1),2) + "/" +STR(lYear1,4))
         ENDIF
      lDays = (lFirstNext - lFirst) + lDay2 - 1
     ELSE
      lDays = lDay2 - lDay1
      ENDIF
   
   *  Now the total number of months (inc 12 * the year-difference)
   lMonths = lMonth2 - lMonth1 + 12 * (lYear2 - lYear1) - IIF(lDay2 < lDay1, 1,0)
   lYears = INT(lMonths/12)
   lMonths = lMonths - (lYears * 12)
   lWeeks = INT(lDays/7)
   lDays = lDays - 7*lWeeks
   
   *  And format the answer as text
   lAnswer = ""
   IF lYears > 0
      lAnswer = ALLTRIM(STR(lYears)+ " Year"+IIF(lYears>1,"s",""))
      ENDIF
   IF lmonths > 0
      lAnswer = lAnswer +" "+ALLTRIM(STR(lMonths))+" Month"+IIF(lMonths>1,"s","")
      ENDIF
   IF lWeeks > 0
      lAnswer = lAnswer +" "+ALLTRIM(STR(lWeeks))+" Week"+IIF(lWeeks>1,"s","")
      ENDIF
   IF lDays > 0
      lAnswer = lAnswer +" "+ALLTRIM(STR(lDays))+" Day"+IIF(lDays>1,"s","")
      ENDIF
   RETURN lAnswer

FUNCTION FormatDate (DateIn AS Date)
LOCAL Temp
   Temp = DTOC(DateIn)
   IF LEFT(Temp,2) = "  "
      RETURN (SPACE(9)) 
      ENDIF
   RETURN (LEFT(Temp,3) + MonShort(Month(DateIn))+SUBSTR(Temp,6,3) )
   ENDFUNC

FUNCTION MonShort (vMonth AS Integer)
RETURN SUBSTR("JanFebMarAprMayJunJulAugSepOctNovDec", 3*vMonth - 2,3)
ENDFUNC

Just for interest I have taken a screen shot of the results from the two approaches :
Results from Mark :
Mark_results_ux7oca.png


Results from Andrew :
Andrew_results_eydhur.png


I appreciate that this could end up as a theological discussion!
 
Hi Griff and Andrew,

Below a demo of how the three functions work - Griff's (third column), Andrew's (second column) and mine (first column)

Afaics, Andrew's code yields the the most accurate results.

Code:
CLOSE ALL
CLEAR ALL

LOCAL ldDate as Date, lnI as Integer

ldDate = {^2001-06-15}

CREATE CURSOR csrDateDifference (dSTDate D, dEDate D, nDays I, cMK2DDAsWords C(50), cMozDDAsWord C(50), cGDDAsWords c(50))

FOR i = 1 TO 12000

	lnI = INT(6000 * RAND(i))
	
	INSERT INTO csrDateDifference VALUES (ldDate, ldDate + lnI, lnI, MK2DateDiffAsWords(ldDate, ldDate + lnI), ;
				MozDateDiffAsWords(ldDate, ldDate + lni), ;
				GRDateDiffAsWords(ldDate, ldDate + lni))
ENDFOR 

BROWSE 

CLOSE ALL
CLEAR ALL 
RETURN 

**********
FUNCTION GRDateDiffAsWords()

*!*	written by Griff

LPARAMETERS ldDATE1, ldDATE2

LOCAL liYEARS, liMONTHS, liDAYS, liWEEKS, lcSTRING
	
	liYEARS = 0
	liMONTHS = 0
	liWEEKS = 0
	liDAYS = 0

	IF GOMONTH(ldDATE1, 1) <= ldDATE2
		liMONTHS = (YEAR(ldDATE2 + 1) * 12 + MONTH(ldDATE2 + 1)) - (YEAR(ldDATE1) * 12 + MONTH(ldDATE1)) - 1
	ENDIF
	
	** advance earlier date on by that many months
	ldDATE1 = GOMONTH(ldDATE1, liMONTHS)
	
	** determine the number of days left 
	liDAYS = ldDATE2 - ldDATE1
	
	** turn that into whole weeks
	liWEEKS = INT(liDAYS/7)
	
	** determine the number of days left if you take away that many weeks
	liDAYS = liDAYS - (liWEEKS * 7)
	
	** use the months to calculate the number of whole years
	liYEARS = INT(liMONTHS / 12)
	liMONTHS = liMONTHS - (liYEARS * 12)

	lcSTRING = ""
	
IF liYEARS > 0
	lcSTRING = ALLTRIM(STR(liYEARS)+ " Year" + IIF(liYEARS > 1,"s",""))
ENDIF
	
IF liMONTHS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liMONTHS))+" Month" + IIF(liMONTHS > 1,"s",""))
ENDIF

IF liWEEKS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liWEEKS))+" Week" + IIF(liWEEKS > 1,"s",""))
ENDIF

IF liDAYS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liDAYS))+" Day" + IIF(liDAYS>1,"s",""))
ENDIF

RETURN(lcSTRING) 

*********

FUNCTION MK2DATEDIFFASWORDS()

*!*	Assumptions: this functions assumes that a year has 365.25 days 
*!*	(between 2001 and 2099 - see leap year on Wikipedia) and hence a month 30.4375 days
*!*	written by marK

LPARAMETERS ldDATE1, ldDATE2

LOCAL liYEARS, liMONTHS, liDAYS, liWEEKS, liAllDays, lcSTRING
	
	liYEARS = 0
	liMONTHS = 0
	liWEEKS = 0
	liDAYS = 0
	liAllDays = 0
	
IF ldDATE2 > ldDATE1
	liYears = INT((ldDate2 - ldDate1) / 365.25)
	liMonths = INT((ldDate2 - ldDate1 - (liYears * 365.25)) / 30.4375)
	liWeeks = INT((ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375)) / 7)
	liDays = INT(ldDate2 - ldDate1 - (liYears * 365.25) - (liMonths * 30.4375) - (liWeeks * 7) + .5)

	IF liDays >= 7
		liDays = liDays - 7
		liWeeks = liWeeks + 1
	ENDIF 

	liAllDays = ldDate2 - ldDate1

ELSE 
	=MESSAGEBOX("Please check order of parameters", 48, "Difference in Y/M/W/D between dates")

ENDIF
	
	lcSTRING = ""
	
IF liYEARS > 0
	lcSTRING = ALLTRIM(STR(liYEARS)+ " Year" + IIF(liYEARS > 1,"s",""))
ENDIF
	
IF liMONTHS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liMONTHS))+" Month" + IIF(liMONTHS > 1,"s",""))
ENDIF

IF liWEEKS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liWEEKS))+" Week" + IIF(liWEEKS > 1,"s",""))
ENDIF

IF liDAYS > 0
	lcSTRING = ALLTRIM(lcSTRING +" "+ALLTRIM(STR(liDAYS))+" Day" + IIF(liDAYS>1,"s",""))
ENDIF

lcString = TRANSFORM(liAllDays) + " d <=> " + lcString

RETURN(lcSTRING) 

**********

FUNCTION MozDateDiffAsWords(vDate1, vDate2)

LOCAL lFirst, lLast, lDay1, lDay2, lMonth1, lMonth2, lYear1, lYear2, lFirstNext
LOCAL lYears, lMonths, lWeeks, lDays, lAnswer
   *  Put the dates in order
	IF vDate1 < vDate2
		lFirst = vDate1
		lLast = vDate2
	ELSE
		lFirst = vDate2
		lLast = vDate1
	ENDIF
   
   lDay1 = DAY(lFirst)
   lMonth1 = MONTH(lFirst)
   lYear1 = YEAR(lFirst)
   lDay2 = DAY(lLast)
   lMonth2 = MONTH(lLast)
   lYear2 = YEAR(lLast)
   
   *  The 'Days' difference is the trickier one.  If lDay1 > lDay2, we calculate
   *  the number of days remaining in the start month (may be zero) and add it to lDay2

	IF lDay1 > lDay2
		IF lMonth1 = 12
			lFirstnext = CTOD("01/01/" + STR(lYear1 + 1,4))
		ELSE
			lFirstNext = CTOD("01/" + STR((lMonth1 + 1),2) + "/" +STR(lYear1,4))
		ENDIF

			lDays = (lFirstNext - lFirst) + lDay2 - 1

	ELSE
    
		lDays = lDay2 - lDay1
	ENDIF
   
   *  Now the total number of months (inc 12 * the year-difference)
   lMonths = lMonth2 - lMonth1 + 12 * (lYear2 - lYear1) - IIF(lDay2 < lDay1, 1, 0)
   lYears = INT(lMonths/12)
   lMonths = lMonths - (lYears * 12)
   lWeeks = INT(lDays/7)
   lDays = lDays - 7*lWeeks
   
   *  And format the answer as text
   lAnswer = ""
   IF lYears > 0
      lAnswer = ALLTRIM(STR(lYears)+ " Year"+IIF(lYears>1,"s",""))
      ENDIF
   IF lmonths > 0
      lAnswer = lAnswer +" "+ALLTRIM(STR(lMonths))+" Month"+IIF(lMonths>1,"s","")
      ENDIF
   IF lWeeks > 0
      lAnswer = lAnswer +" "+ALLTRIM(STR(lWeeks))+" Week"+IIF(lWeeks>1,"s","")
      ENDIF
   IF lDays > 0
      lAnswer = lAnswer +" "+ALLTRIM(STR(lDays))+" Day"+IIF(lDays>1,"s","")
      ENDIF
RETURN lAnswer
***********

Enjoy

MarK
 
Hi Andrew,

Just a tiny little improvement.

In your function you may want to replace

Code:
		IF liSMonth = 12
			ldFirstnext = CTOD("01/01/" + STR(liSYear + 1,4))
		ELSE
			ldFirstNext = CTOD("01/" + STR((liSMonth + 1),2) + "/" +STR(liSYear,4))
		ENDIF

with

Code:
		ldFirstNext = GOMONTH(pdDate1 - DAY(pdDate1) + 1 , 1)

hth

MarK
 
...

and a form for the demo

Code:
oForm = CREATEOBJECT("myForm")
oForm.Show()
READ EVENTS

CLOSE ALL
CLEAR ALL 

RETURN

DEFINE CLASS myForm as Form

Visible = .T.
AutoCenter = .T.
BorderStyle = 2
MinButton = .F.
MaxButton = .F.
Themes = .F.

	ADD OBJECT lblSDate as Label WITH Left = 12, Top = 12, Caption = "Startdate"
	ADD OBJECT lblEDate as Label WITH Left = 120, Top = 12, Caption = "Today"
	ADD OBJECT lblDiffInWords as Label WITH Left = 12, Top = 72, ;
					Caption = "Difference between today and startdate in words", AutoSize = .T.

	ADD OBJECT txtSDate as textbox WITH Top = 36, Left=10, Width = 90
	ADD OBJECT txtEDate as textbox WITH Top = 36, Left = 120 , Width = 90
	ADD OBJECT txtCode as textbox WITH Top = 90, Left=10, Width = 270

	PROCEDURE Init
		this.txtEDate.StrictDateEntry = 1
		this.txtEDate.Value = DATE()
		this.txtEDate.ReadOnly = .T.
      
		this.txtSDate.Value = {}
	ENDPROC 
      
	PROCEDURE txtSDate.LostFocus
		IF EMPTY(This.Value)
			This.Value = {^2000-01-01}
		ENDIF 

		ThisForm.txtCode.Value = ThisForm.AMDateDiffAsWords(ThisForm.txtSDate.Value, ThisForm.txtEDate.Value)
	ENDPROC 

	PROCEDURE AMDateDiffAsWords()
	*!*	written by MarK - inspired by Andrew Mozley

		LPARAMETERS  tdSDate, tdEDate

		LOCAL ldFirstNextMonth as Date, ;
				 liTotalMonths as Integer, ;
				 liYears as Integer, ;
				 liMonths as Integer, ;
				 liWeeks as Integer, ;
				 liDays as Integer, ;
				 lcAnswer as Character
				 
				 ldFirstNextMonth = {}
				 liTotalMonths = 0
				 liYears = 0
				 liMonths = 0
				 liWeeks = 0
				 liDays = 0
				 lcAnswer = ""  

		*!*	If Day(tdSDate) > day(tdEDate), we calculate the number of days remaining in the 
		*!*	start month (may be zero) and add it to the number of days in the end date

		IF tdEDate > tdSDate
			IF DAY(tdSDate) > DAY(tdEDate)
				ldFirstNextMonth = GOMONTH(tdSDate - DAY(tdSDate) + 1 , 1)
				liDays = DAY(tdEDate) + (ldFirstNextMonth - tdSDate) - 1

			ELSE
				liDays = DAY(tdEDate) - DAY(tdSDate)
			
			ENDIF
		   
		*!*	Now the total number of months

		   liTotalMonths = MONTH(tdEDate) - MONTH(tdSDate) + (12 * (YEAR(tdEDate) - YEAR(tdSDate))) - IIF(DAY(tdSDate) > DAY(tdEDate), 1, 0)
		   liYears = INT(liTotalMonths / 12)
		   liMonths = liTotalMonths - (liYears * 12)
		   liWeeks = INT(liDays / 7)
		   liDays = liDays - (7 * liWeeks)
		   
		ELSE 
			=MESSAGEBOX("Please check order of parameters", 48, "Difference in Y/M/W/D between dates")

		ENDIF
		  
		*!*	And format the answer as text

		   lcAnswer = ""

		   IF liYears > 0
		      lcAnswer = ALLTRIM(STR(liYears)+ " Year" + IIF(liYears > 1,"s",""))
		      ENDIF
		   IF liMonths > 0
		      lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liMonths))+" Month"+ IIF(liMonths > 1,"s","")
		      ENDIF
		   IF liWeeks > 0
		      lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liWeeks)) +" Week"+ IIF(liWeeks > 1,"s","")
		      ENDIF
		   IF liDays > 0
		      lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liDays))+" Day"+ IIF(liDays > 1,"s","")
		      ENDIF
		RETURN lcAnswer
	
	ENDPROC
      
	PROCEDURE Destroy()
		CLEAR EVENTS
	
	ENDPROC 
   	
ENDDEFINE

Enjoy

MarK
 
very good B-)

Regards

Griff
Keep [Smile]ing

There are 10 kinds of people in the world, those who understand binary and those who don't.

I'm trying to cut down on the use of shrieks (exclamation marks), I'm told they are !good for you.

There is no place like G28 X0 Y0 Z0
 
...

and a little fancier

Code:
goForm = CREATEOBJECT("frmForm")
goForm.Visible = .T.
goForm.Show()

READ EVENTS

CLOSE ALL
CLEAR ALL 

RETURN

**********

DEFINE CLASS frmForm as Form

Caption = "Date difference in Y/M/W/D"
AutoCenter = .T.
BorderStyle = 3
Width = 540
MinWidth = 540
Height = 300
MinHeight = 300
MinButton = .F.
MaxButton = .F.
Themes = .F.

	ADD OBJECT lblName as Label WITH Left = 12, Top = 12, Caption = "Name"
	ADD OBJECT lblSDate as Label WITH Left = 84, Top = 12, Caption = "Startdate"
	ADD OBJECT lblEDate as Label WITH Left = 186, Top = 12, Caption = "Today"
	ADD OBJECT lblDiffInWords as Label WITH Left = 12, Top = 72, AutoSize = .T. , ;
					Caption = "Difference between today and startdate in words"

	ADD OBJECT txtName as Textbox WITH Top = 36, Left = 12, Width = 60
	ADD OBJECT txtSDate as textbox WITH Top = 36, Left = 84, Width = 90
	ADD OBJECT txtEDate as textbox WITH Top = 36, Left = 186 , Width = 90
	ADD OBJECT txtCode as textbox WITH Top = 90, Left=12, Width = 264
	
	ADD OBJECT cmdDoit as CommandButton WITH Left = 294, Top = 36, Height = 78, Width = 234, BackColor = RGB(0, 180, 240), ;
							FontBold = .T. , FontSize = 16, Caption = "Calculate", Anchor = 11

		PROCEDURE cmdDoit.Click()
			LOCAL ARRAY laNameDays[1]
			
			IF EMPTY(ThisForm.txtName.Value)
				ThisForm.txtName. Value = "Bernie"
			ENDIF 
			
			IF EMPTY(ThisForm.txtSDate.Value)
				ThisForm.txtSDate.Value = {^2000-01-01}
			ENDIF 

			ThisForm.txtCode.Value = ThisForm.AMDateDiffAsWords(ThisForm.txtSDate.Value, ThisForm.txtEDate.Value)
			
			SELECT cName, cDiffAsWords FROM csrBirthdays ;
				WHERE cName = ThisForm.txtName.Value AND cDiffAsWords = ThisForm.txtCode.Value ;
				INTO ARRAY laNameDays

			IF ALEN(laNameDays) = 1
				INSERT INTO csrBirthdays VALUES (ThisForm.txtName.Value, ;
											ThisForm.txtSDate.Value, ;
											ThisForm.txtEDate.Value, ;
											ThisForm.txtEDate.Value - ThisForm.txtSDate.Value, ;
											ThisForm.txtCode.Value)
			ELSE
			
				WAIT WINDOW + ALLTRIM(ThisForm.txtName.Value) +" "+ ALLTRIM(ThisForm.txtCode.Value) + " is already registered!" TIMEOUT 3
			
			ENDIF 
			
			ThisForm.Refresh()		
		ENDPROC 
	
	ADD OBJECT grdBirthdays AS Grid WITH ;
		RecordSource = "csrBirthdays", ;
		ColumnCount = -1 , ;
		Left = 12, ;
		Top = 120, ;
		Width = ThisForm.Width - 24, ;
		Height = ThisForm.Height - 136, ;
		DeleteMark = .F. , ;
		Enabled = .T. , ;
		Anchor = 15
 
		PROCEDURE grdBirthdays.Init
			 WITH This.Column1
			  .Width = 60			
			  .Header1.Caption = "Name"
			 ENDWITH

			 WITH This.Column2
			  .Width = 90			
			  .Header1.Caption = "Birthday"
			 ENDWITH

			 WITH This.Column3
			  .Width = 90			
			  .Header1.Caption = "Today"
			 ENDWITH

			 WITH This.Column4
			  .Header1.Caption = "Days"
			 ENDWITH

			 WITH This.Column5
			  .Width = 180			
			  .Header1.Caption = "Difference in Y/M/W/D"
			 ENDWITH
		 ENDPROC 
		 
	PROCEDURE Init
		this.txtSDate.Value = {}

		this.txtEDate.Value = DATE()
		this.txtEDate.ReadOnly = .T.
		
	ENDPROC 
	
	PROCEDURE Load()
		CREATE CURSOR csrBirthdays (cName C(24), dSDate D, dEDate D, iDays I, cDiffAsWords C(90))
		
	ENDPROC 
      
	PROCEDURE Destroy()
		CLEAR EVENTS
	
	ENDPROC 
	
	PROCEDURE AMDateDiffAsWords()
	*!*	written by MarK - inspired by Andrew Mozley

		LPARAMETERS  tdSDate, tdEDate

		LOCAL ldFirstNextMonth as Date, ;
				 liTotalMonths as Integer, ;
				 liYears as Integer, ;
				 liMonths as Integer, ;
				 liWeeks as Integer, ;
				 liDays as Integer, ;
				 lcAnswer as Character
				 
		ldFirstNextMonth = {}
		liTotalMonths = 0
		liYears = 0
		liMonths = 0
		liWeeks = 0
		liDays = 0
		lcAnswer = ""  

		*!*	If Day(tdSDate) > day(tdEDate), we calculate the number of days remaining in the 
		*!*	start month (may be zero) and add it to the number of days in the end date

		IF tdEDate > tdSDate
			IF DAY(tdSDate) > DAY(tdEDate)
				ldFirstNextMonth = GOMONTH(tdSDate - DAY(tdSDate) + 1 , 1)
				liDays = DAY(tdEDate) + (ldFirstNextMonth - tdSDate) - 1

			ELSE
				liDays = DAY(tdEDate) - DAY(tdSDate)
			
			ENDIF
		   
		*!*	Now the total number of months

		   liTotalMonths = MONTH(tdEDate) - MONTH(tdSDate) + (12 * (YEAR(tdEDate) - YEAR(tdSDate))) - IIF(DAY(tdSDate) > DAY(tdEDate), 1, 0)
		   liYears = INT(liTotalMonths / 12)
		   liMonths = liTotalMonths - (liYears * 12)
		   liWeeks = INT(liDays / 7)
		   liDays = liDays - (7 * liWeeks)
		   
		ELSE 
			=MESSAGEBOX("Please check order of parameters", 48, "Difference in Y/M/W/D between dates")

		ENDIF
		  
		*!*	And format the answer as text

		   lcAnswer = ""

		   IF liYears > 0
		      lcAnswer = ALLTRIM(STR(liYears)+ " Year" + IIF(liYears > 1,"s",""))
		      ENDIF
		   IF liMonths > 0
		      lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liMonths))+" Month"+ IIF(liMonths > 1,"s","")
		      ENDIF
		   IF liWeeks > 0
		      lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liWeeks)) +" Week"+ IIF(liWeeks > 1,"s","")
		      ENDIF
		   IF liDays > 0
		      lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liDays))+" Day"+ IIF(liDays > 1,"s","")
		      ENDIF
		RETURN lcAnswer
	
	ENDPROC
   	
ENDDEFINE 
**********

MarK
 
Thank you Mark.

Mark said:
Just a tiny little improvement. In your function you may want to write :

ldFirstNext = GOMONTH(pdDate1 - DAY(pdDate1) + 1 , 1)

I had not appreciated the usefulness of GOMONTH(); Will incorporate that change.

- Andrew
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top