infoform.pas

来自「Delphi高级开发指南是开发程序的好帮手」· PAS 代码 · 共 121 行

unit InfoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids,
  Dbctrls, Dbgrids, Dblookup, Dbtables, Ddeman, Dialogs,
  Filectrl, Grids, Mask, Menus, Mplayer, Oleconst, Olectnrs,
  Olectrls, Outline, Tabnotbk, Tabs;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    ButtonShow: TButton;
    Label3: TLabel;
    Panel1: TPanel;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure ButtonShowClick(Sender: TObject);
    procedure ComboBox1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TClassArray = array [1..140] of TPersistentClass;

const
  ClassArray: TClassArray = (
    TBitmap, TGraphic, TOutlineNode, TGraphicsObject,
    TBrush, THeaderSection, TParams, TCanvas,
    THeaderSections, TPen, TIcon, TPicture,
    TIconOptions, TCollection, TCollectionItem, TColumn,
    TStatusPanel, TColumnTitle, TStatusPanels, TClipboard,
    TControlScrollBar, TListColumn, TStringList, TListItem,
    TStrings, TListItems, TMetafile, TMetafileCanvas,
    TTreeNode, TFont, TParaAttributes, TTreeNodes,
    TApplication, TDDEServerItem, TPanel, TAutoIncField,
    TDirectoryListBox, TPopupMenu, TBatchMove, TDrawGrid,
    TPrintDialog, TBCDField, TDriveComboBox, TPrinterSetupDialog,
    TBevel, TEdit, TProgressBar, TBitBtn,
    TField, TQuery, TBlobField, TFileListBox,
    TRadioButton, TBooleanField, TFilterComboBox, TRadioGroup,
    TButton, TFindDialog, TReplaceDialog, TBytesField,
    TFloatField, TCheckBox, TFontDialog,
    TRichEdit, TColorDialog, TForm, TSaveDialog,
    TComboBox, TGraphicField, TScreen, TCurrencyField,
    TGroupBox, TScrollBar, TDatabase, THeader,
    TScrollBox, TDataSource, THeaderControl, TSession,
    TDateField, THotKey, TShape, TDateTimeField,
    TImage, TSmallIntField, TDBCheckBox, TImageList,
    TSpeedButton, TDBComboBox, TIntegerField, TStatusBar,
    TDBCtrlGrid, TLabel, TStoredProc, TDBEdit,
    TListBox, TStringField, TDBGrid, TListView,
    TStringGrid, TDBImage, TMainMenu, TTabbedNotebook,
    TDBListBox, TMaskEdit, TTabControl, TDBLookupCombo,
    TMediaPlayer, TTable, TMemoField, TDBLookupComboBox,
    TMemo, TTabSet, TDBLookupList, TTabSheet,
    TDBLookupListBox, TMenuItem, TTimeField, TDBMemo,
    TNotebook, TTable, TDBNavigator, TOleContainer,
    TTimer, TDBRadioGroup, TOpenDialog, TTrackBar,
    TDBText, TOutline, TTreeView, TDDEClientConv,
    TOutline, TUpdateSQL, TDDEClientItem, TPageControl,
    TUpDown, TDDEServerConv, TPaintBox, TVarBytesField,
    TWordField);


procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  // register all of the classes
  RegisterClasses (ClassArray);
  // copy class names to the listbox
  for I := Low (ClassArray) to High (ClassArray) do
    ComboBox1.Items.Add (ClassArray [I].ClassName);
end;

procedure TForm1.ButtonShowClick(Sender: TObject);
var
  MyClass: TClass;
begin
  MyClass := GetClass (ComboBox1.Text);
  if MyClass = nil then
    Beep
  else
  begin
    Edit1.Text := Format ('Name: %s - Size: %d bytes',
      [MyClass.ClassName, MyClass.InstanceSize]);
    with Listbox1.Items do
    begin
      Clear;
      while MyClass.ClassParent <> nil do
      begin
        MyClass := MyClass.ClassParent;
        Add (MyClass.ClassName);
      end; // while
    end; // with
  end; // else
end;

procedure TForm1.ComboBox1DblClick(Sender: TObject);
begin
  ButtonShowClick (Sender);
end;

end.