cara... eu utilizo a RTTI pra fazer chamadas a métodos da classe...
para manipular os métodos e propriedades eu utilizo helpers para as
classes da RTTI... se eu não me engano funciona com os métodos de
qualquer escopo (ou menos da strict private.. não tenho certeza)... na
verdade esse código eu achei na internet.. no site da embarcadero
mesmo... mas agora não consegui achar pra passar o link.. então vou
colocar o exemplo de como eu utilizo aqui....
-------------------------------
Uses TypInfo, ObjAuto, uRClassProperties;
type
// declara os helpers para a RTTI
TParamInfoHelper = record helper for TParamInfo
public
function AsString: string;
function NextParam: PParamInfo;
end;
TReturnInfoHelper = record helper for TReturnInfo
public
function AsString: string;
end;
TMethodInfoHeaderHelper = record helper for TMethodInfoHeader
private
function GetReturnInfo: PReturnInfo;
public
property ReturnInfo: PReturnInfo read GetReturnInfo;
end;
TObjectHelper = class helper for TObject
public
function RTTIMethodsAsString: string;
end;
function DescriptionOfMethod( Obj: TObject; MethodName: string ): string;
implementation
uses
SysUtils;
const
SHORT_LEN = sizeof(ShortString) - 1;
function DescriptionOfMethod( Obj: TObject; MethodName: string ): string;
var
header: PMethodInfoHeader;
headerEnd: Pointer;
Params, Param: PParamInfo;
returnInfo: PReturnInfo;
begin
header := ObjAuto.GetMethodInfo( Obj, MethodName );
if Header.Len <= SizeOf(TMethodInfoHeader) - SHORT_LEN +
Length(Header.Name) then
begin
Result := 'No rich RTTI';
exit;
end;
headerEnd := Pointer(Integer(header) + header^.Len);
Params := PParamInfo(Integer(header) + SizeOf(header^) - SHORT_LEN +
SizeOf(TReturnInfo) + Length(header^.Name));
Param := Params;
Result := '';
while Integer(Param) < Integer(headerEnd) do
begin
Result := Result + Param.AsString + '; ';
Param := Param.NextParam;
end;
Delete( Result, Length(Result)-1,2 );
returnInfo := header.ReturnInfo;
if assigned( returnInfo.ReturnType ) then
Result := Format( 'function %s( %s ): %s', [ MethodName, Result,
returnInfo.AsString ] )
else
Result := Format( 'procedure %s( %s )%s', [ MethodName, Result,
returnInfo.AsString ] );
end;
{ TParamInfoHelper }
function TParamInfoHelper.AsString: string;
begin
Result := '';
if pfResult in Flags then exit;
Result := Name + ': ' + ParamType^.Name;
if pfVar in self.Flags then
Result := 'var ' + Result;
end;
function TParamInfoHelper.NextParam: PParamInfo;
begin
Result := PParamInfo(Integer(@self) + SizeOf(self) - SHORT_LEN +
Length(Name));
end;
{ TMethodInfoHeaderHelper }
function TMethodInfoHeaderHelper.GetReturnInfo: PReturnInfo;
begin
Result := PReturnInfo(Integer(@self) + SizeOf(TMethodInfoHeader) -
SHORT_LEN + Length(Name));
end;
{ TReturnInfoHelper }
function TReturnInfoHelper.AsString: string;
var
c: string;
begin
Assert( Version = 1, 'Version of ReturnInfo incorrect' );
if assigned( ReturnType ) then
Result := ReturnType^.Name;
Result := Result + ';';
case CallingConvention of
ccRegister: ;// Default
ccCdecl: c := 'cdecl';
ccPascal: c := 'pascal';
ccStdCall: c := 'stdcall';
ccSafeCall: c := 'safecall';
end;
if c <> '' then Result := Result + ' ' + c + ';';
end;
{ TObjectHelper }
function TObjectHelper.RTTIMethodsAsString: string;
var
MethodInfo: Pointer;
Count: Integer;
method: PMethodInfoHeader;
i: Integer;
begin
MethodInfo := PPointer(Integer(PPointer(self)^) + vmtMethodTable)^;
if MethodInfo <> nil then
begin
Count := PWord(MethodInfo)^;
Inc(Integer(MethodInfo), 2);
method := MethodInfo;
for i := 0 to Count - 1 do
begin
Result := Result + DescriptionOfMethod(self, method.Name) +
sLineBreak;
Inc(Integer(method), PMethodInfoHeader(method)^.Len);
end;
end;
end;
----------------------------------------------------------
feito isso, adicione essa unit a Uses que irá fazer as chamadas... e
utilize normalmente os métodos da RTTI....
para recuperar as informacoes do objeto em um TreeView, por exemplo:
---
procedure GenerateNodes(Obj: TObject; Node: TTreeNode);
var
i: byte;
InternalNode1, InternalNode2, InternalNode3: TTreeNode;
PropList: PPropList;
PropListCount: byte;
MethodInfo: Pointer;
MethodListCount: byte;
Method: PMethodInfoHeader;
begin
if Assigned(Node) then
InternalNode1 := Node
else
InternalNode1 := TreeView1.Items.Add(nil, Obj.ClassName);
//Propriedades
InternalNode2 := TreeView1.Items.AddChild(
InternalNode1, 'Propriedades');
PropListCount := GetPropList(Obj, PropList);
for i := 0 to Pred(PropListCount) do
begin
InternalNode3 := TreeView1.Items.AddChild(InternalNode2,
string(PropList[i].Name) + '=' +
QuotedStr(
string(
GetPropValue(
Obj,
string(Proplist[i].Name)
)
)
)
);
if PropType(Obj, string( PropList[i].Name )) = tkClass then
GenerateNodes(GetObjectProp(Obj, string(PropList[i].Name)),
InternalNode3);
end;
//Métodos
InternalNode2 := TreeView1.Items.AddChild(InternalNode1, 'Métodos');
//MethodInfo contera toda a lista metodos encontrada na area da vmt
//referente ao objeto passado no caso abaixo a variavel Obj
MethodInfo := PPointer(Integer(PPointer(Obj)^) + vmtMethodTable)^;
if MethodInfo <> nil then
begin
//Retorna a qtd de metodos encontrados
MethodListCount := PWord(MethodInfo)^;
Inc(Integer(MethodInfo), 2);
method := MethodInfo;
for i := 0 to Pred(MethodListCount) do
begin
TreeView1.Items.AddChild(InternalNode2, string( Method.Name ));
Inc(integer(Method), PMethodInfoHeader(Method)^.Len);
end;
end;
end;
-----------------
crie uma função para executar o método:
function ExecMethod(AObj: TObject; AMethodName: string; // objeto e nome
do Metodo
const ParamIndexes: array of Integer; // indice de
parametros
const Params: array of Variant): Variant; // valor
dos parametros
var
Method: PMethodInfoHeader;
begin
try
Method := GetMethodInfo(AObj, ShortString(AMethodName));
if Assigned( Method ) then
Result := ObjectInvoke(AObj, Method, ParamIndexes, Params);
finally
end;
end;
---------------
para invocar um método, vc passa teu objeto, o nome do método e
possiveis parametros, por exemplo:
var
Nome: string;
begin
Nome := VarToString(ExecMethod(AObj: TObject; 'getNomeCompleto',
[], []);
ShowMessage(Nome);
---------------------
se não estiver conseguindo recuperar o método, tenta usar a diretiva
METHODINFO na declaracao das tuas classes:
{$M+} ou {$METHODINFO ON}
TClasse = class
end;
{$M-} ou {$METHODINFO OFF}
divirta-se ai... hehehe... espero q ajude....
o/
Em 19/07/2010 16:18, eric_developer escreveu:
> Não consegui resolver e vou deixar isso de lado.
> Talvez o delphi não permita (mesmo me parecendo tão ilógico) ou é uma
> caixa preta até mesmo para uma lista de quase 5000 pessoas.
>
> Obrigado aquelas que tentaram ajudar, há uns dias o Bruno da
> Embarcadero disse que era possivel, espero que um dia nos mostre como
> rsrs, e que não seja nada que dependa do Delphi 2010 ou 2020.
>
> Grato,
> Eric
>
> --- Em delphi-br@yahoogrupos.com.br
> <mailto:delphi-br%40yahoogrupos.com.br>, "eric_developer"
> <developer.syst...@...> escreveu
> >
> > Boa tarde pessoal,
> >
> > alguem sabe como obter o ponteiro de métodos existentes ? no
> exemplo, se eu criar o método "teste" para o form2, funciona,
> retornando o ponteiro.
> >
> > No lugar de form2, usarei componentes edit, combobox, etc e metodos
> existentes.
> >
> > myCallMethod( edit1, 'SETFOCUS' ) ;
> > myCallMethod( form3, 'SETFOCUS' ) ;
> >
> > procedure TForm2.teste ;
> > begin
> > ShowMessage('OLA');
> > end;
> >
> >
> > procedure TForm2.Button1Click(Sender: TObject);
> > var
> > routine : TMethod ;
> > Begin
> >
> > routine.data:=pointer(form2) ;
> > routine.Code:=Form2.MethodAddress('teste') ; // Nome do metodo
> > if routine.Code <> nil then
> > begin
> > ShowMessage('OK');
> > end;
> >
> > end;
> >
> > Grato,
> > Eric Developer Systems
> >
[As partes desta mensagem que não continham texto foram removidas]
