Código: Selecionar todos
Set Date To British
Set Epoch to 1950
Set Century On
While .t.
cls
xdata:= date()
xnasc:= CToD(Space(8))
@ 12, 10 Say "Data de Nascimento:" Get xnasc
@ 14, 10 Say "Data Base.........." get xdata
Read
If LastKey() == 27
Exit
EndIf
x6:= xdata - xnasc
x9:= x8:= x5:= 0
x11:= xnasc
While x6 >= 365
If isleap(x11) //verefica se o ano e bissesto
If x6 > 0
xc:= 366
x6-= xc
x11+= xc
x8 ++
EndIf
Else
If x6 > 0
xc:= 365
x6-= xc
x11+= xc
x8 ++
EndIf
EndIf
If x6 < 0
x6+= xc
x8 --
Exit
EndIf
End
xa:= Day(xnasc)
xd:= Day(xdata)
? StrZero(x8, 2) + " Anos"
x7:= Int(x6 / 30)
x20:= AddMonth(xdata , -x7) // diminui os meses
If x6 >= 30
While .t.
x5++
x2:= x20 + x5
x3:= lastdayom(x2) //verefica se o mes e 30 ou 31 dias
x6-= x3
If x6 < 0
x6+= x3
x9:= x6
x5--
Exit
EndIf
End
EndIf
? StrZero(x5, 2) + " Meses"
If x6 >= 0
x9:= xd - xa
If x9 < 0
x9:= 30 - (x9 * -1)
EndIf
Else
x9:= x6
EndIf
? StrZero(x9, 2) + " Dias"
Inkey(0)
End
Código: Selecionar todos
FUNCTION Idade( dDataNasc, dDataCalc )
LOCAL nDias, nMeses, nAnos
hb_Default( @dDataCalc, Date() )
IF Dtoc( dDataNasc ) == " / / "
RETURN "*Indefinido*"
ENDIF
nAnos := Year( dDataCalc ) - Year( dDataNasc )
IF Substr( Dtos( dDataCalc ), 5 ) < Substr( Dtos( dDataNasc ), 5 )
nAnos := nAnos - 1
ENDIF
nMeses := ( 12 - Month( dDataNasc ) ) + Month( dDataCalc )
DO CASE
CASE Day( dDataCalc ) = Day( dDataNasc )
nDias := 0
CASE Day( dDataCalc ) < Day( dDataNasc )
nMeses := nMeses - 1
nDias := Day( Last_Day( dDataNasc ) ) - Day( dDataNasc ) + Day( dDataCalc )
OTHERWISE
nDias := Day( dDataCalc ) - Day( dDataNasc )
ENDCASE
nMeses = Mod( nMeses, 12 )
RETURN LTrim( Str( nAnos, 3 ) ) + " ano(s), " + LTrim( Str( nMeses, 3 ) ) + " mes(es), " + LTrim( Str( nDias, 3 ) ) + " dia(s)"
Código: Selecionar todos
FUNCTION Last_Day( dData )
dData += ( 40 - Day( dData ) )
dData -= Day( dData )
RETURN dData