Idade com Anos, Meses e Dias.

12/01/2016

4

Estou usando esta função para poder calcular a idade com anos, meses e dias, preciso da idade bem completa mesmo. Quando informo a data inicial 15/12/2014 e a final 31/03/2016 me retorna a mensagem "Invalid Argument to date encode". Estou usando Delphi e Mysql.

Function diferenca_datas(Dtini, Dtfin :TDate) :string;
var
xAnos,
xMeses,
diferenca :Double;
dias,
anos,
meses :Integer;
begin
If (Dtini = 0) Or (Dtini > Date) Or (Dtini > Dtfin) Then
Begin
MessageDlg('Data inválida !', mtError, [mbOk], 0);
Exit;
End;

diferenca := Dtfin - Dtini;

xAnos := diferenca / 365.25;
anos := Trunc(xAnos);
xMeses := (xAnos - anos) * 12;
meses := Trunc(xMeses);

dias := DaysBetween(EncodeDate(YearOf(Dtini) + anos, MonthOf(Dtini) + meses, DayOf(Dtini)), Dtfin);

If dias = 30 Then
dias := 0;

If meses = 12 Then
Begin
meses := 0;
anos := anos + 1
End;

If anos > 1 Then
Result := IntToStr(anos) + ' anos '
Else
Result := IntToStr(anos) + ' ano ';

If meses > 1 Then
Result := Result + IntToStr(meses) + ' meses '
Else
Result := Result + IntToStr(meses) + ' mês ';

If dias > 1 Then
Result := Result + IntToStr(dias) +' dias '
Else
Result := Result + IntToStr(dias) +' dias ';
End;



procedure Tfrm_cadastro.BitBtn1Click(Sender: TObject);
var Dtini, Dtfin: TDate;
Begin
Dtini := StrToDate(Edit1.Text);
Dtfin := StrToDate(Edit2.Text);
Label_idadecompleta := (diferenca_datas(dtini, dtfin));
end;
Responder

Post mais votado

13/01/2016

Funcionou, obrigado.
Responder

Mais Posts

13/01/2016

P2

Onde se lê :
dias := DaysBetween(EncodeDate(YearOf(Dtini) + anos, MonthOf(Dtini) + meses, DayOf(Dtini)), Dtfin);


Tente assim:
Dtini:=EncodeDate((YearOf(Dtini))+anos,((MonthOf(Dtini)))+meses,((DayOf(Dtini))));

Dtfin:=EncodeDate((YearOf(Dtfin)),((MonthOf(Dtfin))),((DayOf(Dtfin))));

dias :=DaysBetween(Dtini, Dtfin);
Responder

13/01/2016

Wilter Porto

apresentou o mesmo erro.
Responder

13/01/2016

P2

O problema ocorre aqui
((MonthOf(Dtini))+meses);

Você está no mês 12 e soma +3, onde só existe 12 meses .

Vou vê o que consigo.
Responder

13/01/2016

P2

Conseguir realizando as rotinas abaixo.


Function CalculaIdade(DataIni, DataFim : TDateTime) : string;
var Idade : String;
Resto : Integer;
iDia, iMes, iAno, fDia, fMes, fAno : Word;
nDia, nMes, nAno, DiaBissexto : Double;
begin
DecodeDate(DataIni,iAno,iMes,iDia);
DecodeDate(DataFim,fAno,fMes,fDia);
nAno := iAno-fAno;

if nAno > 0 then

nAno := nAno - 1
else
if(fMes = iMes)and(fDia < iDia)then
nAno := nAno - 1;

if fMes < iMes then
begin
nMes := 12 - (iMes-fMes);
if fDia < iDia then nMes := nMes - 1;
end
else if fMes = iMes then
begin
nMes := 0;
if fDia < iDia then nMes := 11;
end
else if fMes > iMes then
begin
nMes := fMes - iMes;
if fDia < iDia then nMes := nMes - 1;
end;
nDia := 0;

if fDia > iDia then nDia := fDia - iDia;
if fDia < iDia then nDia := (DataFim-IncMonth(DataFim,-1))-(iDia-fDia);
Result := '';
if nAno = 1 then Result := FloatToStr(nAno)+ ' Ano '
else if nAno > 1 then Result := FloatToStr(nAno)+ ' Anos ';

if nMes = 1 then Result := Result + FloatToStr(nMes)+ ' Mês '
else if nMes > 1 then Result := Result + FloatToStr(nMes)+ ' Meses ';

if nDia = 1 then Result := Result + FloatToStr(nDia)+ ' Dia '
else if nDia > 1 then Result := Result + FloatToStr(nDia)+ ' Dias ';

end;


procedure TForm1.Button1Click(Sender: TObject);
var I,F:tdate;
begin
f:=(StrToDate(Edit2.Text));
i:=(StrToDate(Edit1.Text));

Label_idadecompleta.Caption:=CalculaIdade(f,i);
end;


Espero que realmente ajude.
Responder

13/01/2016

Wilter Porto

Agora me pediram para armazenar os anos e meses.
Responder
×
+1 DevUP
Acesso diário, +1 DevUP
Parabéns, você está investindo na sua carreira