Вывести информацию о классах Delphi , Компоненты и Классы , Классы
Вывести информацию о классах
unit ClaForm;
interface
uses
SysUtils, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids,
Dbctrls, Dbgrids, Dblookup, DbTables, Ddeman, Dialogs,
Filectrl, Grids, Mask, Menus, Mplayer, Olectnrs,
Outline, Tabnotbk, Tabs, IniFiles, Printers,
Registry, DsgnIntf, TypInfo;
type
TForm1 = class (TForm)
Listbox1: TListBox;
ListBox2: TListBox;
Splitter1: TSplitter;
procedure Listbox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListBox2Click(Sender: TObject);
public
procedure AddType (pti: PTypeInfo);
end ;
procedure ShowClass (pti: PTypeInfo; sList: TStrings);
// repeated from TypInfo.Pas procedure SortPropList(PropList: PPropList; PropCount: Integer);
var
Form1: TForm1;
implementation
{$R *.DFM} procedure TForm1.Listbox1Click(Sender: TObject);
var
pti: PTypeInfo;
begin
pti := PTypeInfo (ListBox1.Items.Objects [
Listbox1.ItemIndex]);
ListBox2.Items.Clear;
Caption := 'RTTI information for ' +
ListBox1.Items [Listbox1.ItemIndex];
ShowClass (pti, ListBox2.Items);
end ;
// show RTTI information for class type procedure ShowClass (pti: PTypeInfo; sList: TStrings);
var
ptd: PTypeData;
ppi: PPropInfo;
pProps: PPropList;
nProps, I: Integer;
ParentClass: TClass;
begin
// protect against misuse if pti^.Kind <> tkClass then
raise Exception.Create ('Invalid type information');
// get a pointer to the TTypeData structure // access the TTypeInfo structure // access the TTypeData structure {omitted: the same information of pti^.Name...
sList.Add ('ClassType: ' + ptd^.ClassType.ClassName);} // add the list of parent classes (if any) if ParentClass <> nil then
begin
sList.Add ('');
sList.Add ('=== Parent classes ===');
while ParentClass <> nil do
begin
sList.Add (ParentClass.ClassName);
ParentClass := ParentClass.ClassParent;
end ;
end ;
// add the list of properties (if any) if nProps > 0 then
begin
// format the initial output // allocate the required memory // protect the memory allocation try
// fill the TPropList structure // pointed to by pProps // sort the properties // show name and data type of each property for I := 0 to nProps - 1 do
begin
ppi := pProps [I];
sList.Add (ppi.Name + ': ' +
ppi.PropType^.Name);
end ;
finally
// free the allocated memmory end ;
end ;
end ;
procedure TForm1.AddType (pti: PTypeInfo);
begin
ListBox1.Items.AddObject(pti.Name, TObject (pti));
end ;
procedure TForm1.FormCreate(Sender: TObject);
begin
// add classes to the first listbox end ;
// code extracted from TypInfo.pas procedure SortPropList(PropList: PPropList; PropCount: Integer); assembler ;
asm
{ -> EAX Pointer to prop list } { EDX Property count } { <- nothing } XOR EAX,EAX
DEC EDX
CALL @@qsort
POP EDI
POP ESI
POP EBX
JMP @@exit
@@qsort:
PUSH EAX
PUSH EDX
LEA EDI,[EAX+EDX] { pivot := (left + right) div 2 } SHR EDI,1
MOV EDI,[ECX+EDI*4]
ADD EDI,OFFSET TPropInfo.Name
@@repeat : { repeat } { while a[i] < a[pivot] do inc(i);} { while a[j] > a[pivot] do dec(j);} { if i <= j then begin } { x := a[i]; } { y := a[j]; } { a[j] := x; } { a[i] := y; } { inc(i); } { dec(j); } { end; } { until i > j; } repeat
@@endRepeat:
POP ESI
POP EBX
CMP EAX,ESI
JL @@rightNonEmpty { if i >= right then begin } { if j <= left then exit } { qsort(left, j) } { qsort(i, right) } { qsort(left, j) } { qsort(i, right) } XOR EBX,EBX
MOV BL,[ESI]
INC ESI
CMP BL,[EDI]
JBE @@firstLenSmaller
MOV BL,[EDI]
@@firstLenSmaller:
INC EDI
TEST BL,BL
JE @@endLoop
@@loop:
MOV AL,[ESI]
MOV AH,[EDI]
AND EAX,$DFDF
CMP AL,AH
JNE @@difference
INC ESI
INC EDI
DEC EBX
JNZ @@loop
@@endLoop:
POP ESI
POP EDI
MOV AL,[ESI]
MOV AH,[EDI]
CMP AL,AH
POP EAX
RET
@@difference:
POP ESI
POP EDI
POP EAX
RET
@@exit:
end ;
procedure TForm1.ListBox2Click(Sender: TObject);
var
Text: string ;
Index : Integer;
pti: PTypeInfo;
begin
// get the current item // search the first listbox Index := ListBox1.Items.IndexOf (Text);
// if found, it was a parent class: show RTTI if Index >= 0 then
begin
pti := PTypeInfo (ListBox1.Items.Objects [Index ]);
Caption := 'RTTI information for ' + Text;
ListBox2.Items.Clear;
ShowClass (pti, ListBox2.Items);
end ;
end ;
end .
Загрузить весь проект
Программа на Delphi, которая отображает информацию о типе выполнения (RTTI) для различных классов в библиотеке VCL. Проект состоит из единственной формы с двумя списками и несколькими кнопками.
Вот обзор того, как проект работает:
Обработчик события FormCreate пополняет первый список классами из библиотеки VCL.
Когда вы выбираете имя класса в первом списке, обработчик события Listbox1Click вызывает процедуру ShowClass, чтобы отобразить информацию RTTI для этого класса во втором списке.
Процедура ShowClass принимает два параметра: указатель на PTypeInfo и объект TStrings. Она использует эти параметры, чтобы получить и отобразить информацию RTTI для указанного класса.
Когда вы выбираете элемент из второго списка, обработчик события ListBox2Click ищет этот элемент в первом списке. Если он найден, то вызывает процедуру ShowClass снова, чтобы отобразить информацию RTTI для этого класса.
Отображаемая информация RTTI включает имя класса, тип, размер и список свойств с их именами и типами данных.
Обратите внимание, что этот проект использует встроенные функции RTTI Delphi, которые являются частью библиотеки VCL. Тип PTypeInfo используется для представления указателя на структуру информации о типе, а процедура ShowClass использует различные функции из единицы TypInfo, чтобы получить и отобразить информацию RTTI.
Если вы хотите узнать больше о функциях RTTI Delphi или вам нужна помощь с их реализацией в вашем проекте, я готов помочь вам.
"Вывести информацию о классах" - это программный код на языке Pascal, который выводит информацию о классах в формате RTTI (Run-Time Type Information). Код содержит список из более 100 классов Delphi, которые добавляются в список listBox1.
Комментарии и вопросы Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
:: Главная :: Классы ::
Telegram-канал