jvqvalidators.pas

East make Tray Icon in delphi

      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;
  Valid := VarCompareValue(R, '') <> vrEqual;
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);
  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);
  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: Boolean;
var
  I: Integer;
begin
  Result := True;
  if ValidationSummary <> nil then
    FValidationSummary.BeginUpdate;
  try
    for I := 0 to Count - 1 do
    begin
      if Items[I].Enabled then
      begin
        Items[I].Validate;
        if not Items[I].Valid then
        begin
          if (Items[I].ErrorMessage <> '') and (Items[I].ControlToValidate <> nil) then
          begin
            if ValidationSummary <> nil then
              FValidationSummary.AddError(Items[I].ErrorMessage);
            if ErrorIndicator <> nil then
              FErrorIndicator.SetError(Items[I].ControlToValidate, Items[I].ErrorMessage);
          end;
          Result := False;
          if not DoValidateFailed(Items[I]) then
            Exit;
        end;
      end;
    end;
  finally
    if ValidationSummary <> nil then
      FValidationSummary.EndUpdate;
  end;
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;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQValidators.pas,v $';
    Revision: '$Revision: 1.21 $';
    Date: '$Date: 2005/02/06 14:06:32 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

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

finalization
  FreeAndNil(GlobalValidatorsList);

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

end.