Иерархия классов

Code:

unit InfoForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

StdCtrls, ExtCtrls, Buttons, Clipbrd, Comctrls, Db, Dbcgrids,

Dbctrls, Dbgrids, Dblookup, Dbtables, Dialogs,

Filectrl, Grids, Mask, Menus, Mplayer, Oleconst, Olectnrs,

Olectrls, Outline, Tabnotbk, Tabs, IniFiles, Printers,

Registry, DsgnIntf, Provider, BdeProv, DBClient,

ComObj, ActiveX, DDEMan, IBCtrls, Math, Nsapi, Isapi,

ScktComp, Axctrls, Calendar, CgiApp, checklst,

ColorGrd, ComServ, syncobjs, httpapp, dbweb, DirOutln,

Gauges, DsIntf, ToolIntf, EditINtf, ExptIntf, VirtIntf,

istreams, isapiapp, dblogdlg, masks, ExtDlgs, Spin;

type

TForm1 = class(TForm)

   ListBox1: TListBox;

   Label1: TLabel;

   Edit1: TEdit;

   Label2: TLabel;

   Panel1: TPanel;

   TreeView1: TTreeView;

   ProgressBar1: TProgressBar;

   Button1: TButton;

   Button2: TButton;

   procedure Button1Click(Sender: TObject);

   procedure TreeView1Change(Sender: TObject; Node: TTreeNode);

   procedure Button2Click(Sender: TObject);

private

   function AddClass (NewClass: TClass): TTreeNode;

   function GetNode (BaseClass: TClass): TTreeNode;

public

   { Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

type

TClassArray = array [1..498] of TClass;

const

ClassArray: TClassArray = (

EAbort,

EAccessViolation,

EAssertionFailed,

EBitsError,

EClassNotFound,

EComponentError,

EControlC,

EConvertError,

EDatabaseError,

EDateTimeError,

EDBClient,

EDBEditError,

EDBEngineError,

EDivByZero,

EExternalException,

EFCreateError,

EFilerError,

EFOpenError,

EIBError,

EInOutError,

EIntError,

EIntfCastError,

EIntOverflow,

EInvalidArgument,

EInvalidCast,

EInvalidContainer,

EInvalidGraphic,

EInvalidGraphicOperation,

EInvalidGridOperation,

EInvalidImage,

EInvalidInsert,

EInvalidOp,

EInvalidOperation,

EInvalidPointer,

EListError,

EMathError,

EMCIDeviceError,

EMenuError,

EMethodNotFound,

ENoResultSet,

EOleCtrlError,

EOleError,

EOleException,

EOleException,

EOleSysError,

EOutlineError,

EOutOfMemory,

EOutOfResources,

EOverflow,

EPackageError,

EParserError,

EPrinter,

EPrivilege,

EPropertyError,

EPropReadOnly,

EPropWriteOnly,

ERangeError,

EReadError,

EReconcileError,

ERegistryException,

EResNotFound,

ESocketError,

EStackOverflow,

EStreamError,

EStringListError,

EThread,

ETreeViewError,

EUnderflow,

EUpdateError,

EVariantError,

EWin32Error,

EWriteError,

Exception,

EZeroDivide,

OutlineError,

TActiveForm,

TActiveFormControl,

TActiveFormFactory,

TActiveXControl,

TActiveXControlFactory,

TActiveXPropertyPage,

TActiveXPropertyPageFactory,

TAdapterNotifier,

TAggregatedObject,

TAnimate,

TApplication,

TAutoIncField,

TAutoIntfObject,

TAutoObject,

TAutoObjectFactory,

TBatchMove,

TBCDField,

TBDECallback,

TBDEDataSet,

TBevel,

TBinaryField,

TBitBtn,

TBitmap,

TBitmapImage,

TBits,

TBlobField,

TBlobStream,

TBookmarkList,

TBooleanField,

TBoolProperty,

TBrush,

TButton,

TButtonControl,

TBytesField,

TCalendar,

TCanvas,

TCaptionProperty,

TCGIApplication,

TCGIRequest,

TCGIResponse,

TChangeLink,

TCharProperty,

TCheckBox,

TCheckConstraint,

TCheckConstraints,

TCheckListBox,

TClassProperty,

TClientDataSet,

TClientSocket,

TClientWinSocket,

TClipboard,

TCollection,

TCollectionItem,

TColorDialog,

TColorGrid,

TColorProperty,

TColumn,

TColumnTitle,

TComboBox,

TComboButton,

TComClassManager,

TCommonDialog,

TCommonDialog,

TComObject,

TComObjectFactory,

TComponent,

TComponentEditor,

TComponentList,

TComponentNameProperty,

TComponentProperty,

TComServer,

TComServerObject,

TComServerObject,

TConnectionPoint,

TConnectionPoints,

TContainedObject,

TControl,

TControlCanvas,

TControlScrollBar,

TConversion,

TCoolBand,

TCoolBands,

TCoolBar,

TCriticalSection,

TCurrencyField,

TCursorProperty,

TCustomAdapter,

TCustomAdapter,

TCustomCheckBox,

TCustomComboBox,

TCustomControl,

TCustomDBGrid,

TCustomEdit,

TCustomForm,

TCustomGrid,

TCustomGroupBox,

TCustomHotKey,

TCustomImageList,

TCustomLabel,

TCustomListBox,

TCustomListView,

TCustomMaskEdit,

TCustomMemo,

TCustomMemoryStream,

TCustomModule,

TCustomOutline,

TCustomPageProducer,

TCustomPanel,

TCustomProvider,

TCustomRadioGroup,

TCustomRemoteServer,

TCustomRemoteServer,

TCustomRichEdit,

TCustomServerSocket,

TCustomSocket,

TCustomStaticText,

TCustomTabControl,

TCustomTreeView,

TCustomUpDown,

TCustomWebDispatcher,

TCustomWinSocket,

TDatabase,

TDataLink,

TDataModule,

TDataSet,

TDataSetDesigner,

TDataSetTableProducer,

TDataSetUpdateObject,

TDataSetUpdateObject,

TDataSource,

TDataSourceLink,

TDateField,

TDateProperty,

TDateTimeColors,

TDateTimeField,

TDateTimePicker,

TDBCheckBox,

TDBComboBox,

TDBCtrlGrid,

TDBCtrlGridLink,

TDBCtrlPanel,

TDBDataSet,

TDBEdit,

TDBError,

TDBGrid,

TDBGridColumns,

TDBImage,

TDBListBox,

TDBLookupCombo,

TDBLookupComboBox,

TDBLookupControl,

TDBLookupList,

TDBLookupListBox,

TDBMemo,

TDBNavigator,

TDBRadioGroup,

TDBRichEdit,

TDBText,

TDdeClientConv,

TDdeClientItem,

TDdeMgr,

TDdeServerConv,

TDdeServerItem,

TDefaultEditor,

TDesigner,

TDirectoryListBox,

TDirectoryOutline,

TDragControlObject,

TDragObject,

TDrawGrid,

TDriveComboBox,

TDSTableProducer,

TDSTableProducerEditor,

TEdit,

TEnumPropDesc,

TEnumProperty,

TEvent,

TEventDispatch,

TField,

TFieldDataLink,

TFieldDef,

TFieldDefs,

TFileListBox,

TFiler,

TFileStream,

TFilterComboBox,

TFindDialog,

TFloatField,

TFloatProperty,

TFont,

TFontAdapter,

TFontCharsetProperty,

TFontDialog,

TFontNameProperty,

TFontProperty,

TForm,

TFormDesigner,

TGauge,

TGraphic,

TGraphicControl,

TGraphicField,

TGraphicsObject,

TGridDataLink,

TGroupBox,

THandleObject,

THandleStream,

THeader,

THeaderControl,

THeaderSection,

THeaderSections,

THintWindow,

THotKey,

THTMLTableAttributes,

THTMLTableCellAttributes,

THTMLTableColumn,

THTMLTableColumns,

THTMLTableElementAttributes,

THTMLTableHeaderAttributes,

THTMLTableRowAttributes,

THTMLTagAttributes,

THTTPDataLink,

TIBComponent,

TIBEventAlerter,

TIComponentInterface,

TIcon,

TIconImage,

TIconOptions,

TIEditorInterface,

TIEditReader,

TIEditView,

TIEditWriter,

TIExpert,

TIFileStream,

TIFormInterface,

TImage,

TImageList,

TIMainMenuIntf,

TIMemoryStream,

TImeNameProperty,

TIMenuItemIntf,

TIModuleCreator,

TIModuleInterface,

TIModuleNotifier,

TIndexDef,

TIndexDefs,

TIndexFiles,

TIniFile,

TInplaceEdit,

TIntegerField,

TIntegerProperty,

TInterface,

TInterfacedObject,

TIProjectCreator,

TIResourceEntry,

TIResourceFile,

TISAPIApplication,

TISAPIRequest,

TISAPIResponse,

TIStream,

TIStreamAdapter,

TIToolServices,

TIVCLStreamAdapter,

TLabel,

TList,

TListBox,

TListColumn,

TListColumns,

TListColumns,

TListItem,

TListItems,

TListSourceLink,

TListView,

TLoginDialog,

TLookupList,

TMainMenu,

TMask,

TMaskEdit,

TMediaPlayer,

TMemo,

TMemoField,

TMemoryStream,

TMenu,

TMenuItem,

TMetafile,

TMetafileCanvas,

TMetafileImage,

TMethodProperty,

TModalResultProperty,

TMPFilenameProperty,

TNavButton,

TNavButton,

TNavDataLink,

TNotebook,

TNumericField,

TObject,

TOleContainer,

TOleControl,

TOleForm,

TOleGraphic,

TOleStream,

TOpenDialog,

TOpenPictureDialog,

TOrdinalProperty,

TOutline,

TOutlineNode,

TPage,

TPageControl,

TPageProducer,

TPaintBox,

TPaintControl,

TPanel,

TParaAttributes,

TParam,

TParamList,

TParams,

TParser,

TPen,

TPersistent,

TPicture,

TPictureAdapter,

TPopupDataList,

TPopupGrid,

TPopupMenu,

TPrintDialog,

TPrinter,

TPrinterSetupDialog,

TProgressBar,

TPropertyEditor,

TPropertyPage,

TProvider,

TProviderObject,

TQuery,

TQueryTableProducer,

TRadioButton,

TRadioGroup,

TReader,

TRegIniFile,

TRegistry,

TRemoteServer,

TReplaceDialog,

TResourceStream,

TRichEdit,

TSaveDialog,

TSavePictureDialog,

TScreen,

TScrollBox,

TScroller,

TScrollingWinControl,

TServerAcceptThread,

TServerClientThread,

TServerClientWinSocket,

TServerSocket,

TServerWinSocket,

dbtables.TSession,

TSessionList,

TSetElementProperty,

TSetProperty,

TShape,

TSharedImage,

TShortCutProperty,

TSimpleEvent,

TSmallintField,

TSpeedButton,

TSpinButton,

TSpinEdit,

TSplitter,

TStaticText,

TStatusBar,

TStatusBar,

TStatusPanel,

TStatusPanels,

TStoredProc,

TStream,

TStringField,

TStringGrid,

TStringGrid,

TStringGridStrings,

TStringList,

TStringProperty,

TStrings,

TStringsAdapter,

TStringStream,

TSynchroObject,

TTabbedNotebook,

TTabControl,

TTable,

TTabList,

TTabOrderProperty,

TTabPage,

TTabSet,

TTabSheet,

TTextAttributes,

TThread,

TThreadList,

TTimeField,

TTimeProperty,

TTimer,

TTimerSpeedButton,

TToolBar,

TToolButton,

TTrackBar,

TTreeNode,

TTreeNodes,

TTreeView,

TTypedComObject,

TTypedComObjectFactory,

TUpdateSQL,

TUpDown,

TVarBytesField,

TVirtualStream,

TWebActionItem,

TWebActionItems,

TWebApplication,

TWebDispatcher,

TWebModule,

TWebRequest,

TWebResponse,

TWinCGIRequest,

TWinCGIResponse,

TWinControl,

TWinSocketStream,

TWordField,

TWriter

);

function TForm1.AddClass (NewClass: TClass): TTreeNode;

var

ParentNode: TTreeNode;

begin

// if the class is not there...

Result := GetNode (NewClass);

if Result = nil then

begin

   // look for the parent (eventually adding it)

   ParentNode := AddClass (NewClass.ClassParent);

   // add the new class

   Result := TreeView1.Items.AddChildObject (

     ParentNode,

     NewClass.ClassName,

     Pointer (NewClass));

end;

end;

function TForm1.GetNode (BaseClass: TClass): TTreeNode;

var

Node1: TTreeNode;

begin

Result := nil; // not found

// find the node in the tree

Node1 := TreeView1.Items.GetFirstNode;

while Node1 <> nil do

begin

   if Node1.Text = BaseClass.ClassName then

   begin

     Result := Node1;

     Exit;

   end;

   Node1 := Node1.GetNext;

   Forms.Application.ProcessMessages;

end;

(* slower loop...

for I := 0 to TreeView1.Items.Count - 1 do

begin

   if TreeView1.Items [I].Text = BaseClass.ClassName then

   begin

     Result := TreeView1.Items [I];

     Exit;

   end;

   Application.ProcessMessages;

end;*)

end;

procedure TForm1.Button1Click(Sender: TObject);

var

I: Integer;

begin

// don't restart this loop

Button1.Enabled := False;

// add the root class

TreeView1.Items.AddObject (nil, 'TObject',

   Pointer (TObject));

// add each class to the tree

ProgressBar1.Min := Low (ClassArray);

ProgressBar1.Max := High (ClassArray);

for I := Low (ClassArray) to High (ClassArray) do

begin

   AddClass (ClassArray [I]);

   ProgressBar1.Position := I;

end;

Beep;

ShowMessage ('Tree Completed');

Button2.Enabled := True;

Button1.Enabled := False;

end;

procedure TForm1.TreeView1Change (

Sender: TObject; Node: TTreeNode);

var

MyClass: TClass;

begin

MyClass := TClass (Node.Data);

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;

procedure TForm1.Button2Click(Sender: TObject);

begin

Screen.Cursor := crHourglass;

TreeView1.SortType := stText;

Screen.Cursor := crDefault;

Button2.Enabled := False;

end;

end.