Validar y Autocompletar Fecha en un DBEdit

[[gluglu]]

Hola Compañeros del Foro !

Intento validar y autocompletar una fecha dentro de un TDBEdit. Para ello he hecho uso del método descrito en http://delphi.about.com/od/adptips20...ltip0305_3.htm

Ligeramente modificado, me ha quedado el siguiente componente denominado TDBDateEdit

Código Delphi [-]
unit DBDateEdit;
 
interface
 
uses
  SysUtils, Classes, System.ComponentModel, Borland.Vcl.Controls,
  Borland.Vcl.StdCtrls, Borland.Vcl.Mask, Borland.Vcl.DBCtrls, DateUtils;
 
type
  TDBDateEdit = class(TDBEdit)
  private
    { Private declarations }
    procedure DateComplete;
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure ValidateEdit; override;
  published
    { Published declarations }
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Data Controls', [TDBDateEdit]);
end;
 
procedure TDBDateEdit.DateComplete;
var
  DateStr : string;
  Year, Month, Day : Word;
  cnt, SepCount : Integer;
begin
 
  DateStr := Text;
 
  if DateStr = '' then Exit;
  SepCount := 0;
 
  for cnt := 1 to Length(DateStr) do begin
    if not (DateStr[cnt] in ['0'..'9']) then begin
      DateStr[cnt] := '/';
      Inc(SepCount);
    end;
  end;
 
  while (DateStr <> '') and (DateStr[Length(DateStr)] = '/') do begin
    Delete(DateStr, Length(DateStr), 1);
    Dec(SepCount);
  end;
 
  DecodeDate(Now, Year, Month, Day);
 
  if SepCount = 0 then begin
    case Length(DateStr) of
         0 : DateStr := DateToStr(Now);
      1, 2 : DateStr := DateStr + '/' + IntToStr(Month);
         4 : Insert('/', DateStr, 3) ;
      6, 8 : begin
               Insert('/', DateStr, 5) ;
               Insert('/', DateStr, 3) ;
             end;
    end;
  end;
 
  try
    Text := DateToStr(StrToDate(DateStr));
  except
    abort;
  end;
 
end;
 
procedure TDBDateEdit.ValidateEdit;
var
   pos : integer;
begin
 
   if not Validate(Text, pos) then
     DateComplete;
 
   inherited;
 
end;
 
end.

Necesito un achuchón final.

El autocompletar funciona a la perfección. Pero me sigue saltando un error de 'Invalid Date' si introduzco p.ej. 29/02/2006. En cambio funciona bien, abortando la operación, si p.ej. introduzco en la fecha '89' como día.

Por otro lado también me gustaría poder llamar desde algún lado a mi propia rutina de mensaje de error que se encuentra en el programa principal en el cual hago uso del componente modificado, indicando p.ej. en el caso anterior de que se introdujera 29 de Febrero de 2006, u '89' en el día, que la fecha introducida es erronea.

Donde debería llamar a dicha rutina propia, o qué valor debería devolver en el componente para interceptar algún evento en mi programa principal ?

Como siempre, gracias por vuestra ayuda, y como no, aprovechar esta ocasión para desearos a todos Felices Fiestas y un Próspero Año Nuevo 2007.

[[gluglu]]

Pensaba que al introducir '29/02/2006' me ejecutaba

Código Delphi [-]
procedure TDBDateEdit.ValidateEdit;
var
   pos : integer;
   Aux_Date : TDateTime;
begin
   if not Validate(Text, pos) then
     DateComplete;
  ...

... pero estaba equivocado, y no entra ahí.

Funciona correctamente así :

Código Delphi [-]
procedure TDBDateEdit.ValidateEdit;
var
   pos : integer;
   Aux_Date : TDateTime;
begin
 
   if not Validate(Text, pos) then
     DateComplete;
 
   if not TryStrToDate(Text, Aux_Date) then
     Abort;
   
   inherited;
 
end;

Me queda entonces sólo la pregunta acerca de donde interceptar un posible error en mi programa principal para lanzar mi propio mensaje de error avisando de Fecha Erronea.

Entiendo que tengo que cambiar el 'Abort' por algo, pero necesito vuestra ayuda.

[[Lepe]]

Creamos un evento para que el usuario del componente pueda asignarlo via el inspector de objetos, lo llamamos OnValidateError.

Después de lanzar el evento dentro de nuestro componente, llamamos a Abort, para que continue.

Código Delphi [-]
unit DBDateEdit;
 
interface
 
uses
  SysUtils, Classes, System.ComponentModel, Borland.Vcl.Controls,
  Borland.Vcl.StdCtrls, Borland.Vcl.Mask, Borland.Vcl.DBCtrls, DateUtils;
 
type
  TError = ( eDay, eMonth, eYear, eDayAndMonth, eDayAndYear, eMonthAndYear, eAll);
  TValidateError = procedure (Sender:TObject; ErrorOn:TError; CurrentDate:string) of object;

  TDBDateEdit = class(TDBEdit)
  private
    { Private declarations }
    FOnError: TValidateError;
    procedure DateComplete;
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure ValidateEdit; override;
  published
    { Published declarations }
    property OnValidateError :TVAlidateError read FOnError write FOnError;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Data Controls', [TDBDateEdit]);
end;
 
procedure TDBDateEdit.DateComplete;
var
  DateStr : string;
  Year, Month, Day : Word;
  cnt, SepCount : Integer;
  tmpDate:TDatetime;
begin
 
  DateStr := Text;
 
  if DateStr = '' then Exit;
  SepCount := 0;
 
  for cnt := 1 to Length(DateStr) do begin
    if not (DateStr[cnt] in ['0'..'9']) then begin
      DateStr[cnt] := '/';
      Inc(SepCount);
    end;
  end;
 
  while (DateStr <> '') and (DateStr[Length(DateStr)] = '/') do begin
    Delete(DateStr, Length(DateStr), 1);
    Dec(SepCount);
  end;
 
  DecodeDate(Now, Year, Month, Day);
 
  if SepCount = 0 then begin
    case Length(DateStr) of
         0 : DateStr := DateToStr(Now);
      1, 2 : DateStr := DateStr + '/' + IntToStr(Month);
         4 : Insert('/', DateStr, 3) ;
      6, 8 : begin
               Insert('/', DateStr, 5) ;
               Insert('/', DateStr, 3) ;
             end;
    end;
  end;
 
  if not tryStrtoDate(year, month, day, tmpDatetime) then
  begin
    if Assigned(FOnError) then
    // tocaría averiguar donde falla la fecha y después asignar el parámetro ErrorOn
        FOnError(self, eDay, Datestr);
    abort;
  end;
end;
 
procedure TDBDateEdit.ValidateEdit;
var
   pos : integer;
begin
 
   if not Validate(Text, pos) then
     DateComplete;
 
   inherited;
 
end;
 
end.

Tendrás que añadir el Uses DateUtils para que reconozca TryStrToDate. Además está hecho de memoria, así que puede tener algún error en el orden de parámetros al llamar a dicha función.

Saludos

[[gluglu]]

Perfesssto !

Muy agradecido.

Lo he dejado de la siguiente manera :

Código Delphi [-]
unit DBDateEdit;
 
interface
 
uses
  SysUtils, Classes, System.ComponentModel, Borland.Vcl.Controls,
  Borland.Vcl.StdCtrls, Borland.Vcl.Mask, Borland.Vcl.DBCtrls;
 
type
  TError = ( eDay, eMonth, eYear, eDayAndMonth, eDayAndYear, eMonthAndYear, eAll);
  TValidateError = procedure (Sender: TObject; ErrorOn: TError; CurrentDate: string) of object;
  TDBDateEdit = class(TDBEdit)
  private
    { Private declarations }
    FOnError: TValidateError;
    procedure DateComplete;
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure ValidateEdit; override;
  published
    { Published declarations }
    property OnValidateError: TValidateError read FOnError write FOnError;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Data Controls', [TDBDateEdit]);
end;
 
procedure TDBDateEdit.DateComplete;
var
  DateStr : string;
  Year, Month, Day : Word;
  cnt, SepCount : Integer;
begin
 
  DateStr := Text;
 
  if DateStr = '' then Exit;
  SepCount := 0;
 
  for cnt := 1 to Length(DateStr) do begin
    if not (DateStr[cnt] in ['0'..'9']) then begin
      DateStr[cnt] := '/';
      Inc(SepCount);
    end;
  end;
 
  while (DateStr <> '') and (DateStr[Length(DateStr)] = '/') do begin
    Delete(DateStr, Length(DateStr), 1);
    Dec(SepCount);
  end;
 
  DecodeDate(Now, Year, Month, Day);
 
  if SepCount = 0 then begin
    case Length(DateStr) of
         0 : DateStr := DateToStr(Now);
      1, 2 : DateStr := DateStr + '/' + IntToStr(Month);
         4 : Insert('/', DateStr, 3) ;
      6, 8 : begin
               Insert('/', DateStr, 5) ;
               Insert('/', DateStr, 3) ;
             end;
    end;
  end;
 
  try
    Text := DateToStr(StrToDate(DateStr));
  except
    if Assigned(FOnError) then FOnError(self, eDay, '');
    Abort;
  end;
 
end;
 
procedure TDBDateEdit.ValidateEdit;
var
  pos : integer;
  Aux_Date : TDateTime;
begin
 
  if not Validate(Text, pos) then
     DateComplete
  else begin
 
    try
      Text := DateToStr(StrToDate(Text));
    except
      if Assigned(FOnError) then FOnError(self, eDay, '');
      Abort;
    end;
 
    inherited;
 
  end;
 
end;
 
end.

Esto me creo el evento deseado OnValidateError y en él puedo ya llamar a mi propia rutina del programa principal de mensaje de error.

De nuevo, muchas gracias Lepe.

[[Lepe]]

Hombreeeee, pero cúrratelo un poco más jajajaja.

El parámetro ErrorOn está pensado para decirle al programador (ususario del TDBedit) qué falla en la fecha, si el día (es mayor de 31), el mes (si es mayor de 12), si el día con el més (por ejemplo fallo del 31/02/2003) ya que febrero no tiene 31, etc.

Si no quieres usar ese parámetro para nada, borralo de su definición y borra también el parámetro cuando lanzas el evento.

Saludos