类信息查看

unit Unit2;

interface

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

type
  TinfoForm = class(TForm)
    Label3: TLabel;
    ListClasses: TListBox;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    ListParent: TListBox;
    EditInfo: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure ListClassesClick(Sender: TObject);
  private
    ClassArray: array of TClass;
  public
    { Public declarations }
  end;

var
  infoForm: TinfoForm;

implementation

{$R *.dfm}

procedure TinfoForm.FormCreate(Sender: TObject);
var
 i: Integer;
begin
  SetLength(ClassArray,50);

  ClassArray [0] := TButton;
  ClassArray [1] := TBitBtn;
  ClassArray [2] := TEdit;
  ClassArray [3] := TSpeedbutton;
  ClassArray [4] := TRadioButton;
  ClassArray [5] := TRadioGroup;
  ClassArray [6] := TPanel;
  ClassArray [7] := TCheckBox;
  ClassArray [8] := TForm;
  ClassArray [9] := TComboBox;
  ClassArray [10] := TGroupBox;
  ClassArray [11] := TSpeedButton;
  ClassArray [12] := TLabel;
  ClassArray [13] := TListBox;
  ClassArray [14] := TMemo;

  for I := 0 to 15 do
   ListClasses.Items.Add(ClassArray[i].ClassName);
  ListClasses.ItemIndex := 0;
 ListClassesClick(nil);
end;

procedure TinfoForm.ListClassesClick(Sender: TObject);
var
 MyClass: TClass;
begin
   MyClass := ClassArray[ListClasses.ItemIndex];
   EditInfo.Text := Format('Name:%s - Size:%d',[MyClass.ClassName,MyClass.InstanceSize]);
   ListParent.Clear;
   with ListParent.Items do
   begin
      while MyClass.ClassParent <> nil do
      begin
         MyClass := MyClass.ClassParent;
         Add(MyClass.ClassName);
      end;

   end;
end;

end.

　　

object infoForm: TinfoForm
  Left = 0
  Top = 0
  Caption = 'infoForm'
  ClientHeight = 202
  ClientWidth = 383
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label3: TLabel
    Left = 8
    Top = 8
    Width = 55
    Height = 13
    Caption = 'Class Name'
  end
  object ListClasses: TListBox
    Left = 8
    Top = 24
    Width = 153
    Height = 177
    ItemHeight = 13
    TabOrder = 0
    OnClick = ListClassesClick
  end
  object Panel1: TPanel
    Left = 168
    Top = 8
    Width = 209
    Height = 193
    Caption = 'Panel1'
    TabOrder = 1
    object Label1: TLabel
      Left = 8
      Top = 48
      Width = 62
      Height = 13
      Caption = 'Base Classes'
    end
    object Label2: TLabel
      Left = 8
      Top = 8
      Width = 25
      Height = 13
      Caption = 'Class'
    end
    object ListParent: TListBox
      Left = 8
      Top = 64
      Width = 193
      Height = 121
      ItemHeight = 13
      TabOrder = 0
    end
    object EditInfo: TEdit
      Left = 8
      Top = 24
      Width = 193
      Height = 21
      ReadOnly = True
      TabOrder = 1
    end
  end
end