Ver Mensaje Individual
  #4  
Antiguo 28-12-2006
Avatar de gluglu
[gluglu] gluglu is offline
Miembro Premium
 
Registrado: sep 2004
Ubicación: Málaga - España
Posts: 1.455
Reputación: 21
gluglu Va por buen camino
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.
__________________
Piensa siempre en positivo !
Responder Con Cita