Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

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

01.01.2007

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

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.

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