terça-feira, 30 de março de 2010

Verificando a hierarquia de uma determinada classe

Eventualmente queremos saber a hierarquia de uma determinada classe.

Eu lanço mão do seguinte algoritmo:

function GetClassHierarchy(poList: TStringList; oClassBase: TClass): Boolean;
var
oClass: TClass;
begin
  Result := False;
  if (Assigned(poList)) then
  begin
    poList.Clear;
    oClass := oClassBase;
    while (Assigned(oClass)) do
    begin
      poList.Insert(0,oClass.ClassName);
      oClass := oClass.ClassParent;
    end;
  end;
end;

Exemplo da utilização:

procedure TForm1.Button9Click(Sender: TObject);
var
slList : TStringList;
begin
  slList := TStringList.Create;
  Unt_RotinasLog.GetClassHierarchy(slList,TSQLQuery);
  Self.Memo1.Lines.Text := slList.Text;
  FreeAndNil(slList);
end;

Resultado para o exemplo acima:

TObject
TPersistent
TComponent
TDataSet
TWideDataSet
TCustomSQLDataSet
TSQLQuery

Show!

Um comentário:

Silvio Clécio • Blog disse...

Legal :)

E como ele não retorna resultado, poderia transformá-la em procedure:

(...)
procedure GetClassHierarchy(var poList: TStringList; const oClassBase: TClass);
var
oClass: TClass;
begin
if Assigned(poList) and Assigned(oClassBase) then
begin
poList.Clear;
oClass := oClassBase;
while Assigned(oClass) do
begin
poList.Insert(0, oClass.ClassName);
oClass := oClass.ClassParent;
end;
end;
end;
(...)

(melhor visualiada em: http://pastebin.com/cFvpLrfS)

Valeu a dica ;)

Minha lista de blogs