claform.pas

Delphi高级开发指南是开发程序的好帮手

unit ClaForm;

interface

uses
  SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids,
  Dbctrls, Dbgrids, Dblookup, DbTables, Ddeman, Dialogs,
  Filectrl, Grids, Mask, Menus, Mplayer, Olectnrs,
  Outline, Tabnotbk, Tabs, IniFiles, Printers,
  Registry, DsgnIntf, TypInfo;

type
  TForm1 = class(TForm)
    Listbox1: TListBox;
    ListBox2: TListBox;
    Splitter1: TSplitter;
    procedure Listbox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBox2Click(Sender: TObject);
  public
    procedure AddType (pti: PTypeInfo);
  end;

  procedure ShowClass (pti: PTypeInfo; sList: TStrings);
  // repeated from TypInfo.Pas
  procedure SortPropList(PropList: PPropList; PropCount: Integer);

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Listbox1Click(Sender: TObject);
var
  pti: PTypeInfo;
begin
  pti := PTypeInfo (ListBox1.Items.Objects [
    Listbox1.ItemIndex]);
  ListBox2.Items.Clear;
  Caption := 'RTTI information for ' +
    ListBox1.Items [Listbox1.ItemIndex];
  ShowClass (pti, ListBox2.Items);
end;

// show RTTI information for class type
procedure ShowClass (pti: PTypeInfo; sList: TStrings);
var
  ptd: PTypeData;
  ppi: PPropInfo;
  pProps: PPropList;
  nProps, I: Integer;
  ParentClass: TClass;
begin
  // protect against misuse
  if pti^.Kind <> tkClass then
    raise Exception.Create ('Invalid type information');

  // get a pointer to the TTypeData structure
  ptd := GetTypeData (pti);

  // access the TTypeInfo structure
  sList.Add ('Type Name: ' + pti^.Name);
  sList.Add ('Type Kind: ' + GetEnumName (
    TypeInfo (TTypeKind),
    Integer (pti^.Kind)));

  // access the TTypeData structure
  {omitted: the same information of pti^.Name...
  sList.Add ('ClassType: ' + ptd^.ClassType.ClassName);}
  sList.Add ('Size: ' + IntToStr (
    ptd^.ClassType.InstanceSize) + ' bytes');
  sList.Add ('Defined in: ' + ptd^.UnitName + '.pas');

  // add the list of parent classes (if any)
  ParentClass := ptd^.ClassType.ClassParent;
  if ParentClass <> nil then
  begin
    sList.Add ('');
    sList.Add ('=== Parent classes ===');
    while ParentClass <> nil do
    begin
      sList.Add (ParentClass.ClassName);
      ParentClass := ParentClass.ClassParent;
    end;
  end;

  // add the list of properties (if any)
  nProps := ptd^.PropCount;
  if nProps > 0 then
  begin
    // format the initial output
    sList.Add ('');
    sList.Add ('=== Properties (' +
      IntToStr (nProps) + ') ===');
    // allocate the required memory
    GetMem (pProps, sizeof (PPropInfo) * nProps);
    // protect the memory allocation
    try
      // fill the TPropList structure
      // pointed to by pProps
      GetPropInfos(pti, pProps);
      // sort the properties
      SortPropList(pProps, nProps);
      // show name and data type of each property
      for I := 0 to nProps - 1 do
      begin
        ppi := pProps [I];
        sList.Add (ppi.Name + ': ' +
          ppi.PropType^.Name);
      end;
    finally
      // free the allocated memmory
      FreeMem (pProps, sizeof (PPropInfo) * nProps);
    end;
  end;
end;

procedure TForm1.AddType (pti: PTypeInfo);
begin
  ListBox1.Items.AddObject(pti.Name, TObject (pti));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // add classes to the first listbox
  AddType (TypeInfo (TApplication));
  AddType (TypeInfo (TAutoIncField));
  AddType (TypeInfo (TBatchMove));
  AddType (TypeInfo (TBCDField));
  AddType (TypeInfo (TBevel));
  AddType (TypeInfo (TBitBtn));
  AddType (TypeInfo (TBitmap));
  AddType (TypeInfo (TBlobField));
  AddType (TypeInfo (TBlobStream));
  AddType (TypeInfo (TBooleanField));
  AddType (TypeInfo (TBrush));
  AddType (TypeInfo (TButton));
  AddType (TypeInfo (TButtonControl));
  AddType (TypeInfo (TBytesField));
  AddType (TypeInfo (TCanvas));
  AddType (TypeInfo (TCaptionProperty));
  AddType (TypeInfo (TChangeLink));
  AddType (TypeInfo (TCharProperty));
  AddType (TypeInfo (TCheckBox));
  AddType (TypeInfo (TClassProperty));
  AddType (TypeInfo (TClipboard));
  AddType (TypeInfo (TCollection));
  AddType (TypeInfo (TCollectionItem));
  AddType (TypeInfo (TColorDialog));
  AddType (TypeInfo (TColorProperty));
  AddType (TypeInfo (TColumn));
  AddType (TypeInfo (TColumnTitle));
  AddType (TypeInfo (TComboBox));
  AddType (TypeInfo (TCommonDialog));
  AddType (TypeInfo (TComponent));
  AddType (TypeInfo (TComponentEditor));
  AddType (TypeInfo (TComponentList));
  AddType (TypeInfo (TComponentProperty));
  AddType (TypeInfo (TControl));
  AddType (TypeInfo (TControlCanvas));
  AddType (TypeInfo (TControlScrollBar));
  AddType (TypeInfo (TCurrencyField));
  AddType (TypeInfo (TCursorProperty));
  AddType (TypeInfo (TCustomCheckBox));
  AddType (TypeInfo (TCustomComboBox));
  AddType (TypeInfo (TCustomControl));
  AddType (TypeInfo (TCustomEdit));
  AddType (TypeInfo (TCustomGrid));
  AddType (TypeInfo (TCustomGroupBox));
  AddType (TypeInfo (TCustomLabel));
  AddType (TypeInfo (TCustomListBox));
  AddType (TypeInfo (TCustomMaskEdit));
  AddType (TypeInfo (TCustomMemo));
  AddType (TypeInfo (TCustomMemoryStream));
  AddType (TypeInfo (TCustomOutline));
  AddType (TypeInfo (TCustomPanel));
  AddType (TypeInfo (TCustomRadioGroup));
  AddType (TypeInfo (TDatabase));
  AddType (TypeInfo (TDataSource));
  AddType (TypeInfo (TDateField));
  AddType (TypeInfo (TDateTimeField));
  AddType (TypeInfo (TDBCheckBox));
  AddType (TypeInfo (TDBComboBox));
  AddType (TypeInfo (TDBCtrlGrid));
  AddType (TypeInfo (TDBEdit));
  AddType (TypeInfo (TDBGrid));
  AddType (TypeInfo (TDBImage));
  AddType (TypeInfo (TDBListBox));
  AddType (TypeInfo (TDBLookupCombo));
  AddType (TypeInfo (TDBLookupList));
  AddType (TypeInfo (TDBLookupListBox));
  AddType (TypeInfo (TDBMemo));
  AddType (TypeInfo (TDBNavigator));
  AddType (TypeInfo (TDBRadioGroup));
  AddType (TypeInfo (TDBText));
  AddType (TypeInfo (TDDEClientConv));
  AddType (TypeInfo (TDDEClientItem));
  AddType (TypeInfo (TDDEServerConv));
  AddType (TypeInfo (TDDEServerItem));
  AddType (TypeInfo (TDefaultEditor));
  AddType (TypeInfo (TDesigner));
  AddType (TypeInfo (TDirectoryListBox));
  AddType (TypeInfo (TDragControlObject));
  AddType (TypeInfo (TDragObject));
  AddType (TypeInfo (TDrawGrid));
  AddType (TypeInfo (TDriveComboBox));
  AddType (TypeInfo (TEdit));
  AddType (TypeInfo (TEnumProperty));
  AddType (TypeInfo (TField));
  AddType (TypeInfo (TFieldDef));
  AddType (TypeInfo (TFieldDefs));
  AddType (TypeInfo (TFileListBox));
  AddType (TypeInfo (TFiler));
  AddType (TypeInfo (TFileStream));
  AddType (TypeInfo (TFilterComboBox));
  AddType (TypeInfo (TFindDialog));
  AddType (TypeInfo (TFloatField));
  AddType (TypeInfo (TFloatProperty));
  AddType (TypeInfo (TFont));
  AddType (TypeInfo (TFontDialog));
  AddType (TypeInfo (TFontNameProperty));
  AddType (TypeInfo (TFontProperty));
  AddType (TypeInfo (TForm));
  AddType (TypeInfo (TFormDesigner));
  AddType (TypeInfo (TGraphic));
  AddType (TypeInfo (TGraphicControl));
  AddType (TypeInfo (TGraphicField));
  AddType (TypeInfo (TGraphicsObject));
  AddType (TypeInfo (TGroupBox));
  AddType (TypeInfo (THandleStream));
  AddType (TypeInfo (THeader));
  AddType (TypeInfo (THeaderControl));
  AddType (TypeInfo (THeaderSection));
  AddType (TypeInfo (THeaderSections));
  AddType (TypeInfo (THintWindow));
  AddType (TypeInfo (THotKey));
  AddType (TypeInfo (TIcon));
  AddType (TypeInfo (TIconOptions));
  AddType (TypeInfo (TImage));
  AddType (TypeInfo (TImage));
  AddType (TypeInfo (TImageList));
  AddType (TypeInfo (TIndexDef));
  AddType (TypeInfo (TIndexDefs));
  AddType (TypeInfo (TIniFile));
  AddType (TypeInfo (TInplaceEdit));
  AddType (TypeInfo (TIntegerField));
  AddType (TypeInfo (TIntegerProperty));
  AddType (TypeInfo (TLabel));
  AddType (TypeInfo (TList));
  AddType (TypeInfo (TListBox));
  AddType (TypeInfo (TListColumn));
  AddType (TypeInfo (TListItem));
  AddType (TypeInfo (TListItems));
  AddType (TypeInfo (TListView));
  AddType (TypeInfo (TMainMenu));