compinsp.pas

类似Delphi Ide的对象查看器 可以在RUNTIME时使用

unit CompInsp;

interface

{$IFDEF VER100}
  {$DEFINE VERSION3}
{$ENDIF}
{$IFDEF VER110}
  {$DEFINE VERSION3}
{$ENDIF}

uses Windows, Messages, Classes, SysUtils, TypInfo, Graphics, Controls, Menus,
  StdCtrls, ComCtrls, CommCtrl, InspCtrl, PropList, PropEdit, IniFiles, Forms;

const
  CM_OIUPDATED = WM_USER + 2000;

type
  TCompInspMode = (imProperties,imEvents);

  TCompInspList = class;

  TCustomComponentInspector = class;
  TComponentInspector = class;

  TNotifyComponentEvent = procedure(Sender: TObject; TheComponent: TComponent) of object;
  TIndexComponentEvent = procedure(Sender: TObject; TheComponent: TComponent; var Index: Integer) of object;
  TSetStringEnableEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: string; var EnableDefault: Boolean) of object;
  TEditorClassEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: TPropertyEditorClass) of object;
  TPropFilterEvent = procedure(Sender: TObject; Prop: TProperty; var Result: Boolean) of object;
  TPropCompareEvent = procedure(Sender: TObject; Prop1,Prop2: TProperty; var Result: Integer) of object;
  TFillEventListEvent = procedure(Sender: TObject; EventType: PTypeInfo; Strings: TStrings) of object;
  TCustomizeInspectorEvent = procedure(Sender: TObject; Inspector: TComponentInspector) of object;
  TFilterComponentEvent = procedure(Sender: TObject; AComponent: TComponent; var EnableAdd: Boolean) of object;
  TGetComponentTextEvent = procedure(Sender: TObject; AComponent: TComponent; var Text: string) of object;

  TCustomComponentTree = class(TCustomTreeView)
  private
    { Private declarations }
    FFilled: Boolean;
    FIgnoreUpdate: Boolean;
    FRoot: TComponent;
    FInstance: TComponent;
    FComponentInspector: TCustomComponentInspector;
    FShowNonVisual: Boolean;
    FOnSelect: TNotifyComponentEvent;
    FOnFilter: TFilterComponentEvent;
    FOnGetText: TGetComponentTextEvent;
    FOnEditText: TGetComponentTextEvent;
    FOnComponentImage: TIndexComponentEvent;
    FIsEnumComponent:Boolean;
    procedure SetRoot(const Value: TComponent);
    procedure SetIsEnumComponent(const Value: Boolean);
    procedure SetInstance(const Value: TComponent);
    procedure SetComponentInspector(const Value: TCustomComponentInspector);
    procedure SetShowNonVisual(const Value: Boolean);
  protected
    { Protected declarations }
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Change(Node: TTreeNode); override;
    procedure Edit(const Item: TTVItem); override;
    function Filter(AComponent: TComponent): Boolean; virtual;
    function GetText(AComponent: TComponent): string; virtual;
    procedure EditText(AComponent: TComponent; var AText: string); virtual;
    procedure SelectInstance(AComponent: TComponent); virtual;
    function GetComponentImage(AComponent: TComponent): Integer; virtual;
    procedure CMOIUpdated(var Message: TMessage); message CM_OIUPDATED;
    property Root: TComponent read FRoot write SetRoot;
    property Instance: TComponent read FInstance write SetInstance;
    property ComponentInspector: TCustomComponentInspector read FComponentInspector write SetComponentInspector;
    property ShowNonVisual: Boolean read FShowNonVisual write SetShowNonVisual default False;
    property OnSelect: TNotifyComponentEvent read FOnSelect write FOnSelect;
    property OnFilter: TFilterComponentEvent read FOnFilter write FOnFilter;
    property OnGetText: TGetComponentTextEvent read FOnGetText write FOnGetText;
    property OnEditText: TGetComponentTextEvent read FOnEditText write FOnEditText;
    property OnComponentImage: TIndexComponentEvent read FOnComponentImage write FOnComponentImage;
    property IsEnumComponent: Boolean read FIsEnumComponent write SetIsEnumComponent;
  public
    { Public declarations }
    function GetComponentNode(AComponent: TComponent): TTreeNode;
    procedure AddComponent(AComponent: TComponent);
    procedure DeleteComponent(AComponent: TComponent);
    procedure RefreshTree;
    procedure EnumComponent(comp:TComponent;N: TTreeNode);
  end;

  TComponentTree = class(TCustomComponentTree)
  published
    { Published declarations }
    {$IFNDEF VERSION3}
    property Anchors;
    property BiDiMode;
    property BorderWidth;
    property Constraints;
    property AutoExpand;
    property ChangeDelay;
    property HotTrack;
    property RightClickSelect;
    property RowSelect;
    property ToolTips;
    property OnCustomDraw;
    property OnCustomDrawItem;
    property OnEndDock;
    property OnStartDock;
    {$ENDIF}
    property Align;
    property BorderStyle;
    property Ctl3D;
    property HelpContext;
    property ParentCtl3D;
    property TabOrder;
    property TabStop;
    property DragMode;
    property HideSelection;
    property Images;
    property Indent;
    property Items;
    property ReadOnly;
    property ShowButtons;
    property ShowLines;
    property ShowRoot;
    property SortType;
    property StateImages;
    property Root;
    property IsEnumComponent;
    property Instance;
    property ComponentInspector;
    property ShowNonVisual;
    property OnSelect;
    property OnFilter;
    property OnGetText;
    property OnEditText;
    property OnComponentImage;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  TCustomComponentComboBox = class(TCustomComboBox)
  private
    FRoot: TComponent;
    FComponentInspector: TCustomComponentInspector;
    FOnFilter: TFilterComponentEvent;
    FOnGetComponentText: TGetComponentTextEvent;
    procedure SetRoot(const Value: TComponent);
    function GetInstance: TComponent;
    procedure SetInstance(const Value: TComponent);
    procedure SetComponentInspector(const Value: TCustomComponentInspector);
  protected
    procedure CreateWnd; override;
    procedure Change; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function TranslateComponent(AComponent: TComponent): TComponent; virtual;
    function Filter(AComponent: TComponent): Boolean; virtual;
    function GetComponentText(AComponent: TComponent): string; virtual;
    procedure CMOIUpdated(var Message: TMessage); message CM_OIUPDATED;
  public
    constructor Create(AOwner: TComponent); override;
    procedure RefreshList;
    property Root: TComponent read FRoot write SetRoot;
    property Instance: TComponent read GetInstance write SetInstance;
    property ComponentInspector: TCustomComponentInspector read FComponentInspector write SetComponentInspector;
    property OnFilter: TFilterComponentEvent read FOnFilter write FOnFilter;
    property OnGetComponentText: TGetComponentTextEvent read FOnGetComponentText write FOnGetComponentText;
  end;

  TComponentComboBox = class(TCustomComponentComboBox)
  published
    {$IFNDEF VERSION3}
    property Anchors;
    property Constraints;
    {$ENDIF}
    property Root;
    property Instance;
    property ComponentInspector;
    property OnFilter;
    property OnGetComponentText;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDrag;
  end;

  TCompInspProperty = class(TProperty)
  private
    FCompInspList: TCompInspList;
  public
    constructor CreateWithOwner(AOwner: TPropertyList; ARoot,AInstance: TComponent; APropInfo: PPropInfo; APropData: TCustomPropData; ACompInspList: TCompInspList);
    function CreatePropertyList: TPropertyList; override;
  end;

  TCompInspPropertyList = class(TPropertyList)
  private
    FCompInspList: TCompInspList;
    FMode: TCompInspMode;
    procedure SetMode(const Value: TCompInspMode);
  public
    constructor CreateWithOwner(AOwner: TProperty; ACompInspList: TCompInspList);
    function CreateProperty(APropInfo: PPropInfo; APropData: TCustomPropData): TProperty; override;
    function Compare(P1,P2: TProperty): Integer; override;
    function Filter(P: TProperty): Boolean; override;
    property CompInspList: TCompInspList read FCompInspList;
    property Mode: TCompInspMode read FMode write SetMode;
  end;

  TCompInspList = class
  private
    FOwner: TCustomComponentInspector;
    FRoot: TComponent;
    FMode: TCompInspMode;
    FPropertyLists: TList;
    FProperties: TList;
    FExpanded: TStrings;
    procedure SetRoot(const Value: TComponent);
    function GetInstance: TComponent;
    procedure SetInstance(const Value: TComponent);
    function GetInstanceCount: Integer;
    function GetArrayInstance(Index: Integer): TComponent;
    procedure SetMode(const Value: TCompInspMode);
    function GetPropertyCount: Integer;
    function GetProperty(Index: Integer): TProperty;
    function GetPropertyListCount: Integer;
    function GetPropertyList(Index: Integer): TCompInspPropertyList;
    procedure Clear;
  public
    constructor CreateWithOwner(AOwner: TCustomComponentInspector);
    destructor Destroy; override;
    procedure Update; virtual;
    procedure AddInstance(AInstance: TComponent); virtual;
    procedure DeleteInstance(AInstance: TComponent); virtual;
    function IndexOfInstance(AInstance: TComponent): Integer;
    function ValidPropIndex(Index: Integer): Boolean;
    function ValidListIndex(Index: Integer): Boolean;
    property Owner: TCustomComponentInspector read FOwner;
    property Root: TComponent read FRoot write SetRoot;
    property Instance: TComponent read GetInstance write SetInstance;
    property Mode: TCompInspMode read FMode write SetMode;
    property InstanceCount: Integer read GetInstanceCount;
    property Instances[Index: Integer]: TComponent read GetArrayInstance;
    property PropertyCount: Integer read GetPropertyCount;
    property Properties[Index: Integer]: TProperty read GetProperty;
    property PropertyListCount: Integer read GetPropertyListCount;
    property PropertyLists[Index: Integer]: TCompInspPropertyList read GetPropertyList;
  end;

  TCustomComponentInspector = class(TCustomInspector)
  private
    FDictionary: TStrings;
    FPropertyList: TCompInspList;
    FNotificationControls: TList;
    FSelectedProperty: string;
    FMultiSelect: Boolean;
    FDictionaryFile: string;
    FOnSetValue: TSetStringEnableEvent;
    FOnCallEditor: TCallEditorEnableEvent;
    FOnBeforeExpand: TIndexEnableEvent;
    FOnAfterExpand: TIndexNotifyEvent;
    FOnBeforeCollapse: TIndexEnableEvent;
    FOnAfterCollapse: TIndexNotifyEvent;
    FOnGetEditorClass: TEditorClassEvent;
    FOnFilter: TPropFilterEvent;
    FOnCompare: TPropCompareEvent;
    FOnFillEventList: TFillEventListEvent;
    FOnChange: TIndexNotifyEvent;
    FOnCustomizeInspector: TCustomizeInspectorEvent;
    procedure SetMultiSelectProperty(const Value: Boolean);
    procedure SetDictionary(const Value: TStrings);
    procedure SetDictionaryFile(const Value: string);
    procedure SetRoot(const Value: TComponent);
    function GetRoot: TComponent;
    procedure SetInstance(const Value: TComponent);
    function GetInstance: TComponent;
    function GetInstanceCount: Integer;
    function GetArrayInstance(Index: Integer): TComponent;
    function GetMode: TCompInspMode;
    function GetPropertyCount: Integer;
    function GetProperty(TheIndex: Integer): TProperty;
    procedure SetMode(const Value: TCompInspMode);
    procedure UpdateList;
    procedure UpdateDictionary;
    function Translate(const Value: string; Direction: Boolean): string;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetDefaultIndex: Integer; override;
    function GetPopupItemWidth(ListBox: TListBox; TheIndex: Integer): Integer; override;
    procedure DrawPopupItem(ListBox: TListBox; ListItemIndex: Integer; R: TRect; TheIndex: Integer); override;
    procedure DrawPropertyValue(TheCanvas: TCanvas; TheIndex: Integer; R: TRect); override;
    function GetName(TheIndex: Integer): string; override;
    function GetValue(TheIndex: Integer): string; override;
    function GetNextValue(TheIndex: Integer): string; override;
    procedure SetValue(TheIndex: Integer; const Value: string); override;
    procedure DragValue(TheIndex,Offset: Integer); override;
    function GetButtonType(TheIndex: Integer): TButtonType; override;
    function GetInplaceEditorType(TheIndex: Integer): TInplaceEditorType; override;
    function GetEnableExternalEditor(TheIndex: Integer): Boolean; override;
    function GetReadOnly(TheIndex: Integer): Boolean; override;
    function GetExpandState(TheIndex: Integer): TExpandState; override;
    function GetLevel(TheIndex: Integer): Integer; override;
    procedure GetValuesList(TheIndex: Integer; const Strings: TStrings); override;
    function GetSortValuesList(TheIndex: Integer): Boolean; override;
    function GetSelectedValue(TheIndex: Integer): string; override;
    function GetAutoApply(TheIndex: Integer): Boolean; override;
    function CallEditor(TheIndex: Integer): Boolean; override;
    procedure Expand(TheIndex: Integer); override;
    procedure Collapse(TheIndex: Integer); override;
    procedure SelectItem(TheIndex: Integer); override;
    function GetEditorClass(TheIndex: Integer): TPropertyEditorClass; virtual;
    procedure Compare(Prop1,Prop2: TProperty; var Result: Integer); virtual;
    procedure Filter(Prop: TProperty; var Result: Boolean); virtual;
    procedure Change(TheIndex: Integer); virtual;
    property MultiSelect: Boolean read FMultiSelect write SetMultiSelectProperty default True;
    property DictionaryFile: string read FDictionaryFile write SetDictionaryFile;
    property Dictionary: TStrings read FDictionary write SetDictionary;
    property Root: TComponent read GetRoot write SetRoot;
    property Instance: TComponent read GetInstance write SetInstance;
    property Mode: TCompInspMode read GetMode write SetMode default imProperties;
    property OnSetValue: TSetStringEnableEvent read FOnSetValue write FOnSetValue;
    property OnCallEditor: TCallEditorEnableEvent read FOnCallEditor write FOnCallEditor;
    property OnBeforeExpand: TIndexEnableEvent read FOnBeforeExpand write FOnBeforeExpand;
    property OnAfterExpand: TIndexNotifyEvent read FOnAfterExpand write FOnAfterExpand;
    property OnBeforeCollapse: TIndexEnableEvent read FOnBeforeCollapse write FOnBeforeCollapse;
    property OnAfterCollapse: TIndexNotifyEvent read FOnAfterCollapse write FOnAfterCollapse;
    property OnGetEditorClass: TEditorClassEvent read FOnGetEditorClass write FOnGetEditorClass;
    property OnFilter: TPropFilterEvent read FOnFilter write FOnFilter;
    property OnCompare: TPropCompareEvent read FOnCompare write FOnCompare;
    property OnFillEventList: TFillEventListEvent read FOnFillEventList write FOnFillEventList;
    property OnChange: TIndexNotifyEvent read FOnChange write FOnChange;
    property OnCustomizeInspector: TCustomizeInspectorEvent read FOnCustomizeInspector write FOnCustomizeInspector;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; override;
    procedure CreateWnd; override;
    procedure RefreshList;
    procedure ClearExpanded;
    procedure AddInstance(AInstance: TComponent); virtual;
    procedure DeleteInstance(AInstance: TComponent); virtual;
    function IndexOfInstance(AInstance: TComponent): Integer;
    procedure AddNotification(TheControl: TControl);
    procedure DeleteNotification(TheControl: TControl);
    procedure FillEventList(EventType: PTypeInfo; Strings: TStrings); virtual;
    procedure CustomizeInspector(Inspector: TComponentInspector); virtual;
    procedure FullExpand;
    function IndexOfPropertyName(AFullname: string): Integer;
    procedure SelectProperty(AFullName: string);
    function IndexOfProperty(P: TProperty): Integer;
    property PropertyCount: Integer read GetPropertyCount;
    property Properties[Index: Integer]: TProperty read GetProperty;
    property InstanceCount: Integer read GetInstanceCount;
    property Instances[Index: Integer]: TComponent read GetArrayInstance;
  end;

  TComponentInspector = class(TCustomComponentInspector)
  published
    // TListBox properties
    {$IFNDEF VERSION3}
    property Anchors;
    property Constraints;
    {$ENDIF}
    property Align;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDrag;
    // TCustomInspector properties
    property CheckBoxes;
    property PaintStyle;
    property Splitter;
    property OnSelect;
    property OnUpdate;
    property OnValidateChar;
    property OnChangeValue;
    property OnDrawName;
    property OnDrawValue;
    // TCustomComponentInspector properties
    property MultiSelect;
    property DictionaryFile;
    property Dictionary;
    property Root;
    property Instance;
    property Mode;
    property OnGetName;
    property OnGetValue;
    property OnGetNextValue;
    property OnSetValue;
    property OnGetButtonType;
    property OnGetInplaceEditorType;
    property OnGetMaxLength;
    property OnGetEditMask;
    property OnGetEnableExternalEditor;
    property OnGetReadOnly;
    property OnGetExpandState;
    property OnGetLevel;
    property OnGetValuesList;
    property OnGetSortValuesList;
    property OnGetSelectedValue;
    property OnGetAutoApply;
    property OnGetNameFont;
    property OnGetNameColor;
    property OnGetValueFont;
    property OnGetValueColor;
    property OnCallEditor;
    property OnBeforeExpand;
    property OnAfterExpand;
    property OnBeforeCollapse;
    property OnAfterCollapse;
    property OnGetEditorClass;
    property OnFilter;
    property OnCompare;
    property OnSelectItem;
    property OnDeselectItem;
    property OnValueDoubleClick;
    property OnFillEventList;
    property OnChange;
    property OnCustomizeInspector;
  end;

implementation

uses Createstring, CreateImage, MenuEdit, CollEdit, TreeView, ListView;

procedure TCustomComponentTree.SetRoot(const Value: TComponent);
begin
  if FRoot<>Value then