Foros Club Delphi - Encontrar objeto por su nombre, encontrar metodo, ejecutar metodo

Estas son varias funciones para encontrar un objeto con su nombre completo (ej; Form3.DBGrid1.Columns). De la misma manera, para encontrar metodos en clases o bien dentro de propiedades TNotifyEvent. Sirve como ejemplo de uso de GetObjectProp y GetMethodProp, en la unidad typinfo.

Código Delphi [-]unit gets;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure Test1;
    procedure Test2;
    procedure Button1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses typinfo;

type THKPersistent=class(TPersistent);

function GetObject(c : TObject; s : string): TObject;
var
     n : integer;
begin
     s := trim(s);
     n := Pos('.',s);
     result := nil;

     if s = '' then result := c;
     if c = nil then c := THKPersistent(c).GetOwner;

     if n <> 0 then
     result := GetObject(GetObject(c,Copy(s,0,n-1)),Copy(s,n+1,Length(s)-n));

     if result = nil then
     try
          result := typinfo.GetObjectProp(c,s);
     except
          result := nil;
     end;

     if result = nil then
     try
          result := (c as TComponent).FindComponent(s);
     except
          result := nil;
     end;
end;

function GetMethod(c : TObject; s : string) : TMethod;
var
     o : TObject;
     ael,lst : string;
begin
     s := trim(s);
     result.code := nil;
     result.data := nil;
     if pos('.',s) = 0 then
     begin
          lst := s;
          o := c;
     end
     else
     begin
          lst := strRscan(PChar(s),'.')+1;
          ael := Copy(s,0,Length(s)-length(lst));
          o := GetObject(c,ael);
     end;

     try
     result := GetMethodProp(o,lst);
     except
     result.code := nil;
     result.data := nil;
     end;

     if result.code = nil then
     try
     result.data := Pointer(o);
     result.code := o.MethodAddress(lst);
     except
     result.code := nil;
     result.data := nil;
     end;
end;

procedure ExecMethod(c : TObject; s : string);
type
   TExec = procedure of object;
var
     m : TMethod;
     Exec : TExec;
begin
      m := GetMethod(c,s);

      if assigned(m.code) then
      begin
        Exec := TExec(m);
        Exec;
      end;
end;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
     o : TObject;
begin
     o := GetObject(Application,'Form1');
     (o as TForm).Color := $BB0000;
     ShowMessage((o as TPersistent).GetNamePath + ' (' + o.classname + ')');

     o := GetObject(Application,'Form1.Edit1.Font');
     ShowMessage((o as TPersistent).GetNamePath + ' (' + o.classname + ')');
     (o as TFont).Size := 18;

     ExecMethod(Application,'Form1.Test1');
     ExecMethod(Application,'Form1.Test2');
     ExecMethod(Application,'Form1.Edit1.OnChange');
end;

procedure TForm1.Test1;
begin
     ShowMessage('procedure Test1');
end;

procedure TForm1.Test2;
begin
     ShowMessage('procedure Test2');
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
     ShowMessage('procedure en propiedad Edit1.OnChange (edit1Change)');
end;

end.