Facilitando digitação de data

Em qualquer documento, geralmente temos que informar datas, de modo que se torna necessário agilizar a digitação.
Pra resolver esse problema, criei duas rotinas, que já uso ha uns 6 anos.
Pra quem é experiente, é algo banal, mas para os iniciantes, essa dica pode ser interessante.

Como funciona as rotinas

São duas rotinas:
Validakeydatas e Validakeydatas2.
Funciona validando a data quando o usuario tecla ENTER.
No meu caso tem sido muito útil, pois essas rotinas alem de validar as datas tem outras vantagens:
.Agiliza na digitação, pois ao digitar a data não precisa colocar o separador, no caso a barra '/', e adicionalmente, não precisa informar o ano da data, que a rotina completa automaticamente
.Pode ser usado em qualquer componente, como Edit, DBEdit, DBGrid.

Essas rotinas interceptam a digitação do usuario, retornando um caracter nulo no caso de digitar algo invalido.

A diferença de Validakeydatas e Validakeydatas2 é que na segunda função pode-se informar o ano para preenchimento automatico.

Por exemplo, pra informar '01/12/2009' você digita apenas '01122009' ou '0112' e tecla ENTER.


Como utilizar as rotinas

Basta configurar o evento OnKeyPress do componente, da seguinte forma:
Crie um form
Insira dois componentes TEdit no form
De um duplo clique no evento OnKeyPress do Edit1

Exemplo 1
Validakeydatas

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);
begin
//Chama Validakeydatas, não aceita data em branco
Validakeydatas(Sender,Key,False);
if key=#13 then Edit2.setfocus;
if key=#27 then close;

end;


Exemplo 2
Validakeydatas

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);
begin
//Chama Validakeydatas, aceitando data em branco
Validakeydatas(Sender,Key,True);
if key=#13 then Edit2.setfocus;
if key=#27 then close;

end;

Exemplo 3
Utilizando
Validakeydatas2

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);
begin
//Chama Validakeydatas
//não aceita data em branco
//se não informar o ano, preenche com '2009'
Validakeydatas2(Sender,Key,False,'2009');
if key=#13 then Edit2.setfocus;
if key=#27 then close;

end;

Codigo fonte


Segue abaixo um exemplo de Unit que poderia ser usada pra armazenar as funcoes:

unit funcoes1;

interface

uses

LCLIntf, Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
EditBtn, ExtCtrls, StdCtrls;

Function IsDate(wData:String):Boolean;
Procedure ValidaKeyDatas(Const Sender:TObject; var key: char; Const AceitaNulo: Boolean);
Procedure ValidaKeyDatas2(Const Sender:TObject; var key: char; Const AceitaNulo: Boolean;Const zAno:String);

implementation

Function IsDate(wData:String):Boolean;
var
T:TDateTime;
Begin
Try
T:=StrToDateTime(wData);
Result:=True;
except
Result:=False;
end;
end;


Procedure ValidaKeyDatas(Const Sender:TObject; var key: char; Const AceitaNulo: Boolean);
var
D1:String;
L:integer;
begin
if not (key in ['0'..'9','/',#8,#13,#27]) Then key:=#0;
if Sender.ClassName='TEdit' Then
begin
    D1:=TEdit(Sender).Text;
    if (key=#13) and (D1='') then
         if not (AceitaNulo) Then key:=#0;

    if (key=#13) and (D1<>'') then
    begin
         L:=length(D1);
         if (pos('/',TEdit(Sender).Text)=0) and ((L=6) or (L=8)) then
         begin
             if L=6 then
                  D1:=copy(D1,1,2)+'/'+copy(D1,3,2)+'/'+copy(D1,5,2)
             else
                  D1:=copy(D1,1,2)+'/'+copy(D1,3,2)+'/'+copy(D1,5,4);
         end;
         if isdate(D1) Then TEdit(Sender).Text:=D1;
         if not isdate(D1) Then
         begin
             key:=#0;
             ShowMessage('Data Invalida');
             TEdit(Sender).SetFocus;
         end;
    end;
end;
end;

Procedure ValidaKeyDatas2(Const Sender:TObject; var key: char; Const AceitaNulo: Boolean;Const zAno:String);
var
D1:String;
L:integer;
begin
if not (key in ['0'..'9','/',#8,#13,#27]) Then key:=#0;
if Sender.ClassName='TEdit' Then
begin
    D1:=TEdit(Sender).Text;
    if (key=#13) and (D1='') then
         if not (AceitaNulo) Then key:=#0;

    if (key=#13) and (D1<>'') then
    begin
         L:=length(D1);
         if (pos('/',TEdit(Sender).Text)=0) and ((L=6) or (L=8)) then
         begin
             if L=6 then
                  D1:=copy(D1,1,2)+'/'+copy(D1,3,2)+'/'+copy(D1,5,2)
             else
                  D1:=copy(D1,1,2)+'/'+copy(D1,3,2)+'/'+copy(D1,5,4);
         end;

         if (pos('/',TEdit(Sender).Text)=0) and (L=4) then
         begin
             D1:=D1+zAno;
             L:=length(D1);
             if L=6 then
                  D1:=copy(D1,1,2)+'/'+copy(D1,3,2)+'/'+copy(D1,5,2)
             else
                  D1:=copy(D1,1,2)+'/'+copy(D1,3,2)+'/'+copy(D1,5,4);
         end;

         if isdate(D1) Then TEdit(Sender).Text:=D1;
         if not isdate(D1) Then
         begin
             key:=#0;
             ShowMessage('Data Invalida');
             TEdit(Sender).SetFocus;
         end;
    end;
end;

end;

end.


Até a próxima.
.