Fórum Somar Dias a uma Data ! #215167

unit Funcoes;

interface

Uses
  SysUtils, ShellApi,Forms,Windows, ComCtrls, Dialogs;

Var
  Horas,Minutos,Segundos,Milessegundos : Word;
  s : string[255];
  c : array[0..255] of Byte absolute s;

   // Procedimentos

       Procedure IncrementarHora(Var parHora : TDateTime; parValor : Word = 0);
       Procedure IncrementarMinuto(Var parHora : TDateTime; parValor : Word = 0);
       Procedure IncrementarSegundos(Var parHora : TDateTime; parValor : Word = 0);
       Procedure DecrementarHora(Var parHora : TDateTime; parValor : Word = 0);
       Procedure DecrementarMinuto(Var parHora : TDateTime; parValor : Word = 0);
       Procedure DecrementarSegundo(Var parHora : TDateTime; parValor : Word = 0);
       Procedure IncrementarAno(Var parData : TDateTime; parValor : Word = 0);
       Procedure IncrementarMes(Var parData : TDateTime; parValor : Word = 0);
       Procedure IncrementarDia(Var parData : TDateTime; parValor : Word = 0);

   // Funções



implementation

uses Math, DateUtils;

Procedure IncrementarHora(Var parHora : TDateTime; parValor : Word = 0);
Begin
   DecodeTime(parHora,Horas,Minutos,Segundos,Milessegundos);
   Horas := Horas + parValor;
   While(Horas >= 24)Do
   Begin
      Horas := Horas - 24;
   End;
   parHora := EncodeTime(Horas,Minutos,Segundos,Milessegundos);
End;


Procedure IncrementarMinuto(Var parHora : TDateTime; parValor : Word = 0);
Begin
  DecodeTime(parHora,Horas,Minutos,Segundos,Milessegundos);
  Minutos := Minutos + parValor;
  While(Minutos >= 60)Do
  Begin
     Minutos := Minutos - 60;
     Horas := Horas + 1;
     If(Horas = 24)then
       Horas := 0;
  End;
  parHora := EncodeTime(Horas,Minutos,Segundos,Milessegundos);
End;


Procedure IncrementarSegundos(Var parHora : TDateTime; parValor : Word = 0);
Begin
   DecodeTime(parHora,Horas,Minutos,Segundos,Milessegundos);
   Segundos := Segundos + parValor;
   While(Segundos >= 60)Do
   Begin
      Segundos := Segundos - 60;
      Minutos := Minutos + 1;
      If(Minutos = 60)Then
      Begin
        Minutos := 0;
        Horas := Horas + 1;
        If(Horas = 24)Then
          Horas := 0;
      End;
   End;
   parHora := EncodeTime(Horas,Minutos,Segundos,Milessegundos);
End;


Procedure DecrementarHora(Var parHora : TDateTime; parValor : Word = 0);
Begin
   DecodeTime(parHora,Horas,Minutos,Segundos,Milessegundos);
   If(Horas >= parValor)Then
     Horas := Horas - parValor
   Else
   Begin
      While(Horas < parValor)Do
         Horas := Horas + 24;
      Horas := Horas - parValor;
   End;
   If(Horas = 24)Then
     Horas := 0;
   parHora := EncodeTime(Horas,Minutos,Segundos,Milessegundos);
End;


Procedure DecrementarMinuto(Var parHora : TDateTime; parValor : Word = 0);
Begin
   DecodeTime(parHora,Horas,Minutos,Segundos,Milessegundos);
   If(Minutos >= parValor)Then
     Minutos := Minutos - parValor
   Else
   Begin
      While(Minutos < parValor)Do
      Begin
         Minutos := Minutos + 60;
         If(Horas = 0)Then
           Horas := 24;
         Horas := Horas -1;
      End;
      Minutos := Minutos - parValor;
   End;
   parHora := EncodeTime(Horas,Minutos,Segundos,Milessegundos);
End;


Procedure DecrementarSegundo(Var parHora : TDateTime; parValor : Word = 0);
Begin
   DecodeTime(parHora,Horas,Minutos,Segundos,Milessegundos);
   If(Segundos >= parValor)Then
     Segundos := Segundos - parValor
   Else
   Begin
      While(Segundos < parValor)Do
      Begin
         Segundos := Segundos + 60;
         If(Minutos = 0)Then
         Begin
            Minutos := 60;
            If(Horas = 0)Then
              Horas := 24;
            Horas := Horas - 1;
         End;
         Minutos := Minutos - 1;
      End;
      Segundos := Segundos - parValor;
   End;
   parHora := EncodeTime(Horas,Minutos,Segundos,Milessegundos);
End;


Procedure IncrementarAno(Var parData : TDateTime; parValor : Word = 0);
Begin
   IncYear(parData,parValor);
End;


Procedure IncrementarMes(Var parData : TDateTime; parValor : Word = 0);
Begin
   IncMonth(parData,parValor);
End;


Procedure IncrementarDia(Var parData : TDateTime; parValor : Word = 0);
Begin
   IncDay(parData,parValor);
End;

end.

Uses
  DateUtils ;