Иерархия классов |
Previous Top Next |
Следующий модуль строит дерево классов
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. |
©Drkb::00345
Взято с http://delphiworld.narod.ru