You've already forked lazarus-ccr
16c71930a6
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6941 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1000 lines
30 KiB
ObjectPascal
1000 lines
30 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvValidators.PAS, released on 2003-01-01.
|
|
|
|
The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net] .
|
|
Portions created by Peter Thörnqvist are Copyright (C) 2003 Peter Thörnqvist.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.delphi-jedi.org
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id$
|
|
|
|
unit JvValidators;
|
|
|
|
{.$DEFINE VALIDATORS_DEBUG}
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
// NB: this is here so a user can disable DB support if he wants to
|
|
// NB2: this need not be defined in the design package because GetDataLink is
|
|
// defined differently depending on this define
|
|
{$DEFINE JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
DB,
|
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
SysUtils, Classes, Controls, Forms, {JvComponentBase,} JvErrorIndicator;
|
|
|
|
type
|
|
EValidatorError = class(Exception);
|
|
|
|
// Implemented by classes that can return the value to validate against.
|
|
// The validator classes first check if the ControlToValidate supports this interface
|
|
// and if it does, uses the value returned from GetValidationPropertyValue instead of
|
|
// extracting it from RTTI (using ControlToValidate and PropertyToValidate)
|
|
// The good thing about implementing this interface is that the value to validate do
|
|
// not need to be a published property but can be anything, even a calculated value
|
|
IJvValidationProperty = interface
|
|
['{564FD9F5-BE57-4559-A6AF-B0624C956E50}']
|
|
function GetValidationPropertyValue: Variant;
|
|
function GetValidationPropertyName: WideString;
|
|
end;
|
|
|
|
IJvValidationSummary = interface
|
|
['{F2E4F4E5-E831-4514-93C9-0E2ACA941DCF}']
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
procedure AddError(const ErrorMessage: string);
|
|
procedure RemoveError(const ErrorMessage: string);
|
|
end;
|
|
|
|
TJvBaseValidator = class;
|
|
TJvValidators = class;
|
|
TJvBaseValidatorClass = class of TJvBaseValidator;
|
|
|
|
TJvBaseValidator = class(TComponent)
|
|
private
|
|
FEnabled: Boolean;
|
|
FValid: Boolean;
|
|
FPropertyToValidate: string;
|
|
FErrorMessage: string;
|
|
FGroupName: string;
|
|
FControlToValidate: TControl;
|
|
FErrorControl: TControl;
|
|
FValidator: TJvValidators;
|
|
FOnValidateFailed: TNotifyEvent;
|
|
|
|
procedure SetControlToValidate(Value: TControl);
|
|
procedure SetErrorControl(Value: TControl);
|
|
protected
|
|
function GetValidationPropertyValue: Variant; virtual;
|
|
procedure SetValid(const Value: Boolean); virtual;
|
|
function GetValid: Boolean; virtual;
|
|
procedure DoValidateFailed; dynamic;
|
|
procedure Validate; virtual; abstract;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure SetParentComponent(Value: TComponent); override;
|
|
procedure ReadState(Reader: TReader); override;
|
|
|
|
// get the number of registered base validator classes
|
|
class function BaseValidatorsCount: Integer;
|
|
// get info on a registered class
|
|
class procedure GetBaseValidatorInfo(Index: Integer; out DisplayName: string;
|
|
out ABaseValidatorClass: TJvBaseValidatorClass);
|
|
|
|
public
|
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
// return a TDataLink if the control is a DB control or nil if is not
|
|
function GetDataLink(AControl:TControl):TDataLink; virtual;
|
|
{$ELSE}
|
|
function GetDataLink(AControl:TControl):TObject; virtual;
|
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
// register a new base validator class. DisplayName is used by the design-time editor.
|
|
// A class with an empty DisplayName will not sshow up in the editor
|
|
class procedure RegisterBaseValidator(const DisplayName: string; AValidatorClass: TJvBaseValidatorClass);
|
|
class procedure UnregisterBaseValidator(AValidatorClass: TJvBaseValidatorClass);
|
|
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function GetParentComponent: TComponent; override;
|
|
function HasParent: Boolean; override;
|
|
property Value: Variant read GetValidationPropertyValue;
|
|
published
|
|
property Valid: Boolean read GetValid write SetValid default true;
|
|
// the control that is used to align the error indicator (nil means that the ControlToValidate should be used)
|
|
property ErrorControl: TControl read FErrorControl write SetErrorControl;
|
|
// the control to validate
|
|
property ControlToValidate: TControl read FControlToValidate write SetControlToValidate;
|
|
// the property in ControlToValidate to validate against
|
|
property PropertyToValidate: string read FPropertyToValidate write FPropertyToValidate;
|
|
// make this validator a part of a group so it can be validated separately using Validate(GroupName)
|
|
property GroupName:string read FGroupName write FGroupName;
|
|
property Enabled: Boolean read FEnabled write FEnabled default true;
|
|
// the message to display in case of error
|
|
property ErrorMessage: string read FErrorMessage write FErrorMessage;
|
|
// triggered when Valid is set to False
|
|
property OnValidateFailed: TNotifyEvent read FOnValidateFailed write FOnValidateFailed;
|
|
end;
|
|
|
|
TJvRequiredFieldValidator = class(TJvBaseValidator)
|
|
private
|
|
FAllowBlank: Boolean;
|
|
protected
|
|
procedure Validate; override;
|
|
published
|
|
property AllowBlank: Boolean read FAllowBlank write FAllowBlank default true;
|
|
end;
|
|
|
|
TJvValidateCompareOperator = (vcoLessThan, vcoLessOrEqual, vcoEqual, vcoGreaterOrEqual, vcoGreaterThan, vcoNotEqual);
|
|
|
|
TJvCompareValidator = class(TJvBaseValidator)
|
|
private
|
|
FValueToCompare: Variant;
|
|
FOperator: TJvValidateCompareOperator;
|
|
protected
|
|
procedure Validate; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property ValueToCompare: Variant read FValueToCompare write FValueToCompare;
|
|
property CmpOperator: TJvValidateCompareOperator read FOperator write FOperator default vcoEqual;
|
|
end;
|
|
|
|
TJvRangeValidator = class(TJvBaseValidator)
|
|
private
|
|
FMinimumValue: Variant;
|
|
FMaximumValue: Variant;
|
|
protected
|
|
procedure Validate; override;
|
|
published
|
|
property MinimumValue: Variant read FMinimumValue write FMinimumValue;
|
|
property MaximumValue: Variant read FMaximumValue write FMaximumValue;
|
|
end;
|
|
|
|
TJvRegularExpressionValidator = class(TJvBaseValidator)
|
|
private
|
|
FValidationExpression: string;
|
|
protected
|
|
procedure Validate; override;
|
|
published
|
|
property ValidationExpression: string read FValidationExpression write FValidationExpression;
|
|
end;
|
|
|
|
TJvCustomValidateEvent = procedure(Sender: TObject; ValueToValidate: Variant; var Valid: Boolean) of object;
|
|
|
|
TJvCustomValidator = class(TJvBaseValidator)
|
|
private
|
|
FOnValidate: TJvCustomValidateEvent;
|
|
protected
|
|
function DoValidate: Boolean; virtual;
|
|
procedure Validate; override;
|
|
published
|
|
property OnValidate: TJvCustomValidateEvent read FOnValidate write FOnValidate;
|
|
end;
|
|
|
|
// compares the properties of two controls
|
|
// if CompareToControl implements the IJvValidationProperty interface, the value
|
|
// to compare is taken from GetValidationPropertyValue, otherwise RTTI is used to get the
|
|
// property value
|
|
TJvControlsCompareValidator = class(TJvBaseValidator)
|
|
private
|
|
FCompareToControl: TControl;
|
|
FCompareToProperty: string;
|
|
FOperator: TJvValidateCompareOperator;
|
|
FAllowNull: Boolean;
|
|
procedure SetCompareToControl(const AValue: TControl);
|
|
protected
|
|
procedure Validate; override;
|
|
function GetPropertyValueToCompare: Variant;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
published
|
|
property CompareToControl: TControl read FCompareToControl write SetCompareToControl;
|
|
property CompareToProperty: string read FCompareToProperty write FCompareToProperty;
|
|
property CmpOperator: TJvValidateCompareOperator read FOperator write FOperator default vcoEqual;
|
|
property AllowNull: Boolean read FAllowNull write FAllowNull default True;
|
|
end;
|
|
|
|
TJvValidateFailEvent = procedure(Sender: TObject; BaseValidator: TJvBaseValidator; var Continue: Boolean) of object;
|
|
|
|
TJvValidators = class(TComponent)
|
|
private
|
|
FOnValidateFailed: TJvValidateFailEvent;
|
|
FItems: TList;
|
|
FValidationSummary: IJvValidationSummary;
|
|
FErrorIndicator: IJvErrorIndicator;
|
|
procedure SetValidationSummary(const Value: IJvValidationSummary);
|
|
procedure SetErrorIndicator(const Value: IJvErrorIndicator);
|
|
function GetCount: Integer;
|
|
function GetItem(Index: Integer): TJvBaseValidator;
|
|
protected
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
|
|
function DoValidateFailed(const ABaseValidator: TJvBaseValidator): Boolean; dynamic;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Insert(AValidator: TJvBaseValidator);
|
|
procedure Remove(AValidator: TJvBaseValidator);
|
|
procedure Exchange(Index1, Index2: Integer);
|
|
function Validate: Boolean; overload;
|
|
function Validate(const GroupName:string): Boolean; overload;
|
|
property Items[Index: Integer]: TJvBaseValidator read GetItem; default;
|
|
property Count: Integer read GetCount;
|
|
published
|
|
property ValidationSummary: IJvValidationSummary read FValidationSummary write SetValidationSummary;
|
|
property ErrorIndicator: IJvErrorIndicator read FErrorIndicator write SetErrorIndicator;
|
|
property OnValidateFailed: TJvValidateFailEvent read FOnValidateFailed write FOnValidateFailed;
|
|
end;
|
|
|
|
TJvValidationSummary = class(TComponent, IUnknown, IJvValidationSummary)
|
|
private
|
|
FUpdateCount: Integer;
|
|
FPendingUpdates: Integer;
|
|
FSummaries: TStringList;
|
|
FOnChange: TNotifyEvent;
|
|
FOnRemoveError: TNotifyEvent;
|
|
FOnAddError: TNotifyEvent;
|
|
function GetSummaries: TStrings;
|
|
protected
|
|
{ IJvValidationSummary }
|
|
procedure AddError(const ErrorMessage: string);
|
|
procedure RemoveError(const ErrorMessage: string);
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
|
|
procedure Change; virtual;
|
|
public
|
|
destructor Destroy; override;
|
|
property Summaries: TStrings read GetSummaries;
|
|
published
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnAddError: TNotifyEvent read FOnAddError write FOnAddError;
|
|
property OnRemoveError: TNotifyEvent read FOnRemoveError write FOnRemoveError;
|
|
end;
|
|
|
|
const
|
|
cValidatorsDBValue = '(DBValue)';
|
|
|
|
implementation
|
|
|
|
uses
|
|
LazLogger,
|
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
DBCtrls,
|
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
Masks,
|
|
Variants,
|
|
TypInfo,
|
|
// JclUnicode, // for reg exp support
|
|
{JvTypes,} JvResources, JvJVCLUtils;
|
|
|
|
var
|
|
GlobalValidatorsList: TStringList = nil;
|
|
|
|
procedure RegisterBaseValidators; forward;
|
|
|
|
function ValidatorsList: TStringList;
|
|
begin
|
|
if not Assigned(GlobalValidatorsList) then
|
|
begin
|
|
GlobalValidatorsList := TStringList.Create;
|
|
// register
|
|
//RegisterBaseValidators; is registered in initialization
|
|
end;
|
|
Result := GlobalValidatorsList;
|
|
end;
|
|
|
|
procedure Debug(const {%H-}Msg: string); overload;
|
|
begin
|
|
{$IFDEF VALIDATORS_DEBUG}
|
|
DebugLn(Msg);
|
|
//Application.MessageBox(PChar(Msg),PChar('Debug'),MB_OK or MB_TASKMODAL)
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure Debug(const Msg: string; const Fmt: array of const); overload;
|
|
begin
|
|
Debug(Format(Msg, Fmt));
|
|
end;
|
|
|
|
function ComponentName(Comp: TComponent): string;
|
|
begin
|
|
if Comp = nil then
|
|
Result := 'nil'
|
|
else
|
|
if Comp.Name <> '' then
|
|
Result := Comp.Name
|
|
else
|
|
Result := Comp.ClassName;
|
|
end;
|
|
|
|
//=== { TJvBaseValidator } ===================================================
|
|
|
|
constructor TJvBaseValidator.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FValid := True;
|
|
FEnabled := True;
|
|
end;
|
|
|
|
destructor TJvBaseValidator.Destroy;
|
|
begin
|
|
Debug('TJvBaseValidator.Destroy: FValidator is %s', [ComponentName(FValidator)]);
|
|
ErrorControl := nil;
|
|
ControlToValidate := nil;
|
|
if FValidator <> nil then
|
|
begin
|
|
FValidator.Remove(Self);
|
|
FValidator := nil;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
class procedure TJvBaseValidator.RegisterBaseValidator(const DisplayName: string; AValidatorClass:
|
|
TJvBaseValidatorClass);
|
|
begin
|
|
if ValidatorsList.IndexOfObject(TObject(Pointer(AValidatorClass))) < 0 then
|
|
begin
|
|
Classes.RegisterClass(TPersistentClass(AValidatorClass));
|
|
ValidatorsList.AddObject(DisplayName, TObject(Pointer(AValidatorClass)));
|
|
end;
|
|
end;
|
|
|
|
class procedure TJvBaseValidator.UnregisterBaseValidator(AValidatorClass: TJvBaseValidatorClass);
|
|
var
|
|
ClassIndex: Integer;
|
|
begin
|
|
ClassIndex := ValidatorsList.IndexOfObject(TObject(Pointer(AValidatorClass)));
|
|
if ClassIndex >= 0 then
|
|
begin
|
|
Classes.UnregisterClass(TPersistentClass(AValidatorClass));
|
|
ValidatorsList.Delete(ClassIndex);
|
|
end;
|
|
end;
|
|
|
|
class function TJvBaseValidator.BaseValidatorsCount: Integer;
|
|
begin
|
|
Result := ValidatorsList.Count;
|
|
end;
|
|
|
|
class procedure TJvBaseValidator.GetBaseValidatorInfo(Index: Integer;
|
|
out DisplayName: string; out ABaseValidatorClass: TJvBaseValidatorClass);
|
|
begin
|
|
if (Index < 0) or (Index >= ValidatorsList.Count) then
|
|
raise Exception.CreateFmt(RsEInvalidIndexd, [Index]);
|
|
DisplayName := ValidatorsList[Index];
|
|
ABaseValidatorClass := TJvBaseValidatorClass(ValidatorsList.Objects[Index]);
|
|
end;
|
|
|
|
function TJvBaseValidator.GetValid: Boolean;
|
|
begin
|
|
Result := FValid;
|
|
end;
|
|
|
|
function TJvBaseValidator.GetParentComponent: TComponent;
|
|
begin
|
|
Debug('TJvBaseValidator.GetParentComponent: Parent is %s', [ComponentName(FValidator)]);
|
|
Result := FValidator;
|
|
end;
|
|
|
|
function TJvBaseValidator.GetValidationPropertyValue: Variant;
|
|
var
|
|
ValProp: IJvValidationProperty;
|
|
PropInfo: PPropInfo;
|
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
DataLink:TDataLink;
|
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
begin
|
|
Result := Null;
|
|
if FControlToValidate <> nil then
|
|
begin
|
|
if Supports(FControlToValidate, IJvValidationProperty, ValProp) then
|
|
Result := ValProp.GetValidationPropertyValue
|
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
else if AnsiSameText(FPropertyToValidate,cValidatorsDBValue) then
|
|
begin
|
|
DataLink := GetDataLink(FControlToValidate);
|
|
if (DataLink is TFieldDataLink) and (TFieldDataLink(DataLink).Field <> nil) then
|
|
Result := TFieldDataLink(DataLink).Field.DisplayText;
|
|
end
|
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
else if FPropertyToValidate <> '' then
|
|
begin
|
|
PropInfo := GetPropInfo(FControlToValidate, FPropertyToValidate);
|
|
if (PropInfo <> nil) and (PropInfo^.GetProc <> nil) then
|
|
begin
|
|
Result := GetPropValue(FControlToValidate, FPropertyToValidate, False);
|
|
if (PropInfo^.PropType = TypeInfo(TDateTime)) or
|
|
(PropInfo^.PropType = TypeInfo(TDate)) or
|
|
(PropInfo^.PropType = TypeInfo(TTime)) then
|
|
Result := VarAsType(Result, varDate);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TJvBaseValidator.HasParent: Boolean;
|
|
begin
|
|
Debug('TJvBaseValidator.HasParent');
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TJvBaseValidator.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
begin
|
|
if AComponent = ControlToValidate then
|
|
ControlToValidate := nil;
|
|
if AComponent = ErrorControl then
|
|
ErrorControl := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBaseValidator.SetValid(const Value: Boolean);
|
|
begin
|
|
FValid := Value;
|
|
if not FValid then
|
|
DoValidateFailed;
|
|
end;
|
|
|
|
procedure TJvBaseValidator.SetControlToValidate(Value: TControl);
|
|
var
|
|
Obj: IJvValidationProperty;
|
|
begin
|
|
if ReplaceComponentReference(Self, Value, TComponent(FControlToValidate)) then
|
|
if FControlToValidate <> nil then
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
if Supports(FControlToValidate, IJvValidationProperty, Obj) then
|
|
PropertyToValidate := UTF8Encode(Obj.GetValidationPropertyName)
|
|
else
|
|
PropertyToValidate := '';
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBaseValidator.SetErrorControl(Value: TControl);
|
|
begin
|
|
ReplaceComponentReference(Self, Value, TComponent(FErrorControl));
|
|
end;
|
|
|
|
procedure TJvBaseValidator.SetParentComponent(Value: TComponent);
|
|
begin
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
Debug('TJvBaseValidator.SetParentComponent: Parent is %s, changing to %s',
|
|
[ComponentName(FValidator), ComponentName(Value)]);
|
|
if FValidator <> nil then
|
|
begin
|
|
Debug('FValidator.Remove');
|
|
FValidator.Remove(Self);
|
|
end;
|
|
if (Value <> nil) and (Value is TJvValidators) then
|
|
begin
|
|
Debug('FValidator.Insert');
|
|
TJvValidators(Value).Insert(Self);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBaseValidator.ReadState(Reader: TReader);
|
|
begin
|
|
inherited ReadState(Reader);
|
|
Debug('TJvBaseValidator.ReadState: Reader.Parent is %s', [ComponentName(Reader.Parent)]);
|
|
if Reader.Parent is TJvValidators then
|
|
begin
|
|
if FValidator <> nil then
|
|
FValidator.Remove(Self);
|
|
FValidator := TJvValidators(Reader.Parent);
|
|
FValidator.Insert(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBaseValidator.DoValidateFailed;
|
|
begin
|
|
if Assigned(FOnValidateFailed) then
|
|
FOnValidateFailed(Self);
|
|
end;
|
|
|
|
{$IFDEF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
function TJvBaseValidator.GetDataLink(AControl:TControl): TDataLink;
|
|
begin
|
|
if AControl <> nil then
|
|
Result := TDataLink(AControl.Perform(CM_GETDATALINK, 0, 0))
|
|
else
|
|
Result := nil;
|
|
end;
|
|
{$ELSE}
|
|
function TJvBaseValidator.GetDataLink(AControl:TControl):TObject;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
{$ENDIF JVVALIDATORS_SUPPORTS_DBCONTROLS}
|
|
|
|
|
|
//=== { TJvRequiredFieldValidator } ==========================================
|
|
|
|
procedure TJvRequiredFieldValidator.Validate;
|
|
var
|
|
R: Variant;
|
|
begin
|
|
R := GetValidationPropertyValue;
|
|
case VarType(R) of
|
|
varDate:
|
|
Valid := VarCompareValue(R, 0) <> vrEqual; // zero is the invalid value for dates
|
|
varSmallint,
|
|
varInteger,
|
|
varSingle,
|
|
varDouble,
|
|
varCurrency,
|
|
varBoolean,
|
|
varByte:
|
|
; // nothing to do because all values are valid
|
|
else
|
|
if FAllowBlank then
|
|
Valid := VarCompareValue(R, '') <> vrEqual
|
|
else
|
|
Valid := Trim(VarToStr(R)) <> '';
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvCustomValidator } =================================================
|
|
|
|
function TJvCustomValidator.DoValidate: Boolean;
|
|
begin
|
|
Result := Valid;
|
|
if Assigned(FOnValidate) then
|
|
FOnValidate(Self, GetValidationPropertyValue, Result);
|
|
end;
|
|
|
|
procedure TJvCustomValidator.Validate;
|
|
begin
|
|
Valid := DoValidate;
|
|
end;
|
|
|
|
//=== { TJvRegularExpressionValidator } ======================================
|
|
|
|
function MatchesMask(const Filename, Mask: string{;
|
|
const SearchFlags: TSearchFlags = [sfCaseSensitive]}): Boolean;
|
|
{var
|
|
URE: TURESearch;
|
|
SL: TWideStringList;}
|
|
begin
|
|
Result := Masks.MatchesMask(Filename, Mask);
|
|
(*
|
|
// use the regexp engine in JclUnicode
|
|
SL := TWideStringList.Create;
|
|
try
|
|
URE := TURESearch.Create(SL);
|
|
try
|
|
URE.FindPrepare(Mask, SearchFlags);
|
|
// this could be overkill for long strings and many matches,
|
|
// but it's a lot simpler than calling FindFirst...
|
|
Result := URE.FindAll(Filename);
|
|
finally
|
|
URE.Free;
|
|
end;
|
|
finally
|
|
SL.Free;
|
|
end;
|
|
*)
|
|
end;
|
|
|
|
procedure TJvRegularExpressionValidator.Validate;
|
|
var
|
|
R: string;
|
|
begin
|
|
R := VarToStr(GetValidationPropertyValue);
|
|
Valid := (R = ValidationExpression) or MatchesMask(R, ValidationExpression);
|
|
end;
|
|
|
|
//=== { TJvCompareValidator } ================================================
|
|
|
|
constructor TJvCompareValidator.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FOperator := vcoEqual;
|
|
end;
|
|
|
|
procedure TJvCompareValidator.Validate;
|
|
var
|
|
VR: TVariantRelationship;
|
|
begin
|
|
VR := VarCompareValue(GetValidationPropertyValue, ValueToCompare);
|
|
case CmpOperator of
|
|
vcoLessThan:
|
|
Valid := VR = vrLessThan;
|
|
vcoLessOrEqual:
|
|
Valid := (VR = vrLessThan) or (VR = vrEqual);
|
|
vcoEqual:
|
|
Valid := (VR = vrEqual);
|
|
vcoGreaterOrEqual:
|
|
Valid := (VR = vrGreaterThan) or (VR = vrEqual);
|
|
vcoGreaterThan:
|
|
Valid := (VR = vrGreaterThan);
|
|
vcoNotEqual:
|
|
Valid := VR <> vrEqual;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvRangeValidator } ==================================================
|
|
|
|
procedure TJvRangeValidator.Validate;
|
|
var
|
|
VR: TVariantRelationship;
|
|
begin
|
|
VR := VarCompareValue(GetValidationPropertyValue, MinimumValue);
|
|
Valid := (VR = vrGreaterThan) or (VR = vrEqual);
|
|
if Valid then
|
|
begin
|
|
VR := VarCompareValue(GetValidationPropertyValue, MaximumValue);
|
|
Valid := (VR = vrLessThan) or (VR = vrEqual);
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvControlsCompareValidator } ========================================
|
|
|
|
constructor TJvControlsCompareValidator.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FAllowNull := True;
|
|
FOperator := vcoEqual;
|
|
end;
|
|
|
|
function TJvControlsCompareValidator.GetPropertyValueToCompare: Variant;
|
|
var
|
|
ValProp: IJvValidationProperty;
|
|
PropInfo: PPropInfo;
|
|
begin
|
|
Result := Null;
|
|
if FCompareToControl <> nil then
|
|
begin
|
|
if Supports(FCompareToControl, IJvValidationProperty, ValProp) then
|
|
Result := ValProp.GetValidationPropertyValue
|
|
else
|
|
if FCompareToProperty <> '' then
|
|
begin
|
|
PropInfo := GetPropInfo(FCompareToControl, FCompareToProperty);
|
|
if (PropInfo <> nil) and (PropInfo^.GetProc <> nil) then
|
|
Result := GetPropValue(FCompareToControl, FCompareToProperty, False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvControlsCompareValidator.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = CompareToControl) then
|
|
CompareToControl := nil;
|
|
end;
|
|
|
|
procedure TJvControlsCompareValidator.SetCompareToControl(const AValue: TControl);
|
|
var
|
|
Obj: IJvValidationProperty;
|
|
begin
|
|
if ReplaceComponentReference(Self, AValue, TComponent(FCompareToControl)) then
|
|
if FCompareToControl <> nil then
|
|
begin
|
|
if not (csLoading in ComponentState) then
|
|
begin
|
|
if Supports(FCompareToControl, IJvValidationProperty, Obj) then
|
|
CompareToProperty := UTF8Encode(Obj.GetValidationPropertyName)
|
|
else
|
|
CompareToProperty := '';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvControlsCompareValidator.Validate;
|
|
var
|
|
Val1, Val2: Variant;
|
|
VR: TVariantRelationship;
|
|
begin
|
|
Val1 := GetValidationPropertyValue;
|
|
Val2 := GetPropertyValueToCompare;
|
|
if not AllowNull and
|
|
((TVarData(Val1).VType in [varEmpty, varNull]) or (TVarData(Val2).VType in [varEmpty, varNull])) then
|
|
begin
|
|
Valid := False;
|
|
Exit;
|
|
end;
|
|
VR := VarCompareValue(Val1, Val2);
|
|
case CmpOperator of
|
|
vcoLessThan:
|
|
Valid := VR = vrLessThan;
|
|
vcoLessOrEqual:
|
|
Valid := (VR = vrLessThan) or (VR = vrEqual);
|
|
vcoEqual:
|
|
Valid := (VR = vrEqual);
|
|
vcoGreaterOrEqual:
|
|
Valid := (VR = vrGreaterThan) or (VR = vrEqual);
|
|
vcoGreaterThan:
|
|
Valid := (VR = vrGreaterThan);
|
|
vcoNotEqual:
|
|
Valid := (VR <> vrEqual);
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvValidators } ======================================================
|
|
|
|
constructor TJvValidators.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
destructor TJvValidators.Destroy;
|
|
var
|
|
V: TJvBaseValidator;
|
|
begin
|
|
Debug('TJvValidators.Destroy: Count is %d', [FItems.Count]);
|
|
while FItems.Count > 0 do
|
|
begin
|
|
V := TJvBaseValidator(FItems.Last);
|
|
V.FValidator := nil;
|
|
V.Free;
|
|
FItems.Delete(FItems.Count - 1);
|
|
end;
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJvValidators.DoValidateFailed(const ABaseValidator: TJvBaseValidator): Boolean;
|
|
begin
|
|
Result := True;
|
|
if Assigned(FOnValidateFailed) then
|
|
FOnValidateFailed(Self, ABaseValidator, Result);
|
|
end;
|
|
|
|
function TJvValidators.Validate(const GroupName:string): Boolean;
|
|
var
|
|
I: Integer;
|
|
Controls: TList;
|
|
ErrCtrl: TControl;
|
|
begin
|
|
Result := True;
|
|
if ValidationSummary <> nil then
|
|
FValidationSummary.BeginUpdate;
|
|
try
|
|
Controls := TList.Create;
|
|
if FErrorIndicator <> nil then
|
|
FErrorIndicator.BeginUpdate;
|
|
try
|
|
{ Get all controls that should be validated }
|
|
if FErrorIndicator <> nil then
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
ErrCtrl := Items[i].ErrorControl;
|
|
if ErrCtrl = nil then
|
|
ErrCtrl := Items[i].ControlToValidate;
|
|
if ErrCtrl <> nil then
|
|
if Controls.IndexOf(ErrCtrl) = -1 then
|
|
Controls.Add(ErrCtrl);
|
|
end;
|
|
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
if Items[I].Enabled and ((Items[I].GroupName = '') or AnsiSameText(GroupName, Items[I].GroupName)) then
|
|
begin
|
|
Items[I].Validate;
|
|
if not Items[I].Valid then
|
|
begin
|
|
if (Items[I].ErrorMessage <> '') and (Items[I].ControlToValidate <> nil) then
|
|
begin
|
|
ErrCtrl := Items[I].ErrorControl;
|
|
if ErrCtrl = nil then
|
|
ErrCtrl := Items[i].ControlToValidate;
|
|
|
|
if ValidationSummary <> nil then
|
|
FValidationSummary.AddError(Items[I].ErrorMessage);
|
|
if ErrorIndicator <> nil then
|
|
FErrorIndicator.SetError(ErrCtrl, UTF8Decode(Items[I].ErrorMessage));
|
|
if FErrorIndicator <> nil then
|
|
Controls.Remove(ErrCtrl); { control is not valid }
|
|
end;
|
|
Result := False;
|
|
if not DoValidateFailed(Items[I]) then
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
{ Clear ErrorIndicators for controls that are valid }
|
|
if FErrorIndicator <> nil then
|
|
for I := 0 to Controls.Count - 1 do
|
|
FErrorIndicator.SetError(TControl(Controls[I]), ''); // clear error indicator
|
|
finally
|
|
if FErrorIndicator <> nil then
|
|
FErrorIndicator.EndUpdate;
|
|
Controls.Free;
|
|
end;
|
|
finally
|
|
if ValidationSummary <> nil then
|
|
FValidationSummary.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TJvValidators.Validate: Boolean;
|
|
begin
|
|
Result := Validate('');
|
|
end;
|
|
|
|
procedure TJvValidators.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
begin
|
|
if Assigned(ValidationSummary) and AComponent.IsImplementorOf(ValidationSummary) then
|
|
ValidationSummary := nil;
|
|
if Assigned(ErrorIndicator) and AComponent.IsImplementorOf(ErrorIndicator) then
|
|
ErrorIndicator := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidators.GetChildren(Proc: TGetChildProc; Root: TComponent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Debug('TJvValidators.GetChildren: Count is %d, Root is %s', [Count, ComponentName(Root)]);
|
|
for I := 0 to Count - 1 do
|
|
Proc(Items[I]);
|
|
end;
|
|
|
|
procedure TJvValidators.SetValidationSummary(const Value: IJvValidationSummary);
|
|
begin
|
|
ReferenceInterface(FValidationSummary, opRemove);
|
|
FValidationSummary := Value;
|
|
ReferenceInterface(FValidationSummary, opInsert);
|
|
end;
|
|
|
|
procedure TJvValidators.Insert(AValidator: TJvBaseValidator);
|
|
begin
|
|
Debug('TJvValidators.Insert: inserting %s', [ComponentName(AValidator)]);
|
|
Assert(AValidator <> nil, RsEInsertNilValidator);
|
|
AValidator.FValidator := Self;
|
|
if FItems.IndexOf(AValidator) < 0 then
|
|
FItems.Add(AValidator);
|
|
end;
|
|
|
|
procedure TJvValidators.Remove(AValidator: TJvBaseValidator);
|
|
begin
|
|
Debug('TJvValidators.Remove: removing %s', [ComponentName(AValidator)]);
|
|
Assert(AValidator <> nil, RsERemoveNilValidator);
|
|
Assert(AValidator.FValidator = Self, RsEValidatorNotChild);
|
|
AValidator.FValidator := nil;
|
|
FItems.Remove(AValidator);
|
|
end;
|
|
|
|
function TJvValidators.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TJvValidators.GetItem(Index: Integer): TJvBaseValidator;
|
|
begin
|
|
Result := TJvBaseValidator(FItems[Index]);
|
|
end;
|
|
|
|
procedure TJvValidators.Exchange(Index1, Index2: Integer);
|
|
begin
|
|
FItems.Exchange(Index1, Index2);
|
|
end;
|
|
|
|
procedure TJvValidators.SetErrorIndicator(const Value: IJvErrorIndicator);
|
|
begin
|
|
ReferenceInterface(FErrorIndicator, opRemove);
|
|
FErrorIndicator := Value;
|
|
ReferenceInterface(FErrorIndicator, opInsert);
|
|
end;
|
|
|
|
//=== { TJvValidationSummary } ===============================================
|
|
|
|
destructor TJvValidationSummary.Destroy;
|
|
begin
|
|
FSummaries.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvValidationSummary.AddError(const ErrorMessage: string);
|
|
begin
|
|
if Summaries.IndexOf(ErrorMessage) < 0 then
|
|
begin
|
|
Summaries.Add(ErrorMessage);
|
|
if (FUpdateCount = 0) and Assigned(FOnAddError) then
|
|
FOnAddError(Self);
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvValidationSummary.RemoveError(const ErrorMessage: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := Summaries.IndexOf(ErrorMessage);
|
|
if I > -1 then
|
|
begin
|
|
Summaries.Delete(I);
|
|
if (FUpdateCount = 0) and Assigned(FOnRemoveError) then
|
|
FOnRemoveError(Self);
|
|
Change;
|
|
end;
|
|
end;
|
|
|
|
function TJvValidationSummary.GetSummaries: TStrings;
|
|
begin
|
|
if FSummaries = nil then
|
|
FSummaries := TStringList.Create;
|
|
Result := FSummaries;
|
|
end;
|
|
|
|
procedure TJvValidationSummary.Change;
|
|
begin
|
|
if FUpdateCount <> 0 then
|
|
begin
|
|
Inc(FPendingUpdates);
|
|
Exit;
|
|
end;
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
procedure TJvValidationSummary.BeginUpdate;
|
|
begin
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TJvValidationSummary.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount < 0 then
|
|
FUpdateCount := 0;
|
|
if (FUpdateCount = 0) and (FPendingUpdates > 0) then
|
|
begin
|
|
Change;
|
|
FPendingUpdates := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure RegisterBaseValidators;
|
|
begin
|
|
TJvBaseValidator.RegisterBaseValidator('Required Field Validator', TJvRequiredFieldValidator);
|
|
TJvBaseValidator.RegisterBaseValidator('Compare Validator', TJvCompareValidator);
|
|
TJvBaseValidator.RegisterBaseValidator('Range Validator', TJvRangeValidator);
|
|
TJvBaseValidator.RegisterBaseValidator('Regular Expression Validator', TJvRegularExpressionValidator);
|
|
TJvBaseValidator.RegisterBaseValidator('Custom Validator', TJvCustomValidator);
|
|
TJvBaseValidator.RegisterBaseValidator('Controls Compare Validator', TJvControlsCompareValidator);
|
|
end;
|
|
|
|
|
|
initialization
|
|
// (p3) do NOT touch! This is required to make the registration work on formulars!!!
|
|
RegisterBaseValidators;
|
|
|
|
finalization
|
|
FreeAndNil(GlobalValidatorsList);
|
|
|
|
end.
|