12 de abril de 2004

Clase para calcular la edad con Años, Meses y Días

El MVP Turco, Cetin Bazos nos ofrece una excelente clase para calcular la edad, separando además, los años, meses y días, en propiedades.
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öz
Editor: Esparta Palma

No hay comentarios. :

Publicar un comentario