Mega Code Archive
TEDIT with Validate,Nextcontrol,Priorcontrol and Char validation
<![CDATA[
Title: TEDIT with Validate,Nextcontrol,Priorcontrol and Char validation
Question: This is a simple component that demonstrates how to stop a control from exiting if a validation routine fails. Also the next and prior controls can be set, this forces focus to the next control if the user clicks on some other control ("tab order" doesn't help when a user does this). There is also support for what characters may be typed in the edit box.
Answer:
unit Validate;
interface
// ==================================================================
// TValEdit
// Mike Heydon Oct 2000
//
// Descendant of TEdit that disallows field exit if validation
// routine fails. Allows for setting of Next and Prior controls
// to allow correct field tab dependenct order. Control over
// what chars may be type in the edit box.
//
// =================================================================
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TValidateProc = procedure(Sender : TObject;
var ValueOk : boolean) of object;
TValidateChar = (chAllChars,chAlpha,chDigit,
chBlank,chSign,chDecimalPoint);
TValidateCSet = set of TValidateChar;
TValidateASet = set of char;
TValEdit = class(TEdit)
private
FExcludeChars : TValidateASet;
FValidChars : TValidateCSet;
FErrorMessage : string;
FAutoErrors : boolean;
FOnValidateErr : TNotifyEvent;
FOnValidate : TValidateProc;
FNextControl,
FPriorControl : TWinControl;
procedure SetFValidChars(NewValue : TValidateCSet);
protected
procedure DoExit; override;
procedure KeyPress(var Key: Char); override;
public
constructor Create(AOwner : TComponent); override;
property ExcludeChars : TValidateASet read FExcludeChars
write FExcludeChars;
published
property NextControl : TWinControl read FNextControl
write FNextControl;
property PriorControl : TWinControl read FPriorControl
write FPriorControl;
property AutoErrors : boolean read FAutoErrors write FAutoErrors;
property ErrorMessage : string read FErrorMessage
write FErrorMessage;
property CharsValid : TValidateCSet read FValidChars
write SetFValidChars;
property OnValidate : TValidateProc read FOnValidate
write FOnValidate;
property OnValidateError : TNotifyEvent read FOnValidateErr
write FOnValidateErr;
end;
procedure Register;
// ----------------------------------------------------------------
implementation
// ==========================
// TValEdit
// ==========================
constructor TValEdit.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FValidChars := [chAllChars,chAlpha,chDigit,chBlank,
chSign,chDecimalPoint];
FExcludeChars := [];
FNextControl := nil;
FPriorControl := nil;
FErrorMessage := '';
FAutoErrors := true;
end;
// =============================================================
// Intercept the OnExit event and prevent if validation fails.
// If validation is ok, then NextControl is given focus.
// =============================================================
procedure TValEdit.DoExit;
var ValueOk : boolean;
procedure CheckNextControl;
begin
inherited DoExit;
if Assigned(FPriorControl) and
(FPriorControl = Screen.ActiveControl) then begin
try FPriorControl.SetFocus; except end;
end
else
if Assigned(FNextControl) then
try FNextControl.SetFocus; except end;
end;
begin
// Has user set OnValidate event ?
if Assigned(FOnValidate) then begin
ValueOk := true;
FOnValidate(self,ValueOk);
if ValueOk then
CheckNextControl
else begin
// Generate any errors and set focus back to self
if FAutoErrors then MessageDlg(FErrorMessage,
mtError,[mbOk],0);
if Assigned(FOnValidateErr) then FOnValidateErr(self);
Self.SetFocus;
end;
end
else
CheckNextControl;
end;
// =======================================================
// Intercept key press and allow/disallow chars
// as set by properties CharsValid and ExcludeChars
// =======================================================
procedure TValEdit.KeyPress(var Key: Char);
begin
// Check Valid Characters
if not (chAllChars in FValidChars) and
(Key in [#32..#126]) then begin
if (UpCase(Key) in ['A'..'Z']) and
not (chAlpha in FValidChars) then Key := #0;
if (Key in ['0'..'9']) and
not (chDigit in FValidChars) then Key := #0;
if (Key = ' ') and
not (chBlank in FValidChars) then Key := #0;
if (Key in ['+','-']) and
not (chSign in FValidChars) then Key := #0;
if (Key = '.') and
not (chDecimalPoint in FValidChars) then Key := #0;
if not (UpCase(Key) in ['A'..'Z','0'..'9',' ','+','-','.'])
then Key := #0;
end;
// Check any additional keys excluded
if FExcludeChars [] then begin
if (Key in FExcludeChars) then Key := #0;
end;
inherited KeyPress(Key);
end;
// =============================================================
// Property CharsValid SET routine. If chAllChars then we
// may as well set all to true
// =============================================================
procedure TValEdit.SetFValidChars(NewValue : TValidateCSet);
begin
FValidChars := NewValue;
if chAllChars in FValidChars then
FValidChars := [chAllChars,chAlpha,chDigit,chBlank,
chSign,chDecimalPoint];
end;
// -------------------------------------------------------------
procedure Register;
begin
RegisterComponents('Win95', [TValEdit]);
end;
end.
]]>