jvqvalidators.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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鰎nqvist [peter3 at sourceforge dot net] .
Portions created by Peter Th鰎nqvist are Copyright (C) 2003 Peter Th鰎nqvist.
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: JvQValidators.pas,v 1.21 2005/02/06 14:06:32 asnepvangers Exp $

unit JvQValidators;

{$I jvcl.inc}

interface

uses
  QWindows, SysUtils, Classes, QControls, QForms,
  JvQComponent, JvQErrorIndicator;

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;
    FControlToValidate: TControl;
    FValidator: TJvValidators;
    FOnValidateFailed: TNotifyEvent;
    procedure SetControlToValidate(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 to validate
    property ControlToValidate: TControl read FControlToValidate write SetControlToValidate;
    // the property in ControlToValidate to validate against
    property PropertyToValidate: string read FPropertyToValidate write FPropertyToValidate;
    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);

  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; 
    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;
    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(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;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Masks,
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  TypInfo,  
  JclWideStrings, 
  JvQTypes, JvQResources;

var
  GlobalValidatorsList: TStringList = nil;

procedure RegisterBaseValidators; forward;

function ValidatorsList: TStringList;
begin
  if not Assigned(GlobalValidatorsList) then
  begin
    GlobalValidatorsList := TStringList.Create;
   // register
    RegisterBaseValidators;
  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)]);
  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
        Result := GetPropValue(FControlToValidate, FPropertyToValidate, False);
    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
    if AComponent = ControlToValidate then
      ControlToValidate := nil;
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.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