Узнать класс формы

Материал из DRKB

Узнать класс формы[править | править код]

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;


ID: 00430