Ver Mensaje Individual
  #12  
Antiguo 20-03-2019
cloayza cloayza is offline
Miembro
 
Registrado: may 2003
Ubicación: San Pedro de la Paz, Chile
Posts: 913
Reputación: 22
cloayza Tiene un aura espectacularcloayza Tiene un aura espectacular
Amigo otro opción es hacer uso de las RTTI...Hace unos años recopile unos procedimientos para realizar esta tarea en un desarrollo.

Te adjunto la unidad y un ejemplo. Espero te ayude.

Es solo otra opción de realizar lo que requieres...

Código Delphi [-]
{
Funciones y procedimientos para accesar objetos a traves de la RTTI.

Christian Loayza
Abril/2012


String   := GetEnumName(TypeInfo(TFieldType),  Integer(ftString));
DataType := TFieldType(GetEnumValue(TypeInfo(TFieldType),'ftString')) ;

}
unit CLRtti;

interface
uses Classes, TypInfo, SysUtils;

function CreateAClass(const AClassName: string): TObject;
function ClonarPropiedades( Origen, Destino: TObject; APropiedades: array of string ): Boolean;
function DesignNameIsUnique(AOwner: TComponent; const AName: string): Boolean;
function DesignUniqueName(AOwner: TComponent; const AClassName: string): string;

procedure SetIntegerProperty(AComp: TComponent; APropName: String; AValue: Integer);
procedure SetFloatProperty(AComp: TComponent; APropName: String; AValue: Double);
procedure SetObjectProperty(AComponent: TComponent; APropName: String; AValue: TObject);

procedure SetBooleanProperty(AComp: TComponent     ;APropName: String; AValue: Boolean);overload;
procedure SetBooleanProperty(AComp:Array of TObject;APropName:string; AValue:Boolean);overload;
procedure SetBooleanProperty(AComp:Array of TObject;APropName:string; AValue:Array Of Boolean);overload;

procedure SetStringProperty(AComp: TComponent; APropName: String; AValue: String);
procedure SetMethodProperty(AComp: TComponent; APropName: String; AMethod: TMethod);

function GetIntegerProperty(AComp: TComponent; APropName:String): Integer;
function GetFloatProperty(AComp: TComponent; APropName:String): Double;
function GetObjectProperty(AComponent: TComponent; APropName:String): TObject;
function GetBooleanProperty(AComp: TComponent; APropName:String):Boolean;
Function GetStringProperty(AComp: TComponent; APropName:String):String;
//function GetEnumerationProperty(AComp:TComponent; APropName:string):Integer;
function GetMethodProperty(AComp: TComponent; APropName:String):TMethod;

function ExistProperty(AComp: TComponent; APropName: String):Boolean;

implementation


function CreateAClass(const AClassName: string): TObject;
var
  C : TComponentClass;
  SomeObject: TObject;
begin
     C         := TComponentClass(FindClass(AClassName));
     SomeObject := C.Create(nil);
     Result     := SomeObject;
end;

function ClonarPropiedades( Origen, Destino: TObject; APropiedades: array of string ): Boolean;
var
  i: Integer;
begin
     Result := True;
     try
       for i := Low( APropiedades ) to High( APropiedades ) do
       begin
         // ¿Existe la propiedad en el control origen?
         if not IsPublishedProp( Origen, APropiedades[i] ) then
           Continue;

         // ¿Existe la propiedad en el control destino?
         if not IsPublishedProp( Destino, APropiedades[i] ) then
           Continue;

         // ¿Son del mismo tipo las dos propiedades?
         if PropType( Origen, APropiedades[i]) <>
           PropType( Destino, APropiedades[i] ) then
           Continue;

         // Copiamos la propiedad según si es variable o método
         case PropType(Origen, APropiedades[i]) of
           tkClass:
             SetObjectProp( Destino, APropiedades[i],
               GetObjectProp( Origen, APropiedades[i] ) );

           tkMethod:
             SetMethodProp( Destino, APropiedades[i],
                            GetMethodProp( Origen, APropiedades[i] ) );
           else
             SetPropValue( Destino, APropiedades[i],
                           GetPropValue( Origen, APropiedades[i] ) );
         end;
       end;
     except
       Result := False;
     end;
end;

function DesignNameIsUnique(AOwner: TComponent; const AName: string): Boolean;
begin
     Result := True;
     while Result and (AOwner <> nil) do
     begin
       Result := AOwner.FindComponent(AName) = nil;
       AOwner := AOwner.Owner;
     end;
end;

function DesignUniqueName(AOwner: TComponent; const AClassName: string): string;
var
  Base: string;
  I: Integer;
begin
     Base := Copy(AClassName, 2, MAXINT);
     I := 0;
     repeat
       Inc(I);
       Result := Base + IntToStr(I);
     until DesignNameIsUnique(AOwner, Result);
end;

function ExistProperty(AComp: TComponent; APropName: String):Boolean;
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     Result:=Assigned(PropInfo);
end;

procedure SetIntegerProperty(AComp: TComponent; APropName: String; AValue: Integer);
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
       if PropInfo^.PropType^.Kind = tkInteger then
         SetOrdProp(AComp, PropInfo, AValue);
     end;
end;

function GetIntegerProperty(AComp: TComponent; APropName:String): Integer;
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkInteger then
             Result:=GetOrdProp(AComp, PropInfo)
          else If PropInfo^.PropType^.Kind = tkEnumeration then
              Result:=GetEnumValue(PropInfo^.PropType^, PropInfo^.PropType^.Name);

     end;
end;

function GetFloatProperty(AComp: TComponent; APropName:String): Double;
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkFloat then
             Result:=GetFloatProp(AComp, PropInfo);
     end;
end;

procedure SetFloatProperty(AComp: TComponent; APropName: String; AValue: Double);
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkFloat then
             SetFloatProp(AComp, PropInfo, AValue);
     end;
end;

procedure SetObjectProperty(AComponent: TComponent; APropName: String; AValue: TObject);
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComponent.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkClass then
            SetObjectProp(AComponent, PropInfo, AValue);
     end;
end;

function GetObjectProperty(AComponent: TComponent; APropName:String): TObject;
var
  PropInfo: PPropInfo;
begin
     Result:=Nil;
     PropInfo := GetPropInfo(AComponent.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkClass then
             Result:=GetObjectProp(AComponent, PropInfo);
     end;
end;

procedure SetBooleanProperty(AComp: TComponent; APropName: String; AValue: Boolean);
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkEnumeration then
            SetOrdProp(AComp, PropInfo, Integer(AValue));
     end;
end;

procedure SetBooleanProperty(AComp:Array of TObject; APropName:string; AValue:Boolean);
Var
     i:Integer;
begin
     For i:=Low(AComp) To High(AComp) Do
         SetBooleanProperty(TComponent(AComp[i]), APropName, AValue);
end;

procedure SetBooleanProperty(AComp:Array of TObject;APropName:string; AValue:Array Of Boolean);
Var
   i:Integer;
begin
     For i:=Low(AComp) To High(AComp) Do
         SetBooleanProperty(TComponent(AComp[i]), APropName, AValue[i]);
end;

function GetBooleanProperty(AComp: TComponent; APropName:String):Boolean;
var
  PropInfo: PPropInfo;
begin
     Result:=False;
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkEnumeration then
             Result:=Boolean(GetOrdProp(AComp, PropInfo));
     end;
end;


procedure SetStringProperty(AComp: TComponent; APropName: String; AValue: String);
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if (PropInfo^.PropType^.Kind in [tkString, tkLString, tkWString]) then
             SetStrProp(AComp, PropInfo, AValue);
     end;
end;

Function GetStringProperty(AComp: TComponent; APropName:String):String;
var
  PropInfo: PPropInfo;
begin
     Result:='';
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
       if (PropInfo^.PropType^.Kind in [tkString, tkLString, tkWString, tkUString]) then
         Result:=GetStrProp(AComp, PropInfo);
     end;
end;


{Function GetEnumerationProperty(AComp: TComponent; APropName:String):Integer;
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
       if (PropInfo^.PropType^.Kind in [tkString, tkLString, tkWString, tkUString]) then
         Result:=GetStrProp(AComp, PropInfo);
     end;
end;
}
procedure SetMethodProperty(AComp: TComponent; APropName: String; AMethod: TMethod);
var
  PropInfo: PPropInfo;
begin
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkMethod then
             SetMethodProp(AComp, PropInfo, AMethod);
     end;
end;

function GetMethodProperty(AComp: TComponent; APropName:String):TMethod;
var
  PropInfo: PPropInfo;
begin
     Result.Code:=NIL;
     Result.Data:=NIL;
     PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
     if PropInfo <> nil then
     begin
          if PropInfo^.PropType^.Kind = tkMethod then
             Result:=GetMethodProp(AComp, PropInfo);
     end;
end;
end.

Ejemplo: Un formulario y varios componentes...
Código Delphi [-]
unit Unit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils,
  System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm4 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Memo1: TMemo;
    Button1: TButton;
    CheckBox1: TCheckBox;
    ListBox1: TListBox;
    Button2: TButton;
    Button3: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation
uses CLRtti;

{$R *.dfm}

procedure TForm4.Button2Click(Sender: TObject);
begin
       CLRtti.SetBooleanProperty([Edit1, Edit2, Label1,
                                Memo1, Button1,
                                CheckBox1,
                                ListBox1],'Enabled',true);
end;

procedure TForm4.Button3Click(Sender: TObject);
begin
     CLRtti.SetBooleanProperty([Edit1, Edit2, Label1,
                                Memo1, Button1,
                                CheckBox1, ListBox1], 'Enabled',false);

end;

end.

Saludos cordiales
Responder Con Cita