RTTI и другие трюки с информацией о классах, модулях и т.п.

Code:

unit PropertyList;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;

type

TMyStream = class(TFileStream)

private

FFred: integer;

published

property Fred: integer read FFred write FFred;

end;

type

TFrmPropertyList = class(TForm)

SpeedButton1: TSpeedButton;

ListBox1: TListBox;

procedure SpeedButton1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmPropertyList: TFrmPropertyList;

implementation

{$R *.DFM}

uses

TypInfo;

procedure ListProperties(AInstance: TPersistent; AList: TStrings);

var

i: integer;

pInfo: PTypeInfo;

pType: PTypeData;

propList: PPropList;

propCnt: integer;

tmpStr: string;

begin

pInfo := AInstance.ClassInfo;

if (pInfo = nil) or (pInfo^.Kind <> tkClass) then

   raise Exception.Create('Invalid type information');

pType := GetTypeData(pInfo);  {Pointer to TTypeData}

AList.Add('Class name: ' + pInfo^.Name);

{If any properties, add them to the list}

propCnt := pType^.PropCount;

if propCnt > 0then

begin

   AList.Add (EmptyStr);

   tmpStr := IntToStr(propCnt) + ' Propert';

   if propCnt > 1then

     tmpStr := tmpStr + 'ies'

   else

     tmpStr := tmpStr + 'y';

   AList.Add(tmpStr);

   FillChar(tmpStr[1], Length(tmpStr), '-');

   AList.Add(tmpStr);

   {Get memory for the property list}

   GetMem(propList, sizeOf(PPropInfo) * propCnt);

   try

     {Fill in the property list}

     GetPropInfos(pInfo, propList);

     {Fill in info for each property}

     for i := 0to propCnt - 1do

       AList.Add(propList[i].Name + ': ' + propList[i].PropType^.Name);

   finally

     FreeMem(propList, sizeOf(PPropInfo) * propCnt);

   end;

end;

end;

function GetPropertyList(AControl: TPersistent; AProperty: string): PPropInfo;

var

i: integer;

props: PPropList;

typeData: PTypeData;

begin

Result := nil;

if (AControl = nil) or (AControl.ClassInfo = nil) then

   Exit;

typeData := GetTypeData(AControl.ClassInfo);

if (typeData = nil) or (typeData^.PropCount = 0) then

   Exit;

GetMem(props, typeData^.PropCount * SizeOf(Pointer));

try

   GetPropInfos(AControl.ClassInfo, props);

   for i := 0to typeData^.PropCount - 1do

   begin

     with Props^[i]^ do

       if (Name = AProperty) then

         result := Props^[i];

   end;

finally

   FreeMem(props);

end;

end;

procedure TFrmPropertyList.SpeedButton1Click(Sender: TObject);

var

c: integer;

begin

ListProperties(self, ListBox1.Items);

for c := 0to ComponentCount - 1do

begin

   ListBox1.Items.Add(EmptyStr);

   ListProperties(Components[c], ListBox1.Items);

end;

end;

end.