Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Rodrigo Miss

Calcular idade

Recommended Posts

Cria a seguinte UNIT

 

unit Idade;interfaceuses  SysUtils, Controls;	function Idade2(DataNasc : TDate; var IdadeAno: integer) : String;implementationfunction Bissexto(AYear: Integer): Boolean;beginResult:=(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);beginResult:=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;beginIdade:='';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;	endelse	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;	endelse	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;beginAuxIdade := 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.

E depois chama ela:

 

lblIdade.Caption:=Idade2(StrToDate(dtNasc.Text),idade);

onde que o primeiro parametro é a data de nascimento, e o segundo é um inteiro que se passa como parametro e ele ira ficar com a idade da pessoa.

 

Não se esquema de adicionar no USES do seu form esta UNIT.

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.