Validar y Autocompletar Fecha en un DBEdit

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