Как прочитать весь список Published методов?
Как прочитать весь список Published методов?
procedureEnumMethods( aClass: TClass; lines: TStrings );
type
TMethodtableEntry = packed Record
len: Word;
adr: Pointer;
name: ShortString;
end;
{Note: name occupies only the size required, so it is not a true shortstring! The actual
entry size is variable, so the method table is not an array of TMethodTableEntry!}
var
pp: ^Pointer;
pMethodTable: Pointer;
pMethodEntry: ^TMethodTableEntry;
i, numEntries: Word;
begin
if aClass = nil then
Exit;
pp := Pointer(Integer( aClass ) + vmtMethodtable);
pMethodTable := pp^;
lines.Add(format('Class %s: method table at %p', [aClass.Classname, pMethodTable ] ));
if pMethodtable <> nil then
begin
{first word of the method table contains the number of entries}
numEntries := PWord( pMethodTable )^;
lines.Add(format(' %d published methods', [numEntries] ));
{make pointer to first method entry, it starts at the second word of the table}
pMethodEntry := Pointer(Integer( pMethodTable ) + 2);
for i := 1 to numEntries do
begin
with pMethodEntry^ do
lines.Add(format( ' %d: len: %d, adr: %p, name: %s', [i, len, adr, name] ));
{make pointer to next method entry}
pMethodEntry := Pointer(Integer( pMethodEntry ) + pMethodEntry^.len);
end;
end;
EnumMethods( aClass.ClassParent, lines );
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
memo1.clear;
EnumMethods( Classtype, memo1.lines );
end;
Взято из
function GetComponentProperties(Instance: TPersistent; AList: TStrings): Integer;
var
I, Count: Integer;
PropInfo: PPropInfo;
PropList: PPropList;
begin
Result := 0;
Count := GetTypeData(Instance.ClassInfo)^.PropCount;
if Count > 0 then
begin
GetMem(PropList, Count * SizeOf(Pointer));
try
GetPropInfos(Instance.ClassInfo, PropList);
for I := 0 to Count - 1 do
begin
PropInfo := PropList^[I];
if PropInfo = nil then
Break;
if IsStoredProp(Instance, PropInfo) then
begin
{
case PropInfo^.PropType^.Kind of
tkInteger:
tkMethod:
tkClass:
...
end;
}
end;
Result := AList.Add(PropInfo^.Name);
end;
finally
FreeMem(PropList, Count * SizeOf(Pointer));
end;
end;
end;
Tip by Grega Loboda
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 > 0 then
begin
AList.Add(EmptyStr);
tmpStr := IntToStr(propCnt) + ' Propert';
if propCnt > 1 then
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 := 0 to propCnt - 1 do
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 := 0 to typeData^.PropCount - 1 do
begin
with Props^[i]^ do
if (Name = AProperty) then
result := Props^[i];
end;
finally
FreeMem(props);
end;
end;
And calling this code by:
ListProperties(TProject(treeview1.items[0].data), memo3.lines);
My tProject is defined as
type
TProject = class(tComponent)
private
FNaam: string;
procedure SetNaam(const Value: string);
public
constructor Create(AOwner: tComponent);
destructor Destroy;
published
property Naam: string read FNaam write SetNaam;
end;
Also note the output, there seem to be 2 standard properties (Name and Tag) !
Memo3
Class name: TProject
3 Properties
-------------------
Name: TComponentName
Tag: Integer
Naam: String
Tip by Ronan van Riet