Ir al contenido


Foto

Obtener todos los metodos de una clase Utilizando RTTI


  • Por favor identifícate para responder
2 respuestas en este tema

#1 genriquez

genriquez

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 539 mensajes
  • LocationCali, Colombia

Escrito 09 diciembre 2013 - 01:37

Hace poco tuve que obtener los métodos de una clase, para ello utilicé el Run Time Type Information.  aquí les dejo una rutina que se puede utilizar para cualquier clase de Delphi.



delphi
  1. Function GetClassInfo1(AClass: TPersistentClass; AMethods : TStringList) : Boolean;
  2. var
  3.   LMethod: TRttiMethod;
  4.   LParam: TRttiParameter;
  5.   LParams: TArray<TRttiParameter>;
  6.   SParamFlag: String;
  7.   S : String;
  8.   SFunctRes : String;
  9.   sReturnType, sProcType, sMethodName: String;
  10.  
  11.   t: TRttiInstanceType;
  12.   c: TRttiContext;
  13.  
  14. begin
  15.  
  16.   c := TRttiContext.Create;
  17.   t := (c.GetType(AClass) as TRttiInstanceType);
  18.  
  19.   If not Assigned(T) then
  20.   Begin
  21.       Result := False;
  22.       Exit;
  23.   End;
  24.  
  25.   Result := True;
  26.  
  27.   for LMethod in t.GetMethods do
  28.   Begin
  29.       sMethodName := LMethod.Name;
  30.  
  31.       LParams := LMethod.GetParameters;
  32.  
  33.       S := '';
  34.       For LParam in LParams do
  35.       Begin
  36.         SParamFlag := '';
  37.  
  38.         if pfvar in LParam.Flags then
  39.             SParamFlag := SParamFlag + 'var ';
  40.         if pfConst in LParam.Flags then
  41.             SParamFlag := SParamFlag + 'Const ';
  42.         if pfArray in LParam.Flags then
  43.             SParamFlag := SParamFlag + 'Array ';
  44.         if pfAddress in LParam.Flags then
  45.             SParamFlag := SParamFlag + 'Address ';
  46.         if pfReference in LParam.Flags then
  47.             SParamFlag := SParamFlag + 'References ';
  48.         if pfOut in LParam.Flags then
  49.             SParamFlag := SParamFlag + 'Out ';
  50.         if pfResult in LParam.Flags then
  51.             SParamFlag := SParamFlag + 'Result ';
  52.  
  53.         S := S + SParamFlag + LParam.Name;
  54.         If Assigned(LParam.ParamType) then
  55.             S := S + ' : ' + LParam.ParamType.ToString+'; ';
  56.       End;
  57.  
  58.       If (S <> '') and (Copy(S, Length(S)-1) = '; ') then
  59.         S := Copy(S, 1, Length(S)-2);
  60.  
  61.  
  62.       If Assigned(LMethod.ReturnType) then
  63.       Begin
  64.         sReturnType := ' : ' + LMethod.ReturnType.ToString;
  65.         sProcType := 'Function ';
  66.       End
  67.       Else
  68.       Begin
  69.         sReturnType := '';
  70.         sProcType := 'Procedure ';
  71.       End;
  72.  
  73.       SFunctRes := aclass.ClassName+'.'+sProcType + sMethodName + '(' + S + ')' + sReturnType;
  74.       SFunctRes := StringReplace(SFunctRes, '()','',[rfReplaceAll]);
  75.  
  76.  
  77.       AMethods.Add(sFunctRes);
  78.   End;
  79. End;
  80.  
  81.  
  82. procedure TForm28.Button1Click(Sender: TObject);
  83. var
  84.   AClass: TPersistentClass;
  85.   AMethods : TStringList;
  86. Begin
  87.   AMethods := TStringList.Create;
  88.   AClass := GetClass('TForm');
  89.   GetClassInfo(AClass, AMethods);
  90.   Memo1.Lines.AddStrings(AMethods);
  91. End;



Si mejoran este procedimiento me envían copia. 

Saludos
  • 0

#2 poliburro

poliburro

    Advanced Member

  • Administrador
  • 4.945 mensajes
  • LocationMéxico

Escrito 09 diciembre 2013 - 01:57

Que interesante, gracias por compartir.
  • 0

#3 ELKurgan

ELKurgan

    Advanced Member

  • Miembro Platino
  • PipPipPip
  • 566 mensajes
  • LocationEspaña

Escrito 10 diciembre 2013 - 02:34

Grracias por el aporte

(y)
  • 0




IP.Board spam blocked by CleanTalk.