http://www.devsuperpage.com/search/Articles.asp?ArtID=857874

ValidatableEdits.pas

unit ValidatableEdits;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TCharSet = Set of Char;

  TBaseValidatableEdit = class(Tedit)
  private
    { Private declarations }
    FLastContent: String;
    FLastPosition: Integer;
    FAllowedChars: TCharset;

    Procedure SetAllowedChars; virtual; abstract;
  protected
    { Protected declarations }
    Procedure SaveState;
    Procedure RestoreState;
    Function IsValidChar( ch: Char ): Boolean; virtual;
    Function Validate: Boolean; virtual; abstract;

    Procedure WndProc( Var msg: TMessage ); override;

    property AllowedChars: TCharset read FAllowedChars write FAllowedChars;
    property LastContent: String read FLastContent;
    property LastPosition: Integer read FLastPosition;
  public
    { Public declarations }
    Constructor Create( aOwner: TComponent ); override;
  end;

  TIntegerEdit = Class( TBaseValidatableEdit )
  private
    Procedure SetAllowedChars; override;
    function GetAllowNegative: Boolean;
    procedure SetAllowNegative(const Value: Boolean);
  protected
    Function Validate: Boolean; override;
  published
    { Published declarations }
    property AllowNegative: Boolean
      read GetAllowNegative write SetAllowNegative default True;
  end;

  TFloatEdit = Class( TIntegeredit )
  private
    Procedure SetAllowedChars; override;
  protected
    Function Validate: Boolean; override;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PBGoodies', [TIntegerEdit, TFloatEdit]);
end;

{ TBaseValidatableEdit }

constructor TBaseValidatableEdit.Create(aOwner: TComponent);
begin
  inherited;
  ControlStyle := Controlstyle - [csSetCaption];
  SetAllowedChars;
end;


function TBaseValidatableEdit.IsValidChar(ch: Char): Boolean;
begin
  Result := ch In FAllowedChars;
end;

procedure TBaseValidatableEdit.RestoreState;
begin
  Text := FLastContent;
  SelStart := FLastPosition;
end;

procedure TBaseValidatableEdit.SaveState;
begin
  FLastContent := Text;
  FLastPosition := SelStart;
end;

procedure TBaseValidatableEdit.WndProc(var msg: TMessage);
begin
  Case msg.msg of
    WM_CHAR: Begin
        If IsValidChar( Chr( msg.wparam )) Then Begin
          SaveState;
          inherited;
          If not Validate Then
            RestoreState;
        End { If }
        Else
          If msg.wparam < 32 Then
            { Pass on control characters or Ctrl-C, Ctrl-V, Ctrl-X stop to 
work }
            inherited; 
      End; { Case WM_CHAR }
    WM_PASTE: Begin
        SaveState;
        inherited;
        If not Validate Then
          RestoreState;
      End; { WM_PASTE }
  Else
    inherited;
  End; { Case }
end;

{ TIntegeredit }

function TIntegerEdit.GetAllowNegative: Boolean;
begin
  Result := IsValidChar( '-' );
end;

procedure TIntegerEdit.SetAllowedChars;
begin
  AllowedChars := ['0'..'9','-',#8];
end;

procedure TIntegerEdit.SetAllowNegative(const Value: Boolean);
begin
  If Value Then
    Include( FAllowedChars, '-' )
  Else
    Exclude( FAllowedChars, '-' );
end;

{$HINTS OFF}{ Hide hint for "i not used" in method below. }
function TIntegerEdit.Validate: Boolean;
var
  err, i: Integer;
begin
  Val( Text, i, err );
  Result := (err = 0) or (GetTextLen = 0) or (Text = '-');
end;
{$HINTS ON}

{ TFloatEdit }

procedure TFloatEdit.SetAllowedChars;
begin
  inherited;
  AllowedChars := AllowedChars + [DecimalSeparator];
end;

function TFloatEdit.Validate: Boolean;
begin
  try
    StrToFloat( text );
    Result := true;
  except
    Result := (GetTextLen = 0) or (Text = '-');
  end;
end;

end.