Erro ao receber parâmetro do tipo Variant na criação de atributos

unit Unit18;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  System.ImageList, Vcl.ImgList, Vcl.Menus, Tora, RTTI,
  System.Generics.Collections;

type
  TCompare = (tcEqual, tcNotEqual, tcGreater, tcLess, tcNotLess, tcNotGreater);

type
  TReferenceCompare = (rcConst, rcObject);

type
  TAtribute = record
    Atributo: String;
    Operacao: TCompare;
    Referencia: TReferenceCompare;
    Valor: Variant;
  end;

type
  TAtributo = class(TCustomAttribute)
  private
    fAtributos: TAtribute;
    FOperacao: TCompare;
    FValor: Variant;
    FAtributo: String;
    FReferencia: TReferenceCompare;
    FTypeCompare: TVarType;
    FOrigem: String;
    FOrigemValue: Variant;
    procedure SetAtributo(const Value: String);
    procedure SetOperacao(const Value: TCompare);
    procedure SetReferencia(const Value: TReferenceCompare);
    procedure SetValor(const Value: Variant);
    procedure SetOrigem(const Value: String);
    procedure SetTypeCompare(const Value: TVarType);
    procedure SetOrigemValue(const Value: Variant);
  public
    property Atributo: String read FAtributo write SetAtributo;
    property Operacao: TCompare read FOperacao write SetOperacao;
    property Referencia: TReferenceCompare read FReferencia write SetReferencia;
    property Valor: Variant read FValor write SetValor;
    property TypeCompare: TVarType read FTypeCompare write SetTypeCompare;
    property Origem: String read FOrigem write SetOrigem;
    property OrigemValue: Variant read FOrigemValue write SetOrigemValue;
    constructor Create(Value: Variant; Operacoes: TCompare; Origem: String;
      Tipo: TVarType); overload;
    constructor Create(Value: Variant; Operacoes: TCompare;
      Referencia: TReferenceCompare; Origem: String; Tipo: TVarType); overload;
  end;

type
  TValidate = class
  private
    class var Obj: TObject;
    class var Campo: TObject;
    class function Valid(Source: TObject; Name: String;
      StopAtrOnFirstError: Boolean; ListError: TStrings): Boolean;
  public
    class function Validar(Source: TObject; Name: String): Boolean; overload;
    class function Validar(Source: TObject; Name: String;
      StopAtrOnFirstError: Boolean): Boolean; overload;
    class function Validar(Source: TObject; StopAtrOnFirstError: Boolean)
      : Boolean; overload;
    class function Validar(Source: TObject; StopAtrOnFirstError: Boolean;
      out ListError: TStrings): Boolean; overload;
    class procedure RefreshValues(Atributo: TAtributo; Source: TObject);
    class function ExtractValue(Atributo: TAtributo; var Lista: TStringList;
      Addr: TObject; DelimiterText: String): Variant;
  end;

type

  TForm18 = class(TForm)
    Button1: TButton;
    TreeView1: TTreeView;
    [TAtributo('Edit4.Text', tcNotLess, rcObject, 'Text', varInteger)]
    [TAtributo('Edit5.Text', tcNotGreater, rcObject, 'Text', varInteger)]
    // [TAtributo('1', '2')]
    Edit1: TEdit;
    Button2: TButton;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    Memo1: TMemo;
    Edit2: TEdit;
    Edit3: TEdit;
    Button3: TButton;
    Edit4: TEdit;
    Edit5: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    Ftes: Byte;
    procedure Settes(const Value: Byte);
    { Private declarations }
  public

  var
    teste: TAtribute;

    { Public declarations }
  published
    property tes: Byte read Ftes write Settes;
  end;

var
  Form18: TForm18;

implementation

uses
  System.TypInfo;

{$R *.dfm}

procedure TForm18.Button1Click(Sender: TObject);
var
  Stream: TStringStream;
  GetInfClass: Tora.TRTTI;
begin
  GetInfClass := Tora.TRTTI.Create;
  GetInfClass.PropListObject(Button1);
  Stream := TStringStream.Create(GetInfClass.Lista.Text);
  TreeView1.LoadFromStream(Stream);
  FreeAndNils([GetInfClass, Stream]);
end;

{ atributo }

function GetVarsNames(const AClass: TObject): TStringList;
var
  lType: TRttiType;
  lContext: TRttiContext;
  lProperty: TRttiProperty;
  lField: TRttiField;
begin
  Result := TStringList.Create;
  lType := lContext.GetType(AClass.ClassType);
  if assigned(lType) then
  begin
    for lProperty in lType.GetProperties do
    begin
      Result.Add(lProperty.Name);
      // Get current value:
      Result.Add(lProperty.GetValue(AClass).ToString);
    end;
    for lField in lType.GetFields do
    begin
      Result.Add(lField.Name);
      // Get current value:
      Result.Add(lField.GetValue(AClass).ToString);
    end;
  end;
end;

// function GetVarValue(const AClass: TObject; Nome: String;
// var Valor: TValue): Boolean;
// var
// lType: TRttiType;
// lContext: TRttiContext;
// lField: TRttiField;
// begin
// Result := false;
// lType := lContext.GetType(AClass.ClassType);
// if assigned(lType) then
// begin
// for lField in lType.GetFields do
// begin
// if lField.Name = Nome then
// begin
// Valor := (lField.GetValue(AClass));
// Result := true;
// break;
// end;
// end;
// end;
// end;

function GetVarValue(const AClass: TObject; Nome: String;
  var Valor: TValue): Boolean;
var
  lType: TRttiType;
  lContext: TRttiContext;
  lProperty: TRttiProperty;
  lField: TRttiField;
begin
  Result := False;
  lType := lContext.GetType(AClass.ClassType);
  if assigned(lType) then
  begin
    for lProperty in lType.GetProperties do
      if Nome = lProperty.Name then
      begin
        Valor := lProperty.GetValue(AClass);
        Result := true;
        exit;
      end;
    for lField in lType.GetFields do
    begin
      if Nome = lField.Name then
      begin
        Valor := lField.GetValue(AClass);
        Result := true;
        exit;
      end;
    end;
  end;
  lContext.Free;
end;

procedure Test;
Var
  t: TRttiType;
  // extract the unit name from the  QualifiedName property
  function GetUnitName(lType: TRttiType): string;
  begin
    Result := StringReplace(lType.QualifiedName, '.' + lType.Name, '',
      [rfReplaceAll])
  end;

begin
  // list all the types of the System.SysUtils unit
  for t in TRttiContext.Create.GetTypes do
    if SameText('Unit18', GetUnitName(t)) and (t.IsInstance) then
      showmessage(t.Name);
end;

procedure TForm18.Button2Click(Sender: TObject);
var
  cronometro: Tora.TCronometro;
begin
  cronometro.Inicia;
  // if edit1.Text = edit2.Text then
  // showmessage('teste')
  // GetVarsNames(self);
  if TValidate.Validar(self, 'Edit1') then
    showmessage('deu');
  cronometro.Finaliza(true);

end;

procedure TForm18.Button3Click(Sender: TObject);
var
  teste: Variant;
  teste1: Variant;

begin
  teste := 123;
  teste1 := '100';
  if VarCompareValue(teste, teste1) = vrGreaterThan then
    showmessage(inttostr(teste1));

  // VarInRange
  // VarSameValue
  // VarCompareValue

end;

procedure TForm18.Settes(const Value: Byte);
begin
  Ftes := Value;
end;

// constructor TAtributo.Create(Min, Max: String);
// var
// Valor: TAtribute;
// Lista: TStringList;
// Prop: String;
// Value: TValue;
// Addr: Pointer;
// begin
// Lista := TStringList.Create;
// Lista.Delimiter := '.';
// Lista.DelimitedText := Min;
// for Prop in Lista do
// begin
// if not GetVarValue(TAtributeate.Obj, Prop, Value) then
// break;
// if not Value.IsObject then
// break;
// end;
/// /  Valor.Min := GetPropValue(TObject(Value.AsObject), Prop);
//
// Lista.DelimitedText := Max;
// for Prop in Lista do
// begin
// if not GetVarValue(TAtributeate.Obj, Prop, Value) then
// break;
// if not Value.IsObject then
// break;
// end;
/// /  Valor.Max := GetPropValue(TObject(Value.AsObject), Prop);
// // Valor.Max := Max;
// Self.Valor := Valor;
// FreeAndNils([Lista]);
// end;

class function TValidate.Validar(Source: TObject; Name: String): Boole

begin
  Result := Valid(Source, EmptyStr, False, nil);
end;

class function TValidate.Validar(Source: TObject;
  StopAtrOnFirstError: Boolean): Boolean;
begin
  Result := Valid(Source, EmptyStr, StopAtrOnFirstError, nil);
end;

class function TValidate.Validar(Source: TObject; StopAtrOnFirstError: Boolean;
  out ListError: TStrings): Boolean;
begin
  Result := Valid(Source, EmptyStr, StopAtrOnFirstError, ListError);
end;

class function TValidate.Validar(Source: TObject; Name: String;
  StopAtrOnFirstError: Boolean): Boolean;
begin
  Result := Valid(Source, Name, StopAtrOnFirstError, nil);
end;

class function TValidate.Valid(Source: TObject; Name: String;
  StopAtrOnFirstError: Boolean; ListError: TStrings): Boolean;
var
  Contexto: TRttiContext;
  Field: TRttiField;
  Tipo: TRttiType;
  VarRelation: TVariantRelationship;
  ValidAll: Boolean;
  cAtributo: TCustomAttribute;
begin
  Result := true;
  Obj := Source;
  ValidAll := Name = EmptyStr;
  if assigned(ListError) then
    ListError.Clear;
  Contexto := TRttiContext.Create;
  try
    Tipo := Contexto.GetType(Obj.ClassInfo);
    for Field in Tipo.GetFields do
    begin
      Campo := Field;
      for cAtributo in Field.GetAttributes do
      begin
        if (cAtributo is TAtributo) then
        begin
          if (Name = EmptyStr) or (Field.Name = Name) then
          begin
            RefreshValues(TAtributo(cAtributo), Field.GetValue(Obj).AsObject);
            VarRelation := VarCompareValue(TAtributo(cAtributo).OrigemValue,
              TAtributo(cAtributo).Valor);

            // VarRelation := VarCompareValue(TEdit(Field.GetValue(Obj).AsObject)
            // .Text, TAtributo(cAtributo).Valor);
            case VarRelation of
              vrEqual:
                if not(TAtributo(cAtributo).Operacao in [tcEqual, tcNotLess,
                  tcNotGreater]) then
                  Result := False;
              vrLessThan:
                if not(TAtributo(cAtributo).Operacao in [tcLess, tcNotGreater])
                then
                  Result := False;
              vrGreaterThan:
                if not(TAtributo(cAtributo).Operacao in [tcGreater, tcNotLess])
                then
                  Result := False;
              vrNotEqual:
                if not(TAtributo(cAtributo).Operacao in [tcNotEqual, tcGreater,
                  tcLess]) then
                  Result := False;
            end;
            if StopAtrOnFirstError and not Result then
              break;
          end;
        end;
      end;
      if not ValidAll and not Result then
        break;
    end;
  finally
    Contexto.Free;
  end;
end;

class procedure TValidate.RefreshValues(Atributo: TAtributo; Source: TObject);
var
  Lista: TStringList;
begin
  Lista := TStringList.Create;
  Lista.Delimiter := '.';
  Atributo.OrigemValue := ExtractValue(Atributo, Lista, Source,
    Atributo.Origem);
  if Atributo.Referencia = rcObject then
    Atributo.Valor := ExtractValue(Atributo, Lista, Obj, Atributo.Atributo);
  FreeAndNil(Lista);
end;

class function TValidate.ExtractValue(Atributo: TAtributo;
  var Lista: TStringList; Addr: TObject; DelimiterText: String): Variant;
var
  Prop: string;
  Value: TValue;
begin
  Lista.DelimitedText := DelimiterText;
  for Prop in Lista do
  begin
    if not GetVarValue(Addr, Prop, Value) then
      break;
    if Value.IsObject then
      Addr := Value.AsObject
    else
      break;
  end;
  Result := VarAsType(Value.AsVariant, Atributo.FTypeCompare);
end;

constructor TAtributo.Create(Value: Variant; Operacoes: TCompare;
  Referencia: TReferenceCompare; Origem: String; Tipo: TVarType); 
begin
  self.Origem := Origem;
  self.TypeCompare := Tipo;
  self.Referencia := Referencia;
  self.Operacao := Operacoes;
  if Referencia = rcConst then
    self.Valor := Value
  else
    self.Atributo := Value;
end;

constructor TAtributo.Create(Value: Variant; Operacoes: TCompare; Origem: String;
  Tipo: TVarType);
begin
  self.Origem := Origem;
  self.TypeCompare := Tipo;
  self.Referencia := rcConst;
  self.Operacao := Operacoes;
  self.Valor := Value;
end;

procedure TAtributo.SetAtributo(const Value: String);
begin
  FAtributo := Value;
end;

procedure TAtributo.SetOperacao(const Value: TCompare);
begin
  FOperacao := Value;
end;

procedure TAtributo.SetOrigem(const Value: String);
begin
  FOrigem := Value;
end;

procedure TAtributo.SetOrigemValue(const Value: Variant);
begin
  FOrigemValue := Value;
end;

procedure TAtributo.SetReferencia(const Value: TReferenceCompare);
begin
  FReferencia := Value;
end;

procedure TAtributo.SetTypeCompare(const Value: TVarType);
begin
  FTypeCompare := Value;
end;

procedure TAtributo.SetValor(const Value: Variant);
begin
  FValor := Value;
end;

end.