...alle Klassen finden, die von einer Form Klasse registriert wurden?
Autor: Peter Below
type
PFieldClassTable = ^TFieldClassTable;
TFieldClassTable = packed record
Count: Smallint;
Classes: array[0..8191] of ^TPersistentClass;
end;
function GetFieldClassTable(AClass: TClass): PFieldClassTable; assembler;
asm
MOV EAX,[EAX].vmtFieldTable
OR EAX,EAX
JE @@1
MOV EAX,[EAX+2].Integer
@@1:
end;
procedure TForm1.Button1Click(Sender: TObject);
procedure Display(const S: string);
begin
memo1.Lines.Add(S);
end;
var
pFCT: PFieldClassTable;
aClass: TClass;
i: SmallInt;
begin
memo1.Clear;
aClass := Classtype;
while aClass <> TPersistent do
begin
Display('Registered classes for class ' + aClass.ClassName);
pFCT := GetFieldClasstable(aClass);
if not Assigned(pFCT) then
Display(' No classes registered')
else
begin
Display(Format(' %d classes registered', [pFCT^.Count]));
for i := 0 to pFCT^.Count - 1 do
Display(' ' + pFCT^.Classes[i]^.ClassName);
end;
aClass := aClass.ClassParent;
end
end;
printed from
www.swissdelphicenter.ch
developers knowledge base