jvvalidatorseditorform.pas

East make Tray Icon in delphi

end;

procedure TfrmValidatorsEditor.FormModified;
begin
  inherited FormModified;
  if not (csDestroying in ComponentState) then
  begin
    UpdateItem(lbValidators.ItemIndex);
    UpdateCaption;
  end;
end;

function TfrmValidatorsEditor.UniqueName(Component: TComponent): string;
begin
  Result := Designer.UniqueName(Component.ClassName);
end;

{$ENDIF COMPILER6_UP}

procedure TfrmValidatorsEditor.UpdateItem(Index: Integer);
var
  I: Integer;
begin
  with lbValidators do
    if (Index < 0) or (Index >= Items.Count) then
      for I := 0 to Items.Count - 1 do
        Items[I] := TComponent(Items.Objects[I]).Name
    else
      Items[Index] := TComponent(Items.Objects[Index]).Name;
end;

function TfrmValidatorsEditor.AddExisting(Validator: TJvBaseValidator): Integer;
begin
  Result := lbValidators.Items.AddObject(Validator.Name, Validator);
  lbValidators.ItemIndex := Result;
  lbValidatorsClick(nil);
end;

function TfrmValidatorsEditor.AddNew(ValidatorClass: TJvBaseValidatorClass): Integer;
var
  V: TJvBaseValidator;
begin
  V := ValidatorClass.Create(FValidator.Owner);
  try
    V.Name := Designer.UniqueName(V.ClassName);
    FValidator.Insert(V);
    Result := AddExisting(V);
  except
    V.Free;
    raise;
  end;
end;

procedure TfrmValidatorsEditor.ClearValidators;
begin
  lbValidators.Items.Clear;
end;

procedure TfrmValidatorsEditor.Delete(Index: Integer);
var
  V: TJvBaseValidator;
begin
  with lbValidators do
    if (Index > -1) and (Index < Items.Count) then
    begin
      V := TJvBaseValidator(Items.Objects[Index]);
      FValidator.Remove(V);
      V.Free;
      Designer.Modified;
    end;
end;

procedure TfrmValidatorsEditor.SelectItem(AObject: TPersistent);
begin
  Designer.SelectComponent(AObject);
  Designer.Modified;
end;

procedure TfrmValidatorsEditor.SetValidator(const Value: TJvValidators);
begin
  FValidator := Value;
  Activated;
end;

procedure TfrmValidatorsEditor.UpdateCaption;
begin
  Caption := RsJvValidatorItemsEditorEllipsis;
end;

procedure TfrmValidatorsEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmValidatorsEditor.lbValidatorsClick(Sender: TObject);
begin
  if lbValidators.ItemIndex > -1 then
    with lbValidators do
      SelectItem(TJvBaseValidator(Items.Objects[ItemIndex]));
end;

procedure TfrmValidatorsEditor.alEditorUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  acDelete.Enabled := lbValidators.ItemIndex > -1;
  acMoveUp.Enabled := lbValidators.ItemIndex > 0;
  acMoveDown.Enabled := (lbValidators.ItemIndex < lbValidators.Items.Count - 1) and
    acDelete.Enabled;
end;


procedure TfrmValidatorsEditor.acDeleteExecute(Sender: TObject);
begin
  Delete(lbValidators.ItemIndex);
end;

procedure TfrmValidatorsEditor.acMoveUpExecute(Sender: TObject);
var
  I: Integer;
begin
  with lbValidators do
  begin
    I := ItemIndex;
    Items.Exchange(I, I - 1);
    FValidator.Exchange(I, I - 1);
  end;
end;

procedure TfrmValidatorsEditor.acMoveDownExecute(Sender: TObject);
var
  I: Integer;
begin
  with lbValidators do
  begin
    I := ItemIndex;
    Items.Exchange(I, I + 1);
    FValidator.Exchange(I, I + 1);
  end;
end;

procedure TfrmValidatorsEditor.DoAddNewValidator(Sender: TObject);
begin
  with Sender as TAction do
    AddNew(TJvBaseValidatorClass(Tag));
end;

type
  TJvBaseValidatorAccess = class(TJvBaseValidator);

procedure TfrmValidatorsEditor.AddValidatorClasses;
var
  I, J, K: Integer;
  A: TAction;
  M: TMenuItem;
  AName: string;
  AClass: TJvBaseValidatorClass;
begin
  J := TJvBaseValidatorAccess.BaseValidatorsCount;
  K := 0;
  for I := 0 to J - 1 do
  begin
    TJvBaseValidatorAccess.GetBaseValidatorInfo(I, AName, AClass);
    if AName = '' then
    begin
      Inc(K);
      Continue;
    end;
    A := TAction.Create(Self);
    A.Caption := AName;
    A.Tag := Integer(AClass);
    A.ImageIndex := 0;
    if I - K < 9 then
      A.ShortCut := ShortCut(Ord('0') + I + 1 - K, [ssCtrl]);
    A.OnExecute := DoAddNewValidator;
    M := TMenuItem.Create(popNew);
    M.Action := A;
    if I = 0 then
    begin
      {$IFDEF VCL}
      M.Default := True;
      {$ENDIF VCL}
      btnNew.Action := A;
    end;
    popNew.Items.Add(M);
    M := TMenuItem.Create(popForm);
    M.Action := A;
    {$IFDEF VCL}
    if I = 0 then
      M.Default := True;
    {$ENDIF VCL}
    popForm.Items.Insert(I,M);
  end;
  if J < 2 then
    btnNew.Style := tbsButton
  else
    btnNew.Style := tbsDropDown;
  ToolBar1.Width := 0;
end;

//=== { TJvPropertyValidateProperty } ========================================

function TJvPropertyValidateProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList];
end;

procedure TJvPropertyValidateProperty.GetValues(Proc: TGetStrProc);
const
  ValidKinds: TTypeKinds =
    [tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet,
     tkWChar, tkLString, tkWString, tkVariant, tkInt64];
var
  PropList: PPropList;
  PropInfo: PPropInfo;
  I, J: Integer;
  C: TControl;
begin
  if not (GetComponent(0) is TJvBaseValidator) then
    Exit;
  C := TJvBaseValidator(GetComponent(0)).ControlToValidate;
  if C = nil then
    Exit;
  J := GetPropList(PTypeInfo(C.ClassInfo), ValidKinds, nil);
  if J > 0 then
  begin
    GetMem(PropList, J * SizeOf(Pointer));
    J := GetPropList(PTypeInfo(C.ClassInfo), ValidKinds, PropList);
    if J > 0 then
    try
      for I := 0 to J - 1 do
      begin
        PropInfo := PropList^[I];
        if (PropInfo <> nil) and (PropInfo.PropType^.Kind in ValidKinds) then
          Proc(PropInfo.Name);
      end;
    finally
      FreeMem(PropList);
    end;
  end;
end;

{$IFDEF COMPILER5}

//=== { TJvValidationSummaryProperty } =======================================

procedure TJvValidationSummaryProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Obj: IJvValidationSummary;
begin
  for I := 0 to Designer.Form.ComponentCount - 1 do
    if Supports(Designer.Form.Components[I], IJvValidationSummary, Obj) and
      (Designer.Form.Components[I] <> GetComponent(0)) then
      Proc(Designer.Form.Components[I].Name);
end;

//=== { TJvErrorIndicatorProperty } ==========================================

procedure TJvErrorIndicatorProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Obj: IJvErrorIndicator;
begin
  for I := 0 to Designer.Form.ComponentCount - 1 do
    if Supports(Designer.Form.Components[I], IJvErrorIndicator, Obj) and
      (Designer.Form.Components[I] <> GetComponent(0)) then
      Proc(Designer.Form.Components[I].Name);
end;

{$ENDIF COMPILER5}

//=== { TJvPropertyToCompareProperty } =======================================

function TJvPropertyToCompareProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList];
end;

procedure TJvPropertyToCompareProperty.GetValues(Proc: TGetStrProc);
const
  ValidKinds: TTypeKinds =
    [tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet,
     tkWChar, tkLString, tkWString, tkVariant, tkInt64];
var
  PropList: PPropList;
  PropInfo: PPropInfo;
  I, J: Integer;
  C: TControl;
begin
  if not (GetComponent(0) is TJvControlsCompareValidator) then
    Exit;
  C := TJvControlsCompareValidator(GetComponent(0)).CompareToControl;
  if C = nil then
    Exit;
  J := GetPropList(PTypeInfo(C.ClassInfo), ValidKinds, nil);
  if J > 0 then
  begin
    GetMem(PropList, J * SizeOf(Pointer));
    J := GetPropList(PTypeInfo(C.ClassInfo), ValidKinds, PropList);
    if J > 0 then
    try
      for I := 0 to J - 1 do
      begin
        PropInfo := PropList^[I];
        if (PropInfo <> nil) and (PropInfo.PropType^.Kind in ValidKinds) then
          Proc(PropInfo.Name);
      end;
    finally
      FreeMem(PropList);
    end;
  end;
end;

end.