Fórum Retorna a Idade da pessoa em um campo Edit #550692

unit Idade;

interface

uses
SysUtils, Controls;

function Idade2(DataNasc: TDate; var IdadeAno: integer): string;

implementation

function Bissexto(AYear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

function DiasDoMes(AYear, AMonth: Integer): Integer;
const
DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
Result := DaysInMonth[AMonth];
if (AMonth = 2) and Bissexto(AYear) then
Inc(Result);
end;

function Idade2(DataNasc: TDate; var IdadeAno: integer): string;
var
Ano1, Mes1, Dia1: Word;
Ano2, Mes2, Dia2: Word;
Ano, Mes, Dia: Word;
Idade: string;
AuxDia1, AuxDia2: Integer;
begin
Idade := '';
DecodeDate(DataNasc, Ano1, Mes1, Dia1);
DecodeDate(Date, Ano2, Mes2, Dia2);
AuxDia1 := Dia1;
AuxDia2 := Dia2;
if (Dia1 > Dia2) and ((Mes2 - Mes1) = 1) then
begin
Dia2 := Dia2 + DiasDoMes(Ano1, Mes1);
Mes1 := Mes2;
end
else if (Dia1 > Dia2) and (Mes1 <> Mes2) then
begin
Dia2 := Dia2 + DiasDoMes(Ano1, Mes1);
end
else if (Mes1 = Mes2) and (Dia1 > Dia2) and (Ano1 <> Ano2) then
begin
Dia2 := Dia2 + DiasDoMes(Ano1, Mes1);
Mes2 := Mes2 + 11;
Ano1 := Ano1 + 1;
end;
if (Mes1 > Mes2) and (AuxDia1 <= AuxDia2) then
begin
Ano1 := Ano1 + 1;
Mes2 := Mes2 + 12;
end
else if (Mes1 > Mes2) and (AuxDia1 > AuxDia2) then
begin
Ano1 := Ano1 + 1;
Mes2 := Mes2 + 11;
end;
Ano := Ano2 - Ano1;
IdadeAno := Ano;
Mes := Mes2 - Mes1;
Dia := Dia2 - Dia1;
if Ano > 1 then
Idade := IntToStr(Ano) + ' Anos'
else if Ano = 1 then
Idade := IntToStr(Ano) + ' Ano';
if Mes > 1 then
Idade := Idade + ', ' + IntToStr(Mes) + ' Meses '
else if Mes <> 0 then
Idade := Idade + ', ' + IntToStr(Mes) + ' Mês ';
if Ano = 0 then
Delete(Idade, 1, 1);
if Dia > 1 then
Idade := Idade + ' e ' + IntToStr(Dia) + ' Dias'
else if Dia <> 0 then
Idade := Idade + ' e ' + IntToStr(Dia) + ' Dia';
if (Mes = 0) and (Ano = 0) then
Delete(Idade, 1, 3);
if (Ano1 = Ano2) and (Mes1 = Mes2) and (Dia1 > Dia2) then
Idade := '0';
Result := Idade;
end;

function Idade1(Nasc: TDate): string;
var
AuxIdade, Meses, IdadeReal: string;
MesesFloat: Real;
IdadeInc: Integer;
begin
AuxIdade := Format('%0.2f', [(Date - Nasc) / 365.6]);
Meses := FloatToStr(Frac(StrToFloat(AuxIdade)));
if AuxIdade = '0' then
begin
Result := '0,0';
Exit;
end;
if Meses[1] = '-' then
Meses := FloatToStr(StrToFloat(Meses) * - 1);
Delete(Meses, 1, 2);
if Length(Meses) = 1 then
Meses := Meses + '0';
if (Meses <> '0') and (Meses <> '') then
MesesFloat := Round(((365.6 * StrToInt(Meses)) / 100) / 30)
else
MesesFloat := 0;
if MesesFloat <> 12 then
IdadeReal := IntToStr(Trunc(StrToFloat(AuxIdade))) + ',' + FloatToStr(MesesFloat)
else
begin
IdadeInc := Trunc(StrToFloat(AuxIdade));
Inc(IdadeInc);
IdadeReal := IntToStr(IdadeInc) + ',' + '0';
end;
Result := IdadeReal;
end;

end.