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