GT Delphi Components – Freeware Components

Posts Tagged ‘registered classes’

This demo will demonstrate the usage of the TgtRegisteredClasses component on how to list all registered classes in a delphi application.

This is the actual code of the demo

procedure TForm1.btnGetClassesClick(Sender: TObject);
begin
  ListBox1.Items.Clear;
  ListBox1.Items.AddStrings(RegisteredClasses.ClassList);
end;

procedure TForm1.btnRegisterClassesClick(Sender: TObject);
begin
  RegisterClass(TWinControl);
  RegisterClass(TButton);
end;

The btnGetClasses lists all registered classes in the listbox and the btnRegisterClasses
registers some new classes.
Press first the btnGetClasses then the btnRegisterClasses to see the diference.

Download the soure code of the Class Finder Demo

This demo is using the TgtRegisteredClasses component

The TgtRegisteredClasses is a TComponent descentant which can list all registered classes in a delphi application into a TStrings. It also has two procedures that implement an extension of the standard TObject procedure
InheritsFrom.
Here is the source code.

TgtClassFinder is included in GT Component Pack

{*******************************}
   GT Delphi Components
   TgtRegisteredClasses                    

   Copyright (c) GT Delphi Components
   http://www.gtdelphicomponents.gr
{*******************************}

unit lo_ClassFinder;

interface
  uses
    Classes
    ;
type
  TgtRegisteredClasses = class(TComponent)
  private
    { Private declarations }
    FRegisteredClasses : TStrings;
    FClassFinder       : TClassFinder;
    procedure GetClassCallBack(AClass: TPersistentClass);
    function GetRegisteredClasses: TStrings;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);override;
    destructor  Destroy;override;
  public
    function IsRegisteredClass(const AClassName : string):Boolean;
    function InheritsFrom(Instance : TComponent; AClassName :string):Boolean;overload;
    function InheritsFrom(Instance : TPersistentClass; AClassName :string):Boolean;overload;
  public
    property ClassList : TStrings  read GetRegisteredClasses;
  published
    { Published declarations}
  end;

function RegisteredClasses:TgtRegisteredClasses;

implementation
uses
  SysUtils
  ;

var
  _RegisteredClasses : TgtRegisteredClasses;

function RegisteredClasses:TgtRegisteredClasses;
begin
   if not Assigned(_RegisteredClasses) then
    _RegisteredClasses := TgtRegisteredClasses.Create(nil);
  Result := _RegisteredClasses;
end;

{ TRegisteredClasses }
{--------------------------------------------------}
constructor TgtRegisteredClasses.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRegisteredClasses := TStringList.Create;
  FClassFinder       := TClassFinder.Create();
end;
{--------------------------------------------------}
destructor TgtRegisteredClasses.Destroy;
begin
  FreeAndNil(FRegisteredClasses);
  FClassFinder.Free;
  inherited;
end;
{--------------------------------------------------}
procedure TgtRegisteredClasses.GetClassCallBack(AClass: TPersistentClass);
begin
  FRegisteredClasses.AddObject(AClass.ClassName,TObject(AClass));
end;
{--------------------------------------------------}
function TgtRegisteredClasses.GetRegisteredClasses: TStrings;
begin
  FRegisteredClasses.Clear;
  FClassFinder.GetClasses(GetClassCallBack);
  Result := FRegisteredClasses;
end;
{--------------------------------------------------}
function TgtRegisteredClasses.IsRegisteredClass(const AClassName: string): Boolean;
begin
  Result := ClassList.IndexOf(AClassName) <> -1;
end;
{--------------------------------------------------}
function TgtRegisteredClasses.InheritsFrom(Instance: TPersistentClass;AClassName: string): Boolean;
var
  AClass : TClass;
begin
  Result := False;
  if Assigned(Instance) then
  begin
    AClass := Instance.ClassParent;
    while AClass <> nil do
    begin
      if SameText(AClass.ClassName,AClassName) then
      begin
        Result := True;
        Break;
      end;
      AClass := AClass.ClassParent;
    end;
  end;
end;
{--------------------------------------------------}
function TgtRegisteredClasses.InheritsFrom(Instance : TComponent; AClassName :string):Boolean;
var
  AClass : TClass;
begin
  Result := False;
  if Assigned(Instance) then
  begin
    AClass := Instance.ClassParent;
    while AClass <> nil do
    begin
      if SameText(AClass.ClassName,AClassName) then
      begin
        Result := True;
        Break;
      end;
      AClass := AClass.ClassParent;
    end;
  end;
end;
{--------------------------------------------------}

initialization

finalization
  if Assigned(_RegisteredClasses) then
    FreeAndNil(_RegisteredClasses);

end.