Delphi Funções para idade

[.IndependentResearch.]

[CENTER]unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, Buttons, Mask; 
  
type 
  TForm1 = class(TForm) 
  meNasc: TMaskEdit; 
  Label1: TLabel; 
  SpeedButton1: TSpeedButton; 
  edIdade: TEdit; 
  Label2: TLabel; 
  BitBtn1: TBitBtn; 
  Label3: TLabel; 
  edDias: TEdit; 
  function Bissexto(AYear: Integer): Boolean; 
  function DiasDoMes(AYear, AMonth: Integer): Integer; 
  function Idade2(DataNasc : TDate) : String; 
  function Dias(Data : TDate) : String; 
  function Idade(Nasc : TDate) : String; 
  procedure SpeedButton1Click(Sender: TObject); 
  procedure meNascKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
  private 
  { Private declarations } 
  public 
  { Public declarations } 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.DFM} 
  
function TForm1.Bissexto(AYear: Integer): Boolean; 
begin 
  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0)); 
end; 
  
function TForm1.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 TForm1.Idade2(DataNasc : TDate) : 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; 
  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 TForm1.Dias(Data : TDate) : String; 
begin 
  Result := FloatToStr(Date - Data); 
end; 
  
function TForm1.Idade(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; 
  
procedure TForm1.SpeedButton1Click(Sender: TObject); 
begin 
  edDias.Text := Dias(StrToDate(meNasc.Text)); 
  edIdade.Text := Idade2(StrToDate(meNasc.Text)); 
end; 
  
procedure TForm1.meNascKeyDown(Sender: TObject; var Key: Word; 
  Shift: TShiftState); 
begin 
  if Key = 13 then begin 
  SpeedButton1.Click; 
  Key := 0; 
  end; 
end; 
  
end.  

[/CENTER]