Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment