{-----------------------------------------------------------------------------
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.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvValidators.pas 11210 2007-03-15 18:40:05Z peter3 $

unit JvValidators;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, SysUtils, Classes, Controls, Forms,
  JvComponentBase, JvErrorIndicator, JvVCL5Utils;

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(TJvComponent)
  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; var DisplayName: string;
      var ABaseValidatorClass: TJvBaseValidatorClass);
  public
    // 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);

    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;
    // 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;
    // 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)
  protected
    procedure Validate; override;
  end;

  TJvValidateCompareOperator = (vcoLessThan, vcoLessOrEqual, vcoEqual, vcoGreaterOrEqual, vcoGreaterThan, vcoNotEqual);

  TJvCompareValidator = class(TJvBaseValidator)
  private
    FValueToCompare: Variant;
    FOperator: TJvValidateCompareOperator;
  protected
    procedure Validate; override;
  published
    property ValueToCompare: Variant read FValueToCompare write FValueToCompare;
    property Operator: TJvValidateCompareOperator read FOperator write FOperator;
  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;
  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 FCompareToControl;
    property CompareToProperty: string read FCompareToProperty write FCompareToProperty;
    property Operator: TJvValidateCompareOperator read FOperator write FOperator;
    property AllowNull: Boolean read FAllowNull write FAllowNull default True;
  end;

  TJvValidateFailEvent = procedure(Sender: TObject; BaseValidator: TJvBaseValidator; var Continue: Boolean) of object;

  TJvValidators = class(TJvComponent)
  private
    FOnValidateFailed: TJvValidateFailEvent;
    FItems: TList;
    FValidationSummary: IJvValidationSummary;
    FErrorIndicator: IJvErrorIndicator;
    {$IFNDEF COMPILER6_UP}
    FValidationSummaryComponent: TComponent;
    FErrorIndicatorComponent: TComponent;
    procedure SetValidationSummaryComponent(Value: TComponent);
    procedure SetErrorIndicatorComponent(Value: TComponent);
    {$ENDIF COMPILER6_UP}
    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
    {$IFDEF COMPILER6_UP}
    property ValidationSummary: IJvValidationSummary read FValidationSummary write SetValidationSummary;
    property ErrorIndicator: IJvErrorIndicator read FErrorIndicator write SetErrorIndicator;
    {$ELSE}
    property ValidationSummary: TComponent read FValidationSummaryComponent write SetValidationSummaryComponent;
    property ErrorIndicator: TComponent read FErrorIndicatorComponent write SetErrorIndicatorComponent;
    {$ENDIF COMPILER6_UP}
    property OnValidateFailed: TJvValidateFailEvent read FOnValidateFailed write FOnValidateFailed;
  end;

  TJvValidationSummary = class(TJvComponent, 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;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvValidators.pas $';
    Revision: '$Revision: 11210 $';
    Date: '$Date: 2007-03-15 19:40:05 +0100 (jeu., 15 mars 2007) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
implementation

uses
  Masks,
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}           
  TypInfo,
  {$IFDEF VCL}
//  JclUnicode, // for reg exp support
  {$ENDIF VCL}
  JclWideStrings,
  JvTypes, JvResources;

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 Msg: string); overload;
begin
//  Application.MessageBox(PChar(Msg),PChar('Debug'),MB_OK or MB_TASKMODAL)
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(Pointer(AValidatorClass)) < 0 then
  begin
    Classes.RegisterClass(TPersistentClass(AValidatorClass));
    ValidatorsList.AddObject(DisplayName, Pointer(AValidatorClass));
  end;
end;

class function TJvBaseValidator.BaseValidatorsCount: Integer;
begin
  Result := ValidatorsList.Count;
end;

class procedure TJvBaseValidator.GetBaseValidatorInfo(Index: Integer;
  var DisplayName: string; var ABaseValidatorClass: TJvBaseValidatorClass);
begin
  if (Index < 0) or (Index >= ValidatorsList.Count) then
    raise EJVCLException.CreateResFmt(@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;
begin
  Result := Null;
  if FControlToValidate <> nil then
  begin
    if Supports(FControlToValidate, IJvValidationProperty, ValProp) then
      Result := ValProp.GetValidationPropertyValue
    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 FControlToValidate <> Value then
  begin
    if FControlToValidate <> nil then
      FControlToValidate.RemoveFreeNotification(Self);
    FControlToValidate := Value;
    if FControlToValidate <> nil then
    begin
      FControlToValidate.FreeNotification(Self);
      if Supports(FControlToValidate, IJvValidationProperty, Obj) then
        PropertyToValidate := Obj.GetValidationPropertyName;
    end;
  end;
end;

procedure TJvBaseValidator.SetErrorControl(Value: TControl);
begin
  if FErrorControl <> Value then
  begin
    if FErrorControl <> nil then
      FErrorControl.RemoveFreeNotification(Self);
    FErrorControl := Value;
    if FErrorControl <> nil then
      FErrorControl.FreeNotification(Self);
  end;
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;

//=== { TJvRequiredFieldValidator } ==========================================

procedure TJvRequiredFieldValidator.Validate;
var
  R: Variant;
begin
  R := GetValidationPropertyValue;
  case VarType(R) of
    varDate:
      Valid := VarCompareValue(R, 0) <> vrEqual; // zero is the invalid valid
    varSmallint,
    varInteger,
    varSingle,
    varDouble,
    varCurrency,
    varBoolean,
    varByte:
      ; // nothing to do because all values are valid
  else
    Valid := VarCompareValue(R, '') <> vrEqual;
  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 } ================================================

procedure TJvCompareValidator.Validate;
var
  VR: TVariantRelationship;
begin
  VR := VarCompareValue(GetValidationPropertyValue, ValueToCompare);
  case Operator 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;
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.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 Operator 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
          if Items[I].Enabled and (Items[I].ControlToValidate <> nil) then
            if Controls.IndexOf(Items[I].ControlToValidate) = -1 then
              Controls.Add(Items[I].ControlToValidate);

      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, Items[I].ErrorMessage);
              if FErrorIndicator <> nil then
                Controls.Remove(Items[I].ControlToValidate); { 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(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
    {$IFDEF COMPILER6_UP}
    if Assigned(ValidationSummary) and AComponent.IsImplementorOf(ValidationSummary) then
      ValidationSummary := nil;
    if Assigned(ErrorIndicator) and AComponent.IsImplementorOf(ErrorIndicator) then
      ErrorIndicator := nil;
    {$ELSE}
    if ValidationSummary = AComponent then
      ValidationSummary := nil;
    if ErrorIndicator = AComponent then
      ErrorIndicator := nil;
    {$ENDIF COMPILER6_UP}
  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
  {$IFDEF COMPILER6_UP}
  ReferenceInterface(FValidationSummary, opRemove);
  FValidationSummary := Value;
  ReferenceInterface(FValidationSummary, opInsert);
  {$ELSE}
  FValidationSummary := Value;
  {$ENDIF COMPILER6_UP}
end;

{$IFNDEF COMPILER6_UP}

procedure TJvValidators.SetValidationSummaryComponent(Value: TComponent);
var
  Obj: IJvValidationSummary;
begin
  if Value <> FValidationSummaryComponent then
  begin
    if FValidationSummaryComponent <> nil then
      FValidationSummaryComponent.RemoveFreeNotification(Self);
    if Value = nil then
    begin
      FValidationSummaryComponent := nil;
      SetValidationSummary(nil);
      Exit;
    end;
    if not Supports(Value, IJvValidationSummary, Obj) then
      raise EValidatorError.CreateResFmt(@RsEInterfaceNotSupported, [Value.Name, 'IJvValidationSummary']);
    if Value = Self then
      raise EValidatorError.CreateRes(@RsECircularReference);
    SetValidationSummary(Obj);
    FValidationSummaryComponent := Value;
    FValidationSummaryComponent.FreeNotification(Self);
  end;
end;

procedure TJvValidators.SetErrorIndicatorComponent(Value: TComponent);
var
  Obj: IJvErrorIndicator;
begin
  if Value <> FErrorIndicatorComponent then
  begin
    if FErrorIndicatorComponent <> nil then
      FErrorIndicatorComponent.RemoveFreeNotification(Self);
    if Value = nil then
    begin
      FErrorIndicatorComponent := nil;
      SetErrorIndicator(nil);
      Exit;
    end;
    if not Supports(Value, IJvErrorIndicator, Obj) then
      raise EValidatorError.CreateResFmt(@RsEInterfaceNotSupported, [Value.Name, 'IJvErrorIndicator']);
    if Value = Self then
      raise EValidatorError.CreateRes(@RsECircularReference);
    SetErrorIndicator(Obj);
    FErrorIndicatorComponent := Value;
    FErrorIndicatorComponent.FreeNotification(Self);
  end;
end;

{$ENDIF COMPILER6_UP}

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
  {$IFDEF COMPILER6_UP}
  ReferenceInterface(FErrorIndicator, opRemove);
  FErrorIndicator := Value;
  ReferenceInterface(FErrorIndicator, opInsert);
  {$ELSE}
  FErrorIndicator := Value;
  {$ENDIF COMPILER6_UP}
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
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

  // (p3) do NOT touch! This is required to make the registration work on formulars!!!
  RegisterBaseValidators;

finalization
  FreeAndNil(GlobalValidatorsList);

  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.