Validar y Autocompletar Fecha en un DBEdit

[[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