Bom dia,

Hoje vou mostrar algumas funções úteis em muitos casos, como: cálculo de idade, validação de datas, ano bisexto, conversor de segundos para horas, horas para segundos;


Calcular a idade (Parametro de entrada = date e retorno integer = idade):


function CalculaIdade(Data: TDateTime): Integer;
var
  a1,m1,d1, a2, m2, d2: word;
  Idade: Integer;
begin
  DecodeDate(Data, a1, m1, d1);
  DecodeDate(Date, a2, m2, d2);
  Idade := a2 - a1;
  if m2 < m1 then
    Idade := Idade - 1
  else if m2 = m1 then
  begin
    if d2 < d1 then
    Idade := Idade - 1;
  end;
  CalculaIdade := Idade;
end;

Verifica se a data é válida (essa função utiliza outra função que eu publiquei anteriormente, "alltrim", para quem não pegou antes, vou passar novamente):

Function VerifyDate(text : TCaption):Boolean;
const
    aMes : Array[1..12] of byte = (31,28,31,30,31,30,31,31,30,31,30,31);
var
    ok    : Boolean;
    d,m,a : Integer;
    cD,cM,cA : String[4];
    sDate : String;
begin
    sDate := text;
    ok := Length(sDate) = 10;
    if ok then begin
         ok := (sDate[3] = '/') and (sDate[6] = '/');
         cD := Alltrim(copy(sDate,1,2));
         cM := Alltrim(copy(sDate,4,2));
         cA := Alltrim(copy(sDate,7,4));
         if ok then
              ok := ( length(cd) = 2 ) and ( length(cm) = 2 ) and ( length(ca) = 4 );
         if ok then begin
              d := StrToIntDef(cd,-1);
              m := StrToIntDef(cm,-1);
              a := StrToIntDef(ca,-1);
              ok := (m > 0) and (m < 13) and (d > 0) and (d < aMes[m]+1);
              if ok and (a div 4 = 0) then begin
                   ok := d < 30;
              end;
         End;
    end;
    VerifyDate := ok;
end;

Função allTrim para remover os espaços em branco de uma string:

Function Alltrim(cStr:String):String;
var
  cCopy: String;
  i: Integer;
begin
  cCopy := '';
  for i := 1 to Length(cStr) do
    begin
      if cStr[i] <> ' ' then
        cCopy := cCopy + cStr[i];
    end;
  Result := cCopy;
end;

Verifica se o ano é bisexto (Retorna True ou False):

function AnoBis(Ano: Integer): Boolean;
begin
  if (Ano mod 4 <> 0) then
    AnoBis := False
  else
    if (Ano mod 100 <> 0) then
      AnoBis := True
    else
    if (Ano mod 400 <> 0) then
      AnoBis := False
    else
      AnoBis := True;
end;

Converte segundos (integer) para horas (string formato "00:00:00"):

function segundosToHorasString(pISegundos : Integer): String;
var
  vIHoras, vIHorasSeg, vIDifHoras, vIMinutos, vIMinutosSeg, vIDifMinutos : Integer;
begin
  vIHoras := trunc(pISegundos / 3600);
  vIHorasSeg := (vIHoras * 3600);
  vIDifHoras := (pISegundos - vIHorasSeg);
  vIMinutos := trunc(vIDifHoras / 60);
  vIMinutosSeg := (vIMinutos * 60);
  vIDifMinutos := (vIDifHoras - vIMinutosSeg);
  result := iif(Length(inttostr(vIHoras)) = 1, '0' + inttostr(vIHoras), inttostr(vIHoras)) + ':' +
            iif(Length(inttostr(vIMinutos)) = 1, '0' + inttostr(vIMinutos), inttostr(vIMinutos)) + ':' +
            iif(Length(inttostr(vIDifMinutos)) = 1, '0' + inttostr(vIDifMinutos), inttostr(vIDifMinutos));
end;

Converte horas (string formato "00:00:00") para segundos (integer):

function TfrmNewProgramacao.timeConvert(pSTempoExec: String): Integer;
var
  vS: String;
  vI: Integer;
begin
  vS := copy(pSTempoExec, 7, 2);
  vI := StrToInt(vS);
  vS := copy(pSTempoExec, 4, 2);
  vI := vI + (60 * StrToInt(vS));
  vS := copy(pSTempoExec, 1, 2);
  vI := vI + (3600 * StrToInt(vS));
  Result := vI;
end;

Espero ter ajudado. Estou a disposição para dúvidas...

Adriano Dias da Silva