Local birthDate,loCalculator
birthDate = DATE(1990,06,28)
loCalculator = Createobject("AgeCalculator")
loCalculator.CalcAge(birthDate,DATE(2010,01,31)) && Age in Jan 31,2010
? PrintAge(loCalculator,birthDate,DATE(2010,01,31))
loCalculator.CalcAge(birthDate) && Age today
? PrintAge(loCalculator,birthDate,Date())
Function PrintAge
Lparameters loAge, ldBirthDate, ldTarget
Local lcText
TEXT to m.lcText textmerge noshow
Birthday: [<<Transform(m.ldBirthDate,\@YL')>>] Target date: [<<Transform(m.ldTarget,\@YL')>>]
<<m.loAge.Years>> Years,<<m.loAge.Months>> Months,<<m.loAge.Days>> Days old
ENDTEXT
Return m.lcText
Endfunc
Function TestCalcBDateAccuracy
Create Cursor datedata ;
(dod D, dobS D Null, nyears i, nmonths i, ndays i, ;
ncyears i, ncmonths i, ncdays i, DiffDays i)
=Rand(-1)
loCalculator = Createobject("AgeCalculator")
For i = 1 To 1000000
dod = Date() - Int(Iif(i <= 500000, 1000, 10000) * Rand())
nyears = Int(99 * Rand() + 1)
nmonths = Int(11 * Rand() + 1)
ndays = Int(364 * Rand() + 1)
dobS = loCalculator.CalcBDate(m.dod, m.nyears, m.nmonths, m.ndays)
loCalculator.CalcAge(m.dod,m.dobS)
ncyears = loCalculator.Years
ncmonths = loCalculator.Months
ncdays = loCalculator.Days
DiffDays = loCalculator.GetDifference(m.dobS,;
m.nyears, m.nmonths, m.ndays, ;
m.ncyears, m.ncmonths, m.ncdays)
Insert Into datedata From Memvar
Endfor
Select * From datedata Where DiffDays <> 0 Order By DiffDays Desc
Endfunc
Define Class AgeCalculator As Custom
Years = 0
Months = 0
Days = 0
* Calculate age with given birthDate and target calculation date
* Target calculation date defaults to 'Today' if omitted
* CalcAge(birthDate[, targetDate])
Procedure CalcAge
Lparameters tdBirth, tdTarget
Local ldTemp, ldBirth, lnDrop
tdTarget = Iif(Empty(m.tdTarget), Date(), m.tdTarget)
If m.tdBirth > m.tdTarget
ldTemp = m.tdTarget
tdTarget = m.tdBirth
tdBirth = m.ldTemp
Endif
ldBirth = Date(Year(m.tdTarget),Month(m.tdBirth),Day(m.tdBirth))
lnDrop = 0
If Empty(m.ldBirth) && leap case
ldBirth = Date(Year(m.tdTarget),3,1)
lnDrop = Iif(Month(m.tdTarget)<=2,0,1)
Endif
With This
.Years = Year(m.tdTarget) - Year(m.tdBirth) - ;
(Iif(m.ldBirth > m.tdTarget,1,0))
.Months = (Month(m.tdTarget) - Month(m.tdBirth) + 12 - ;
(Iif(Day(m.tdBirth)>Day(m.tdTarget),1,0)))%12
ldTemp = Date( Year(m.tdBirth) + .Years, Month(m.tdBirth), Day(m.tdBirth) )
If Empty(ldTemp)
ldTemp = Date( Year(m.tdBirth) + .Years, Month(m.tdBirth), Day(m.tdBirth-1) )
Endif
.Days = m.tdTarget - Gomonth(m.ldTemp,.Months) - m.lnDrop
Endwith
Endproc
* Calculate birthDate from given date, years, months, days
* Question was raised originally by Jim Livermore on UT
* If grandma died on:
* Jan 1st, 1908
* and she was 83 years, 2 months, 5 days
* when she died what is her BirthDate
* CalcBDate(targetDate, years, months, days)
* Depending on passed values accuracy is => 98.6%
* With randomly generated 1 million values
* Less than 14000 calculated birthdates'
* difference from CalcAge() result is in the range 1 to -3 days
* Check test routine at top
Procedure CalcBDate
Lparameters tdTarget,tnYears,tnMonths,tnDays
Local ldDate,ldBirth
ldDate = m.tdTarget-m.tnDays
If Month(m.ldDate)=2 And Day(m.ldDate)=29
ldDate = Gomonth(m.ldDate,-m.tnMonths)
ldBirth = Date(Year(m.ldDate)-m.tnYears,Month(m.ldDate),Day(m.ldDate))
Else
ldBirth = Gomonth(;
Date(Year(m.ldDate)-m.tnYears,;
Month(m.ldDate),Day(m.ldDate)), -m.tnMonths)
Endif
Return m.ldBirth
Endproc
* Verification routines
* Used to check the accuracy of CalcBDate
Procedure GetDifference
Lparameters tdBirth, tnYears1,tnMonths1,tnDays1, tnYears2,tnMonths2,tnDays2
With This
Return ;
.DatesAdd(m.tdBirth, m.tnYears1,m.tnMonths1,m.tnDays1) - ;
.DatesAdd(m.tdBirth, m.tnYears2,m.tnMonths2,m.tnDays2)
Endwith
Endproc
Procedure DatesAdd
Lparameters tdDate, tnYears,tnMonths,tnDays
Local ldDate
ldDate = Date(Year(m.tdDate)+m.tnYears,Month(m.tdDate),Day(m.tdDate))
If Empty(m.ldDate)
ldDate = Date(Year(m.tdDate)+m.tnYears,2,28)
Endif
Return (Gomonth(m.ldDate,m.tnMonths)+m.tnDays)
Endproc
Enddefine
Autor: Çetin BasözEditor: Esparta Palma
No hay comentarios. :
Publicar un comentario
Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.