实现关键:TTypeInfo
方法自己找

解决方案 »

  1.   

    前两天从CSDN一个帖子上拷出来的,不记得帖子号了。
    ====================================================
    unit MainFrm;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls, ExtCtrls, DBClient, MidasCon, MConnect;type  TMainForm = class(TForm)
        pnlTop: TPanel;
        pnlLeft: TPanel;
        lbBaseClassInfo: TListBox;
        spSplit: TSplitter;
        lblBaseClassInfo: TLabel;
        pnlRight: TPanel;
        lblClassProperties: TLabel;
        lbPropList: TListBox;
        lbSampClasses: TListBox;
        procedure FormCreate(Sender: TObject);
        procedure lbSampClassesClick(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      MainForm: TMainForm;implementation
    uses TypInfo;{$R *.DFM}function CreateAClass(const AClassName: string): TObject;
    { This method illustrates how you can create a class from the class name. Note
      that this requires that you register the class using RegisterClasses() as
      show in the initialization method of this unit. }
    var
      C : TFormClass;
      SomeObject: TObject;
    begin
      C := TFormClass(FindClass(AClassName));
      SomeObject := C.Create(nil);
      Result := SomeObject;
    end;
    procedure GetBaseClassInfo(AClass: TObject; AStrings: TStrings);
    { This method obtains some basic RTTI data from the given object and adds that
      information to the AStrings parameter. }
    var
      ClassTypeInfo: PTypeInfo;
      ClassTypeData: PTypeData;
      EnumName: String;
    begin
      ClassTypeInfo := AClass.ClassInfo;
      ClassTypeData := GetTypeData(ClassTypeInfo);
      with AStrings do
      begin
        Add(Format('Class Name:     %s', [ClassTypeInfo.Name]));
        EnumName := GetEnumName(TypeInfo(TTypeKind), Integer(ClassTypeInfo.Kind));
        Add(Format('Kind:           %s', [EnumName]));
        Add(Format('Size:           %d', [AClass.InstanceSize]));
        Add(Format('Defined in:     %s.pas', [ClassTypeData.UnitName]));
        Add(Format('Num Properties: %d',[ClassTypeData.PropCount]));
      end;
    end;procedure GetClassAncestry(AClass: TObject; AStrings: TStrings);
    { This method retrieves the ancestry of a given object and adds the
      class names of the ancestry to the AStrings parameter. }
    var
      AncestorClass: TClass;
    begin
      AncestorClass := AClass.ClassParent;
      { Iterate through the Parent classes starting with Sender's
        Parent until the end of the ancestry is reached. }
      AStrings.Add('Class Ancestry');
      while AncestorClass <> nil do
      begin
        AStrings.Add(Format('    %s',[AncestorClass.ClassName]));
        AncestorClass := AncestorClass.ClassParent;
      end;
    end;
    procedure GetClassProperties(AClass: TObject; AStrings: TStrings);
    { This method retrieves the property names and types for the given object
      and adds that information to the AStrings parameter. }
    var
      PropList: PPropList;
      ClassTypeInfo: PTypeInfo;
      ClassTypeData: PTypeData;
      i: integer;
      NumProps: Integer;
    begin  ClassTypeInfo := AClass.ClassInfo;
      ClassTypeData := GetTypeData(ClassTypeInfo);  if ClassTypeData.PropCount <> 0 then
      begin
        // allocate the memory needed to hold the references to the TPropInfo
        // structures on the number of properties.
        GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
        try
          // fill PropList with the pointer references to the TPropInfo structures
          GetPropInfos(AClass.ClassInfo, PropList);
          for i := 0 to ClassTypeData.PropCount - 1 do
            // filter out properties that are events ( method pointer properties)
            if not (PropList[i]^.PropType^.Kind = tkMethod) then
              AStrings.Add(Format('%s: %s', [PropList[i]^.Name, PropList[i]^.PropType^.Name]));      // Now get properties that are events (method pointer properties)
          NumProps := GetPropList(AClass.ClassInfo, [tkMethod], PropList);
          if NumProps <> 0 then begin
            AStrings.Add('');
            AStrings.Add('   EVENTS   ================ ');
            AStrings.Add('');
          end;
          // Fill the AStrings with the events. 
          for i := 0 to NumProps - 1 do
              AStrings.Add(Format('%s: %s', [PropList[i]^.Name, PropList[i]^.PropType^.Name]));    finally
          FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
        end;
      end;end;procedure TMainForm.FormCreate(Sender: TObject);
    begin
      // Add some example classes to the list box.
      lbSampClasses.Items.Add('TApplication');
      lbSampClasses.Items.Add('TButton');
      lbSampClasses.Items.Add('TForm');
      lbSampClasses.Items.Add('TListBox');
      lbSampClasses.Items.Add('TPaintBox');
      lbSampClasses.Items.Add('TMidasConnection');
      lbSampClasses.Items.Add('TFindDialog');
      lbSampClasses.Items.Add('TOpenDialog');
      lbSampClasses.Items.Add('TTimer');
      lbSampClasses.Items.Add('TComponent');
      lbSampClasses.Items.Add('TGraphicControl');
    end;procedure TMainForm.lbSampClassesClick(Sender: TObject);
    var
      SomeComp: TObject;
    begin
      lbBaseClassInfo.Items.Clear;
      lbPropList.Items.Clear;  // Create an instance of the selected class. 
      SomeComp := CreateAClass(lbSampClasses.Items[lbSampClasses.ItemIndex]);
      try
        GetBaseClassInfo(SomeComp, lbBaseClassInfo.Items);
        GetClassAncestry(SomeComp, lbBaseClassInfo.Items);
        GetClassProperties(SomeComp, lbPropList.Items);
      finally
        SomeComp.Free;
      end;
    end;initialization
    begin
      RegisterClasses([TApplication, TButton, TForm, TListBox, TPaintBox,
        TMidasConnection, TFindDialog, TOpenDialog, TTimer, TComponent,
        TGraphicControl]);
    end;end.