Fórum Subtraçãocom hora #222619

{**************************************************************************

             Desenvolvido por: Rômulo Manoel de Freitas Barros
                           

 **************************************************************************    }

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);
       Procedure JumpTo(Const aAdress : String);
       Procedure ControlarTeclas(Var parTecla : Char); // Está rotina captura as teclas digitadas em um componente e verifica
                                                 // se ela é numérica ou alfanumérica. Se for numérica (entre 0 e 9) ou
                                                 // , backspace ou enter tudo saíra normalmente,
                                                 //  caso contrário, a tecla não será aceita,
                                            // ou seja, o usuário apenas poderá digitar números, e não letras.

   // Funções

       Function Criptografar(Cadeia: String): String;
       Function Descriptografar(Cadeia: String): String;
       Function ValidaCpf(Cpf : String) : Boolean;
       Function ValidaCEP(cCep:String ; cEstado:String): Boolean;


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;


function Criptografar(Cadeia: String): String;
Var
  I : Integer;
begin
   S := Cadeia;
   For I:=1 to ord(S[0]) Do
     C[I] := 23 XOr C[I];
   Result := S;
end;


function Descriptografar(Cadeia: String): String;
Var
  I : Integer;
begin
   S := Cadeia;
   For I:=1 to Length(S) do
     S[I] := char(23 Xor ord(C[I]));
   Result := S;
end;


Procedure JumpTo(Const aAdress : String);
Begin
   ShellExecute(Application.Handle,Nil,Pchar(aAdress),Nil,Nil,SW_SHOWNORMAL);
End;

Function ValidaCpf(Cpf : String) : Boolean;
Var
    n1,n2,n3,n4,n5,n6,n7,n8,n9: integer;
    d1,d2: integer;
    digitado, calculado: string;
    C : Byte; // Controle do laço "For"
Begin
   For C := 1 To Length(Cpf)Do // Esta rotina passa por todos os caracteres do Cpf e elimina Pontos (.) e traços (-),
   Begin                       // Evitando assim que ocorra erro durante a validação, pois a rotina não aceita pontos ou traços, que são da máscara.
      If((Copy(Cpf,C,1)=´.´)Or(Copy(Cpf,C,1)=´-´))Then
        Delete(Cpf,C,1);
   End;
   Cpf := Trim(Cpf);
   If((Cpf = ´´) Or (Length(Cpf)<11))Then  // Se o cpf estiver em branco ou possui menos de 11 caracteres então
   Begin                                   // o cpf não é válido (Result = false) e forçamos a saída da rotina (Exit),
      Result := False;                     // recebendo então o usuário uma mensagem de "Cpf Inválido" ;
      Exit;
   End;

   n1:=StrToInt(Cpf[1]);
   n2:=StrToInt(Cpf[2]);
   n3:=StrToInt(Cpf[3]);
   n4:=StrToInt(Cpf[4]);
   n5:=StrToInt(Cpf[5]);
   n6:=StrToInt(Cpf[6]);
   n7:=StrToInt(Cpf[7]);
   n8:=StrToInt(Cpf[8]);
   n9:=StrToInt(Cpf[9]);
   d1:=n9*2+n8*3+n7*4+n6*5+n5*6+n4*7+n3*8+n2*9+n1*10;
   d1:=11-(d1 mod 11);
   if d1>=10 then
      d1:=0;
      d2:=d1*2+n9*3+n8*4+n7*5+n6*6+n5*7+n4*8+n3*9+n2*10+n1*11;
      d2:=11-(d2 mod 11);
      if d2>=10 then
         d2:=0;
         calculado:=inttostr(d1)+inttostr(d2);
         digitado:=Cpf[10]+Cpf[11];
         if calculado=digitado then
           Result := True
         else
           Result := False;

End;

Function ValidaCEP(cCep:String ; cEstado:String): Boolean;
var
 cCEP1 : Integer;
 C : Byte; // Controla o laço "For"
Begin
 For C := 1 To Length(cCep)Do // Esta rotina passa por todos os caracteres do Cep e elimina Pontos (.) e traços (-),
 Begin // Evitando assim que ocorra erro durante a validação, pois a rotina não aceita pontos ou traços, que são da máscara.
    If((Copy(cCep,C,1)=´.´)Or(Copy(cCep,C,1)=´-´))Then
      Delete(cCep,C,1);
 End;
 cCep := Trim(cCep);
 If( (cCep =´´) Or (Length(cCep) < 8) )Then    // Verifica se o Cep está vazio ou se possui menos de 8 caracteres;
 Begin
    Result := False;
    Exit;
 End;
 cCep := copy(cCep,1,5) + copy(cCep,7,3);
 cCEP1 := StrToInt(copy(cCep,1,3));
 if Length(trim(cCep)) > 0 then
 begin
  if (StrToInt(cCep) <= 1000000.0) then
   begin 
    MessageDlg(´CEP tem que ser maior que [01000-000]´,mtError,[mbOk],0);
    Result := False
   end
  else
  begin
    if Length(trim(copy(cCep,5,3))) < 3 then Result := False else
    if (cEstado = ´SP´) and (cCEP1 >= 10 ) and (cCEP1 <= 199) then Result := True else
    if (cEstado = ´RJ´) and (cCEP1 >= 200) and (cCEP1 <= 289) then Result := True else
    if (cEstado = ´ES´) and (cCEP1 >= 290) and (cCEP1 <= 299) then Result := True else
    if (cEstado = ´MG´) and (cCEP1 >= 300) and (cCEP1 <= 399) then Result := True else
    if (cEstado = ´BA´) and (cCEP1 >= 400) and (cCEP1 <= 489) then Result := True else
    if (cEstado = ´SE´) and (cCEP1 >= 490) and (cCEP1 <= 499) then Result := True else
    if (cEstado = ´PE´) and (cCEP1 >= 500) and (cCEP1 <= 569) then Result := True else
    if (cEstado = ´AL´) and (cCEP1 >= 570) and (cCEP1 <= 579) then Result := True else
    if (cEstado = ´PB´) and (cCEP1 >= 580) and (cCEP1 <= 589) then Result := True else
    if (cEstado = ´RN´) and (cCEP1 >= 590) and (cCEP1 <= 599) then Result := True else
    if (cEstado = ´CE´) and (cCEP1 >= 600) and (cCEP1 <= 639) then Result := True else
    if (cEstado = ´PI´) and (cCEP1 >= 640) and (cCEP1 <= 649) then Result := True else
    if (cEstado = ´MA´) and (cCEP1 >= 650) and (cCEP1 <= 659) then Result := True else
    if (cEstado = ´PA´) and (cCEP1 >= 660) and (cCEP1 <= 688) then Result := True else
    if (cEstado = ´AM´) and ((cCEP1 >= 690) and (cCEP1 <= 692) or (cCEP1 >= 694) and

    (cCEP1 <= 698)) then Result := True else
    if (cEstado = ´AP´) and (cCEP1 = 689) then Result := True else
    if (cEstado = ´RR´) and (cCEP1 = 693) then Result := True else
    if (cEstado = ´AC´) and (cCEP1 = 699) then Result := True else
    if ((cEstado = ´DF´) or (cEstado = ´GO´)) and (cCEP1 >= 000)and(cCEP1 <= 999)then

    Result := True else
    if (cEstado = ´TO´) and (cCEP1 >= 770) and (cCEP1 <= 779) then Result := True else    
    if (cEstado = ´MT´) and (cCEP1 >= 780) and (cCEP1 <= 788) then Result := True else
    if (cEstado = ´MS´) and (cCEP1 >= 790) and (cCEP1 <= 799) then Result := True else
    if (cEstado = ´RO´) and (cCEP1 = 789) then Result := True else
    if (cEstado = ´PR´) and (cCEP1 >= 800) and (cCEP1 <= 879) then Result := True else
    if (cEstado = ´SC´) and (cCEP1 >= 880) and (cCEP1 <= 899) then Result := True else
    if (cEstado = ´RS´) and (cCEP1 >= 900) and (cCEP1 <= 999) then Result := True else
    
    Result := False
  end;
 end
 else
 begin
  Result := True;
 end;
End;

procedure ControlarTeclas(var parTecla: Char);
begin
   If(Not(parTecla In [´0´..´9´,8,13]))Then // Está rotina será chamada no evento OnKeyPress de um TEdit;
     parTecla := #0;                          // ele apenas deixa o usuário digitar números, e não letras.
                                              // 8 representa a tecla Backspace, que também será aceita normalmente,
                                              // assim como 13, que representa a tecla Enter; Esta rotina será chamada
                                              // no TEdit responsável pela atualização do estoque;
end;

end.