Delphi: At runtime find classes that descend from a given base class?

前端 未结 3 1744

Is there at way, at runtime, to find all classes that descend from a particular base class?

For example, pretend there is a class:

TLocalization = cl         


        
3条回答
  •  一生所求
    2020-12-16 04:29

    Ian, as Mason says the TRttiContext.GetTypes function get the list of all RTTI objects that provide type information . but this function was introduced in Delphi 2010.

    As workaround you can inherit your base class from the TPersistent class and then register manually every class using the RegisterClass function (i know wich this is annoying).

    then using the TClassFinder object you can retrieve all the registered classes.

    see this sample

    type
      TForm12 = class(TForm)
        Memo1: TMemo; // a TMemo to show the classes in this example
        ButtonInhertisFrom: TButton;
        procedure FormCreate(Sender: TObject);
        procedure ButtonInhertisFromClick(Sender: TObject);
      private
        { Private declarations }
        RegisteredClasses : TStrings; //The list of classes
        procedure GetClasses(AClass: TPersistentClass); //a call procedure used by TClassFinder.GetClasses
      public
        { Public declarations }
      end;
    
      TTestCase = class (TPersistent) //Here is your base class 
      end;
    
      TTestCaseChild1 = class (TTestCase) //a child class , can be in any place in your application
      end;
    
      TTestCaseChild2 = class (TTestCase)//another child class
      end;
    
      TTestCaseChild3 = class (TTestCase)// and another child class
      end;
    
    var
      Form12: TForm12;
    
    implementation
    
    {$R *.dfm}
    
    //Function to determine if a class Inherits directly from another given class
    function InheritsFromExt(Instance: TPersistentClass;AClassName: string): Boolean; 
    var
      DummyClass : TClass;
    begin
      Result := False;
      if Assigned(Instance) then
      begin
        DummyClass := Instance.ClassParent;
        while DummyClass <> nil do
        begin
          if SameText(DummyClass.ClassName,AClassName) then
          begin
            Result := True;
            Break;
          end;
          DummyClass := DummyClass.ClassParent;
        end;
      end;
    end;
    
    procedure TForm12.ButtonInhertisFromClick(Sender: TObject);
    var
    Finder       : TClassFinder;
    i            : Integer;
    begin
      Finder     := TClassFinder.Create();
      try
       RegisteredClasses.Clear; //Clear the list
       Finder.GetClasses(GetClasses);//Get all registered classes
       for i := 0 to RegisteredClasses.Count-1 do
         //check if inherits directly from TTestCase
         if InheritsFromExt(TPersistentClass(RegisteredClasses.Objects[i]),'TTestCase') then
         //or you can use , if (TPersistentClass(RegisteredClasses.Objects[i]).ClassName<>'TTestCase') and  (TPersistentClass(RegisteredClasses.Objects[i]).InheritsFrom(TTestCase)) then //to check if a  class derive from TTestCase not only directly
         Memo1.Lines.Add(RegisteredClasses[i]); //add the classes to the Memo 
      finally
      Finder.Free;
      end;
    end;
    
    procedure TForm12.FormCreate(Sender: TObject);
    begin
      RegisteredClasses := TStringList.Create;
    end;
    
    procedure TForm12.GetClasses(AClass: TPersistentClass);//The cllaback function to fill the list of classes
    begin
      RegisteredClasses.AddObject(AClass.ClassName,TObject(AClass));
    end;
    
    
    initialization
    //Now the important part, register the classes, you can do this in any place in your app , i choose this location just for the example
      RegisterClass(TTestCase);
      RegisterClass(TTestCaseChild1);
      RegisterClass(TTestCaseChild2);
      RegisterClass(TTestCaseChild3);
    end.
    

    UPDATE

    I'm sorry, but apparently the TClassFinder class was introduced in Delphi 6

提交回复
热议问题