Fórum Me ajuda neste Probleminha #146090
15/03/2003
0
>>>Eu estou tentando fazer um pequeno programa que calcula a Idade de uma pessoa a parti da Data de Nascimento e Data Atual.... e dar o resultado como Literal (String) numa Label.......eu estou usando estes Códigos só que não esta dando certo .....Aguem pode me ajuda ....fico muito grato .............[ ]s ......Jairo-GO
procedure TForm1.BitBtn1Click(Sender: TObject);
var
DataIni,DataFin :Tdate ;
NumDias:real;
sAnos,sMeses,sDias :string;
Anos,Meses,Dias:integer;
begin
DataIni :=strtodate(MaskEdit1.Text);
DataFin := strtodate (MaskEdit1.Text);
NumDias := datafin - dataini;
{ --- Calcula o número de anos --- }
anos:=0;
while NumDias >=365 do begin
Anos := Anos + 1;
NumDias:=NumDias - 365;
end;
if Anos >1 then
sAnos := ´ anos,´
else
sAnos := ´ ano,´;
{ --- Calcula o número de meses --- }
Meses := 0;
while NumDias >=30 do
begin
Meses := Meses + 1;
NumDias:=NumDias - 30;
end;
if Meses > 1 then
sMeses := ´ meses e ´
else
sAnos := ´ mês e ´;
{ --- O Número de dias é a sobra --- }
NumDias := NumDias;
if sDias >1 then
sDias := ´dias´
else
sDias := ´dia´;
label1.caption:= Inttostr(Anos)+sAnos+inttostr(Meses)+sMeses+inttostr(Dias)+sDias;
end;
end.
Meu e-mail>>>>>>>jairobig@hotmail.com
procedure TForm1.BitBtn1Click(Sender: TObject);
var
DataIni,DataFin :Tdate ;
NumDias:real;
sAnos,sMeses,sDias :string;
Anos,Meses,Dias:integer;
begin
DataIni :=strtodate(MaskEdit1.Text);
DataFin := strtodate (MaskEdit1.Text);
NumDias := datafin - dataini;
{ --- Calcula o número de anos --- }
anos:=0;
while NumDias >=365 do begin
Anos := Anos + 1;
NumDias:=NumDias - 365;
end;
if Anos >1 then
sAnos := ´ anos,´
else
sAnos := ´ ano,´;
{ --- Calcula o número de meses --- }
Meses := 0;
while NumDias >=30 do
begin
Meses := Meses + 1;
NumDias:=NumDias - 30;
end;
if Meses > 1 then
sMeses := ´ meses e ´
else
sAnos := ´ mês e ´;
{ --- O Número de dias é a sobra --- }
NumDias := NumDias;
if sDias >1 then
sDias := ´dias´
else
sDias := ´dia´;
label1.caption:= Inttostr(Anos)+sAnos+inttostr(Meses)+sMeses+inttostr(Dias)+sDias;
end;
end.
Meu e-mail>>>>>>>jairobig@hotmail.com
Anonymous
Curtir tópico
+ 0
Responder
Posts
15/03/2003
Carnette
>>>
Idade
// Programador - Paulo Alexsandro Freitas de Miranda <- The Programmer ->
// dprogrammer@ieg.com.br
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.
Eu estou tentando fazer um pequeno programa que calcula a Idade de uma pessoa a parti da Data de Nascimento e Data Atual.... e dar o resultado como Literal (String) numa Label.......eu estou usando estes Códigos só que não esta dando certo .....Aguem pode me ajuda ....fico muito grato .............[ ]s ......Jairo-GO
procedure TForm1.BitBtn1Click(Sender: TObject);
var
DataIni,DataFin :Tdate ;
NumDias:real;
sAnos,sMeses,sDias :string;
Anos,Meses,Dias:integer;
begin
DataIni :=strtodate(MaskEdit1.Text);
DataFin := strtodate (MaskEdit1.Text);
NumDias := datafin - dataini;
{ --- Calcula o número de anos --- }
anos:=0;
while NumDias >=365 do begin
Anos := Anos + 1;
NumDias:=NumDias - 365;
end;
if Anos >1 then
sAnos := ´ anos,´
else
sAnos := ´ ano,´;
{ --- Calcula o número de meses --- }
Meses := 0;
while NumDias >=30 do
begin
Meses := Meses + 1;
NumDias:=NumDias - 30;
end;
if Meses > 1 then
sMeses := ´ meses e ´
else
sAnos := ´ mês e ´;
{ --- O Número de dias é a sobra --- }
NumDias := NumDias;
if sDias >1 then
sDias := ´dias´
else
sDias := ´dia´;
label1.caption:= Inttostr(Anos)+sAnos+inttostr(Meses)+sMeses+inttostr(Dias)+sDias;
end;
end.
Meu e-mail>>>>>>>jairobig@hotmail.com
Responder
Gostei + 0
15/03/2003
Adilsond
Se voce possuir a bliblioteca RxLib.
uses DateUtil;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
Ano,
Mes,
Dia: 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;
uses DateUtil;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
Ano,
Mes,
Dia: 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;
Responder
Gostei + 0
16/03/2003
Anonymous
vou passa......
Responder
Gostei + 0
17/03/2003
Anonymous
..........
Responder
Gostei + 0
Clique aqui para fazer login e interagir na Comunidade :)