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
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;
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.