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
FOnError: TValidateError;
procedure DateComplete;
protected
public
procedure ValidateEdit; override;
published
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
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