função para retornar a idade de cada funcionário\paciente
23/03/2003
0
[b:4453e32239]Ex: ( 20 anos e 4 meses ),,,[/b:4453e32239]
Estou precisando e se alguém tiver vai me poupar um trabalhão!!!!
Valeu galera,,,,,
[b:4453e32239][/b:4453e32239]
Anonymous
Posts
23/03/2003
Carnette
23/03/2003
Adilsond
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; Edit2: TEdit; procedure Button1Click(Sender: TObject); private { Private declarations } function DaysPerMonth(AYear, AMonth: Integer): Integer; procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word); public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} function TForm1.DaysPerMonth(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 IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special } end; procedure TForm1.DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word); var DtSwap: TDateTime; Day1, Day2, Month1, Month2, Year1, Year2: Word; begin if Date1 > Date2 then begin DtSwap := Date1; Date1 := Date2; Date2 := DtSwap; end; DecodeDate(Date1, Year1, Month1, Day1); DecodeDate(Date2, Year2, Month2, Day2); Years := Year2 - Year1; Months := 0; Days := 0; if Month2 < Month1 then begin Inc(Months, 12); Dec(Years); end; Inc(Months, Month2 - Month1); if Day2 < Day1 then begin Inc(Days, DaysPerMonth(Year1, Month1)); if Months = 0 then begin Dec(Years); Months := 11; end else Dec(Months); end; Inc(Days, Day2 - Day1); end; procedure TForm1.Button1Click(Sender: TObject); var Dia, Mes, Ano: Word; begin DateDiff(StrToDate(Edit1.Text),StrToDate(Edit2.Text),Dia,Mes,Ano); ShowMessage(Format(´¬.d dias, ¬.d meses e ¬.d anos´,[Dia,Mes,Ano])); end; end.
23/03/2003
Anonymous
Var AuxIdade, Meses : String;
MesesFloat : Real;
IdadeInc, IdadeReal : Integer;
begin
AuxIdade := Format(´¬0.2f´, [(Date - Nasc) / 365.6]);
Meses := FloatToStr(Frac(StrToFloat(AuxIdade)));
if AuxIdade = ´0´ then
begin
Result := 0;
Exit;
end;
if Meses[1] = ´-´ then
begin
Meses := FloatToStr(StrToFloat(Meses) * -1);
end;
Delete(Meses, 1, 2);
if Length(Meses) = 1 then
begin
Meses := Meses + ´0´;
end;
if (Meses <> ´0´) And (Meses <> ´´) then
begin
MesesFloat := Round(((365.6 * StrToInt(Meses)) / 100) / 30.47)
end
else
begin
MesesFloat := 0;
end;
if MesesFloat <> 12 then
begin
IdadeReal := Trunc(StrToFloat(AuxIdade)); // + MesesFloat;
end
else
begin
IdadeInc := Trunc(StrToFloat(AuxIdade));
Inc(IdadeInc);
IdadeReal := IdadeInc;
end;
Result := IdadeReal;
end;
Espero ter Ajudado :evil:
Clique aqui para fazer login e interagir na Comunidade :)