Ventas Code

unit Fecha;

interface

uses
  SysUtils, Classes, Controls, StdCtrls;

type
  TFecha = class(TEdit)
  private
    FFecha: TDate;

    procedure SetDate(dteFecha: TDate);
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
  protected
    procedure FormatText; dynamic;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;

  public
    constructor Create(AOwner: TComponent); override;
  published
    property Anchors;
    property AutoSize;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property Date: TDate read FFecha write SetDate;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TFecha]);
end;

{ TFecha }

procedure TFecha.CMExit(var Message: TCMExit);
begin
  inherited;
  FormatText;
end;

constructor TFecha.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFecha:= 0;
end;

procedure TFecha.FormatText;
begin
  if(FFecha <> 0) then
    Text:= FormatDateTime(ShortDateFormat, FFecha)
  else
    Text:= EmptyStr;
end;

procedure TFecha.KeyUp(var Key: Word; Shift: TShiftState);
var
  dteFecha: TDateTime;
  iDia: integer;
  iMes: integer;
  iAnio: integer;
  iTam: integer;
  sFecha: String;
begin
  inherited;
  sFecha:= Text;
  if(Trim(sFecha) = EmptyStr) then
  begin
    FFecha:= 0;
    exit;
  end;

  // si es una fecha válida, no hacer nada
  if(TryStrToDate(sFecha, dteFecha)) then
  begin
    FFecha:= dteFecha;
    exit;
  end;

  iTam:= Length(sFecha);
  // Si no tiene diagonales
  if(Pos('/', sFecha) = 0) then
  begin
    iDia:= 0;
    iMes:= 0;
    iAnio:= 0;
    TryStrToInt(Copy(sFecha, 1, 2), iDia);
    TryStrToInt(Copy(sFecha, 3, 2), iMes);
    TryStrToInt(Copy(sFecha, 5, 4), iAnio);

    if(iTam in [1, 2]) then
      sFecha:= IntToStr(iDia) + FormatDateTime('/mm/yyyy', Now)
    else if(iTam in [3, 4]) then
      sFecha:= IntToStr(iDia) + '/' + IntToStr(iMes) + FormatDateTime('/yyyy', Now)
    else if(iTam in [5..8]) then
      sFecha:= IntToStr(iDia) + '/' + IntToStr(iMes) + '/' + IntToStr(iAnio);
  end;

  // si no es una fecha válida, poner la fecha actual
  if(not TryStrToDate(sFecha, dteFecha)) then
    FFecha:= Date
  else
    FFecha:= dteFecha;
end;

procedure TFecha.SetDate(dteFecha: TDate);
begin
  FFecha:= dteFecha;
  FormatText;
end;

end.