Idade com Anos, Meses e Dias.
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;
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;
Wilter Porto
Curtidas 0
Melhor post
Wilter Porto
13/01/2016
Funcionou, obrigado.
GOSTEI 1
Mais Respostas
Raimundo Pereira
12/01/2016
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);
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);
GOSTEI 0
Wilter Porto
12/01/2016
apresentou o mesmo erro.
GOSTEI 0
Raimundo Pereira
12/01/2016
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.
((MonthOf(Dtini))+meses);
Você está no mês 12 e soma +3, onde só existe 12 meses .
Vou vê o que consigo.
GOSTEI 0
Raimundo Pereira
12/01/2016
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.
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.
GOSTEI 0
Wilter Porto
12/01/2016
Agora me pediram para armazenar os anos e meses.
GOSTEI 0