Descobrindo se uma classe descende de uma outra

Criei uma pequena função que me permite dizer se uma classe é descendente de uma outra, utilizando o nome da classe ancestral.

Você pode se perguntar: "Mas qual o objetivo disso? Não é mais fácil usar o operador is?" Por exemplo:

if ActiveControl is TEdit then
  TEdit(ActiveControl).SelectAll;

A resposta é: Depende! O operador is faz uma checagem de tipo dinâmica, mas requer que o TEdit seja conhecido em tempo de compilação e consequentemente requer que o código da classe TEdit esteja linkado no executável. O código acima só compila se a unit StdCtrls (onde está a declaração da classe TEdit) esteja na cláusula uses da unit.

Agora, imagine que você tenha um método onde inúmeras classes podem ser passadas como parâmetro e você não deseja - ou não possa - linkar todas as possíveis classes. Exemplo:

Procedure DoSomething(Instance: TPersistent);

Bem provavelmente você pode pensar: "Mas de quê me serve um método assim se desconheço a classe e não poderei usá-la diretamente?" A resposta é que bem provavelmente você irá utilizar a RTTI diretamente para obter e modificar as propriedades dos objetos referenciados por Instance, assim como faz o nosso conhecido Object Inspector.

Precisei utilizar esta função em algumas classes para saber, por exemplo, se um determinado DataSet era descendente direto do TCustomADODataSet padrão do Delphi, ou de um outro DataSet com linhagem totalmente diferente (TQuery, TSQLQuery), sem ter que linkar com as units ADODB, DBTables e SqlExpr, o que aumentaria consideravelmente o tamanho do meu executável.

Isso me permitiu criar classes de um framework que trabalhavam igualmente bem com ambos os DataSets, SEM QUE O CÓDIGO DE NENHUM DELES FOSSE LINKADO NO MEU EXECUTÁVEL FINAL.

O código é simples e por isto dispensei comentários. Simplesmente faço um loop onde comparo o nome da classe da instância passada como parâmetro com o nome da classe procurada. Se não for igual, passo para o ancestral imediatamente superior e refaço a comparação. Repito até que o resultado seja verdadeiro ou eu chegue ao topo da árvore da hierarquia do objeto.

function PertenceAClasse(const Instance: TObject; ParentClassName: string): boolean;
var
  ParentClass: TClass;
  ObjClassName,
  TargetClassName: string;
begin
    Result := False;
    ObjClassName := UpperCase(Instance.ClassName);
    TargetClassName := UpperCase(ParentClassName);
    ParentClass := Instance.ClassType;
    repeat
      if ObjClassName = TargetClassName then
      begin
        Result := True;
        break;
      end;
      ParentClass := ParentClass.ClassParent;
      if ParentClass <> nil then
       ObjClassName := UpperCase(ParentClass.ClassName);
    until (ParentClass = nil);
end;