Получить информацию о классе

Delphi , Компоненты и Классы , Классы

Автор: Xavier Pacheco

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, DBClient, MidasCon, MConnect;

type

  TMainForm = class(TForm)
    pnlTop: TPanel;
    pnlLeft: TPanel;
    lbBaseClassInfo: TListBox;
    spSplit: TSplitter;
    lblBaseClassInfo: TLabel;
    pnlRight: TPanel;
    lblClassProperties: TLabel;
    lbPropList: TListBox;
    lbSampClasses: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure lbSampClassesClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation
uses TypInfo;

{$R *.DFM}

function CreateAClass(const AClassName: string): TObject;
{ This method illustrates how you can create a class from the class name. Note
  that this requires that you register the class using RegisterClasses() as
  show in the initialization method of this unit. }
var
  C: TFormClass;
  SomeObject: TObject;
begin
  C := TFormClass(FindClass(AClassName));
  SomeObject := C.Create(nil);
  Result := SomeObject;
end;

procedure GetBaseClassInfo(AClass: TObject; AStrings: TStrings);
{ This method obtains some basic RTTI data from the given object and adds that
  information to the AStrings parameter. }
var
  ClassTypeInfo: PTypeInfo;
  ClassTypeData: PTypeData;
  EnumName: string;
begin
  ClassTypeInfo := AClass.ClassInfo;
  ClassTypeData := GetTypeData(ClassTypeInfo);
  with AStrings do
  begin
    Add(Format('Class Name:     %s', [ClassTypeInfo.Name]));
    EnumName := GetEnumName(TypeInfo(TTypeKind), Integer(ClassTypeInfo.Kind));
    Add(Format('Kind:           %s', [EnumName]));
    Add(Format('Size:           %d', [AClass.InstanceSize]));
    Add(Format('Defined in:     %s.pas', [ClassTypeData.UnitName]));
    Add(Format('Num Properties: %d', [ClassTypeData.PropCount]));
  end;
end;

procedure GetClassAncestry(AClass: TObject; AStrings: TStrings);
{ This method retrieves the ancestry of a given object and adds the
  class names of the ancestry to the AStrings parameter. }
var
  AncestorClass: TClass;
begin
  AncestorClass := AClass.ClassParent;
  { Iterate through the Parent classes starting with Sender's
    Parent until the end of the ancestry is reached. }
  AStrings.Add('Class Ancestry');
  while AncestorClass <> nil do
  begin
    AStrings.Add(Format('    %s', [AncestorClass.ClassName]));
    AncestorClass := AncestorClass.ClassParent;
  end;
end;

procedure GetClassProperties(AClass: TObject; AStrings: TStrings);
{ This method retrieves the property names and types for the given object
  and adds that information to the AStrings parameter. }
var
  PropList: PPropList;
  ClassTypeInfo: PTypeInfo;
  ClassTypeData: PTypeData;
  i: integer;
  NumProps: Integer;
begin

  ClassTypeInfo := AClass.ClassInfo;
  ClassTypeData := GetTypeData(ClassTypeInfo);

  if ClassTypeData.PropCount <> 0 then
  begin
    // allocate the memory needed to hold the references to the TPropInfo
    // structures on the number of properties.
    GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
    try
      // fill PropList with the pointer references to the TPropInfo structures
      GetPropInfos(AClass.ClassInfo, PropList);
      for i := 0 to ClassTypeData.PropCount - 1 do
        // filter out properties that are events ( method pointer properties)
        if not (PropList[i]^.PropType^.Kind = tkMethod) then
          AStrings.Add(Format('%s: %s', [PropList[i]^.Name,
            PropList[i]^.PropType^.Name]));

      // Now get properties that are events (method pointer properties)
      NumProps := GetPropList(AClass.ClassInfo, [tkMethod], PropList);
      if NumProps <> 0 then
      begin
        AStrings.Add('');
        AStrings.Add('   EVENTS   ================ ');
        AStrings.Add('');
      end;
      // Fill the AStrings with the events.
      for i := 0 to NumProps - 1 do
        AStrings.Add(Format('%s: %s', [PropList[i]^.Name,
          PropList[i]^.PropType^.Name]));

    finally
      FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
    end;
  end;

end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  // Add some example classes to the list box.
  lbSampClasses.Items.Add('TApplication');
  lbSampClasses.Items.Add('TButton');
  lbSampClasses.Items.Add('TForm');
  lbSampClasses.Items.Add('TListBox');
  lbSampClasses.Items.Add('TPaintBox');
  lbSampClasses.Items.Add('TMidasConnection');
  lbSampClasses.Items.Add('TFindDialog');
  lbSampClasses.Items.Add('TOpenDialog');
  lbSampClasses.Items.Add('TTimer');
  lbSampClasses.Items.Add('TComponent');
  lbSampClasses.Items.Add('TGraphicControl');
end;

procedure TMainForm.lbSampClassesClick(Sender: TObject);
var
  SomeComp: TObject;
begin
  lbBaseClassInfo.Items.Clear;
  lbPropList.Items.Clear;

  // Create an instance of the selected class.
  SomeComp := CreateAClass(lbSampClasses.Items[lbSampClasses.ItemIndex]);
  try
    GetBaseClassInfo(SomeComp, lbBaseClassInfo.Items);
    GetClassAncestry(SomeComp, lbBaseClassInfo.Items);
    GetClassProperties(SomeComp, lbPropList.Items);
  finally
    SomeComp.Free;
  end;
end;

initialization
  begin
    RegisterClasses([TApplication, TButton, TForm, TListBox, TPaintBox,
      TMidasConnection, TFindDialog, TOpenDialog, TTimer, TComponent,
        TGraphicControl]);
  end;

end.

Программа на языке Object Pascal в среде Delphi, демонстрирующая создание и управление классами.

Основная форма

Основная форма (TMainForm) - это графический пользовательский интерфейс (GUI), отображающий информацию о различных классах. Она содержит следующие компоненты:

1. pnlTop: верхняя панель с меткой.
2. pnlLeft: левая панель с списком (lbBaseClassInfo).
3. spSplit: разделитель, разделяющий панели.
4. lblBaseClassInfo: метка, отображающая информацию о классе.
5. pnlRight: правая панель с двумя списками: lbPropList и lbSampClasses.
6. lblClassProperties: метка, отображающая информацию о свойствах класса.
7. lbPropList: список, отображающий имена свойств и типы.

Создание класса

Функция CreateAClass создает экземпляр класса, передавая имя класса в виде строки. Она использует метод RegisterClasses для регистрации классов в секции инициализации модуля.

Получение информации о базовом классе

Процедура GetBaseClassInfo получает основные сведения о типе времени выполнения (RTTI) из класса и добавляет их в список lbBaseClassInfo. Информация включает:

1. Имя класса.
2. Тип (например, объект, класс, интерфейс).
3. Размер экземпляра.
4. Имя модуля, где определен класс.
5. Количество свойств.

Получение предков

Процедура GetClassAncestry получает предков класса и добавляет их в список lbBaseClassInfo. Она перебирает родительские классы до тех пор, пока не достигнет конца предка.

Получение свойств класса

Процедура GetClassProperties получает имена и типы свойств для класса и добавляет их в список lbPropList. Она использует структуры PPropList и TTypeData, чтобы перебрать свойства и получить информацию о них.

Событие создания формы

В событии FormCreate добавляются несколько примеров классов в список lbSampClasses.

Событие клика по lbSampClasses

Когда пользователь выбирает класс из списка lbSampClasses и нажимает на него, происходят следующие действия:

1. Создается экземпляр выбранного класса с помощью функции CreateAClass.
2. Получается информация о базовом классе с помощью процедуры GetBaseClassInfo.
3. Получается предок класса с помощью процедуры GetClassAncestry.
4. Получаются свойства класса с помощью процедуры GetClassProperties.
5. Созданный объект освобождается, чтобы предотвратить утечки памяти.

В целом, это проект демонстрирует создание и управление классами в Delphi, а также получение информации о типе времени выполнения (RTTI) о классах.

В статье описывается механизм работы с классами в Delphi, включая получение информации о классе, его наследии и свойствах.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Классы ::