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

Следующий модуль строит дерево классов

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.Get;

  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.


Взято с http://delphiworld.narod.ru

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...