inspctrl.pas

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

unit InspCtrl;

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

interface

uses SysUtils, Classes, TypInfo, Windows, Messages, Controls, StdCtrls,
  Dialogs, Graphics, Forms, Mask;

type
  TCustomInspector = class;

  TButtonType = (btNone,btDropDown,btUpDown,btDialog);

  TInplaceEditorType = (ieNone,ieEdit,ieCheckBox);

  TExpandState = (esNone,esExpand,esCollapse);

  TInspectorPopup = class(TListBox)
  private
    function Inspector: TCustomInspector;
  protected
    procedure DrawItem(TheIndex: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TInspectorEdit = class(TMaskEdit)
  private
    FEditing: Boolean;
    function Inspector: TCustomInspector;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure KeyPress(var Key: Char); override;
    procedure Change; override;
  end;

  TInspectorCheckBox = class(TCheckBox)
  private
    function Inspector: TCustomInspector;
  protected
    procedure Click; override;
  end;

  TInspectorButton = class(TCustomControl)
  private
    FDown: Boolean;
    FButtonType: TButtonType;
    FDropDown: TBitmap;
    FUpDown: TBitmap;
    FDialog: TBitmap;
    procedure SetDown(const Value: Boolean);
    procedure SetButtonType(const Value: TButtonType);
    function Inspector: TCustomInspector;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Down: Boolean read FDown write SetDown;
    property ButtonType: TButtonType read FButtonType write SetButtonType;
  end;

  TDragKind = (dkNone,dkItem,dkSplitter);

  TItemAction = (iaDoubleClick,iaButtonClick);

  TPaintStyle = (psClassic,psTree,psGreatis);

  TValidateCharEvent = function(Sender: TObject; TheIndex: Integer; var Key: Char): Boolean of object;
  TGetStringEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: string) of object;
  TSetStringEvent = procedure(Sender: TObject; TheIndex: Integer; const Value: string) of object;
  TButtonTypeEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: TButtonType) of object;
  TInplaceEditorTypeEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: TInplaceEditorType) of object;
  TBooleanEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: Boolean) of object;
  TExpandStateEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: TExpandState) of object;
  TIntegerEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: Integer) of object;
  TPointerEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: Pointer) of object;
  TColorEvent = procedure(Sender: TObject; TheIndex: Integer; var Value: TColor) of object;
  TFontEvent = procedure(Sender: TObject; TheIndex: Integer; const TheFont: TFont) of object;
  TStringsEvent = procedure(Sender: TObject; TheIndex: Integer; const Strings: TStrings) of object;
  TEditEvent = procedure(Sender: TObject; TheIndex: Integer; const Strings: TStrings) of object;
  TCallEditorEvent = function(Sender: TObject; TheIndex: Integer): Boolean of object;
  TCallEditorEnableEvent = function(Sender: TObject; TheIndex: Integer; var EnableDefault: Boolean): Boolean of object;
  TIndexNotifyEvent = procedure(Sender: TObject; TheIndex: Integer) of object;
  TIndexDrawEvent = procedure(Sender: TObject; TheIndex: Integer; TheCanvas: TCanvas; TheRect: TRect) of object;
  TIndexEnableEvent = procedure(Sender: TObject; TheIndex: Integer; var EnableDefault: Boolean) of object;
  TChangeValueEvent = procedure(Sender: TObject; TheIndex: Integer; Editing: Boolean; const Value: string) of object;

  TCustomInspector = class(TCustomListBox)
  private
    FCheckBox: TInspectorCheckBox;
    FEdit: TInspectorEdit;
    FButton: TInspectorButton;
    FIndex: Integer;
    FFullUpdate: Boolean;
    FOldScrollPos: Integer;
    FClicked: Boolean;
    FOldWidth: Integer;
    FOldHeight: Integer;
    FOldSplitter: Integer;
    FLockCounter: Integer;
    FSplitter: Integer;
    FCheckBoxes: Boolean;
    FPaintStyle: TPaintStyle;
    FDragSplitter: Integer;
    FDragKind: TDragKind;
    FPopup: TInspectorPopup;
    FExpand: TBitmap;
    FCollapse: TBitmap;
    FItemCount: Integer;
    FOnSelect: TIndexNotifyEvent;
    FOnUpdate: TNotifyEvent;
    FOnValidateChar: TValidateCharEvent;
    FOnChangeValue: TChangeValueEvent;
    FOnDrawName: TIndexDrawEvent;
    FOnDrawValue: TIndexDrawEvent;
    FOnGetName: TGetStringEvent;
    FOnGetValue: TGetStringEvent;
    FOnGetNextValue: TGetStringEvent;
    FOnSetValue: TSetStringEvent;
    FOnGetButtonType: TButtonTypeEvent;
    FOnGetInplaceEditorType: TInplaceEditorTypeEvent;
    FOnGetMaxLength: TIntegerEvent;
    FOnGetEditMask: TGetStringEvent;
    FOnGetEnableExternalEditor: TBooleanEvent;
    FOnGetReadOnly: TBooleanEvent;
    FOnGetExpandState: TExpandStateEvent;
    FOnGetLevel: TIntegerEvent;
    FOnGetData: TPointerEvent;
    FOnGetValuesList: TStringsEvent;
    FOnGetSortValuesList: TBooleanEvent;
    FOnGetSelectedValue: TGetStringEvent;
    FOnGetAutoApply: TBooleanEvent;
    FOnGetNameFont: TFontEvent;
    FOnGetNameColor: TColorEvent;
    FOnGetValueFont: TFontEvent;
    FOnGetValueColor: TColorEvent;
    FOnCallEditor: TCallEditorEvent;
    FOnExpand: TIndexNotifyEvent;
    FOnCollapse: TIndexNotifyEvent;
    FOnSelectItem: TIndexNotifyEvent;
    FOnDeselectItem: TIndexNotifyEvent;
    FOnValueDoubleClick: TIndexEnableEvent;
    FOnDragValue: TIntegerEvent;
    function GetLocked: Boolean;
    function GetItemCount: Integer;
    procedure SetItemCount(const Value: Integer);
    procedure SetSplitter(const Value: Integer);
    procedure SetCheckBoxes(const Value: Boolean);
    procedure SetPaintStyle(const Value: TPaintStyle);
    procedure DrawDragSplitter;
    procedure SetMouseItem(Pos: LParam);
    function Action(A: TItemAction): Boolean;
    procedure HidePopup;
    function IsFocused: Boolean;
    function SpecialClick(L: LParam): Boolean;
    procedure UpdateControls;
    procedure SetIndex(const Value: Integer);
    procedure FocusControl;
//    {$IFDEF GOITRIAL}
//    procedure TrialMessage;
//    {$ENDIF}
  protected
    procedure WndProc(var Message: TMessage); override;
    function GetDefaultIndex: Integer; virtual;
    procedure FullUpdateNeeded;
    function GetPopupItemWidth(ListBox: TListBox; TheIndex: Integer): Integer; virtual;
    procedure DrawPopupItem(ListBox: TListBox; ListItemIndex: Integer; R: TRect; TheIndex: Integer); virtual;
    procedure SetEditedText(const AText: string); virtual;
    function ValidateChar(TheIndex: Integer; var Key: Char): Boolean; virtual;
    procedure ChangeValue(TheIndex: Integer; Editing: Boolean; const AText: string); virtual;
    procedure SetSelectionPos(TheIndex: Integer; NeedUpdate: Boolean);
    procedure DrawPropertyName(TheCanvas: TCanvas; TheIndex: Integer; R: TRect); virtual;
    procedure DrawPropertyValue(TheCanvas: TCanvas; TheIndex: Integer; R: TRect); virtual;
    procedure DrawVerticalSeparator(TheCanvas: TCanvas; TheIndex: Integer; R: TRect); virtual;
    procedure DrawHorizontalSeparator(TheCanvas: TCanvas; TheIndex: Integer; R: TRect); virtual;
    procedure DrawBorders(TheCanvas: TCanvas; TheIndex: Integer; R: TRect); virtual;
    function GetName(TheIndex: Integer): string; virtual;
    function GetValue(TheIndex: Integer): string; virtual;
    function GetNextValue(TheIndex: Integer): string; virtual;
    procedure SetValue(TheIndex: Integer; const Value: string); virtual;
    procedure DragValue(TheIndex,Offset: Integer); virtual;
    function GetButtonType(TheIndex: Integer): TButtonType; virtual;
    function GetInplaceEditorType(TheIndex: Integer): TInplaceEditorType; virtual;
    function GetMaxLength(TheIndex: Integer): Integer; virtual;
    function GetEditMask(TheIndex: Integer): string; virtual;
    function GetEnableExternalEditor(TheIndex: Integer): Boolean; virtual;
    function GetReadOnly(TheIndex: Integer): Boolean; virtual;
    function GetExpandState(TheIndex: Integer): TExpandState; virtual;
    function GetLevel(TheIndex: Integer): Integer; virtual;
    function GetData(TheIndex: Integer): Pointer; virtual;
    procedure GetValuesList(TheIndex: Integer; const Strings: TStrings); virtual;
    function GetSortValuesList(TheIndex: Integer): Boolean; virtual;
    function GetSelectedValue(TheIndex: Integer): string; virtual;
    function GetAutoApply(TheIndex: Integer): Boolean; virtual;
    procedure GetNameFont(TheIndex: Integer; TheFont: TFont); virtual;
    function GetNameColor(TheIndex: Integer): TColor; virtual;
    procedure GetValueFont(TheIndex: Integer; TheFont: TFont); virtual;
    function GetValueColor(TheIndex: Integer): TColor; virtual;
    function GetIndent: Integer; virtual;
    function CallEditor(TheIndex: Integer): Boolean; virtual;
    procedure Expand(TheIndex: Integer); virtual;
    procedure Collapse(TheIndex: Integer); virtual;
    procedure SelectItem(TheIndex: Integer); virtual;
    procedure DeselectItem(TheIndex: Integer); virtual;
    property ItemCount: Integer read GetItemCount write SetItemCount default 0;
    property Splitter: Integer read FSplitter write SetSplitter default 100;
    property CheckBoxes: Boolean read FCheckBoxes write SetCheckBoxes default False;
    property OnSelect: TIndexNotifyEvent read FOnSelect write FOnSelect;
    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
    property OnValidateChar: TValidateCharEvent read FOnValidateChar write FOnValidateChar;
    property OnChangeValue: TChangeValueEvent read FOnChangeValue write FOnChangeValue;
    property OnDrawName: TIndexDrawEvent read FOnDrawName write FOnDrawName;
    property OnDrawValue: TIndexDrawEvent read FOnDrawValue write FOnDrawValue;
    property OnGetName: TGetStringEvent read FOnGetName write FOnGetName;
    property OnGetValue: TGetStringEvent read FOnGetValue write FOnGetValue;
    property OnGetNextValue: TGetStringEvent read FOnGetNextValue write FOnGetNextValue;
    property OnSetValue: TSetStringEvent read FOnSetValue write FOnSetValue;
    property OnGetButtonType: TButtonTypeEvent read FOnGetButtonType write FOnGetButtonType;
    property OnGetInplaceEditorType: TInplaceEditorTypeEvent read FOnGetInplaceEditorType write FOnGetInplaceEditorType;
    property OnGetMaxLength: TIntegerEvent read FOnGetMaxLength write FOnGetMaxLength;
    property OnGetEditMask: TGetStringEvent read FOnGetEditMask write FOnGetEditMask;
    property OnGetEnableExternalEditor: TBooleanEvent read FOnGetEnableExternalEditor write FOnGetEnableExternalEditor;
    property OnGetReadOnly: TBooleanEvent read FOnGetReadOnly write FOnGetReadOnly;
    property OnGetExpandState: TExpandStateEvent read FOnGetExpandState write FOnGetExpandState;
    property OnGetLevel: TIntegerEvent read FOnGetLevel write FOnGetLevel;
    property OnGetData: TPointerEvent read FOnGetData write FOnGetData;
    property OnGetValuesList: TStringsEvent read FOnGetValuesList write FOnGetValuesList;
    property OnGetSortValuesList: TBooleanEvent read FOnGetSortValuesList write FOnGetSortValuesList;
    property OnGetSelectedValue: TGetStringEvent read FOnGetSelectedValue write FOnGetSelectedValue;
    property OnGetAutoApply: TBooleanEvent read FOnGetAutoApply write FOnGetAutoApply;
    property OnGetNameFont: TFontEvent read FOnGetNameFont write FOnGetNameFont;
    property OnGetNameColor: TColorEvent read FOnGetNameColor write FOnGetNameColor;
    property OnGetValueFont: TFontEvent read FOnGetValueFont write FOnGetValueFont;
    property OnGetValueColor: TColorEvent read FOnGetValueColor write FOnGetValueColor;
    property OnCallEditor: TCallEditorEvent read FOnCallEditor write FOnCallEditor;
    property OnExpand: TIndexNotifyEvent read FOnExpand write FOnExpand;
    property OnCollapse: TIndexNotifyEvent read FOnCollapse write FOnCollapse;
    property OnSelectItem: TIndexNotifyEvent read FOnSelectItem write FOnSelectItem;
    property OnDeselectItem: TIndexNotifyEvent read FOnDeselectItem write FOnDeselectItem;
    property OnValueDoubleClick: TIndexEnableEvent read FOnValueDoubleClick write FOnValueDoubleClick;
    property OnDragValue: TIntegerEvent read FOnDragValue write FOnDragValue;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; override;
    procedure CreateWnd; override;
    procedure Lock; virtual;
    procedure Unlock; virtual;
    procedure DrawPropertyNameDefault(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
    procedure DrawPropertyValueDefault(TheCanvas: TCanvas; TheIndex: Integer; R: TRect);
    procedure ApplyChanges;
    procedure IgnoreChanges;
    property InplaceEdit: TInspectorEdit read FEdit;
    property InplaceCheckBox: TInspectorCheckBox read FCheckBox;
    property Locked: Boolean read GetLocked;
    property Names[Index: Integer]: string read GetName;
    property Values[Index: Integer]: string read GetValue;
    property ButtonType[Index: Integer]: TButtonType read GetButtonType;
    property InplaceEditorType[Index: Integer]: TInplaceEditorType read GetInplaceEditorType;
    property EnableExternalEditor[Index: Integer]: Boolean read GetEnableExternalEditor;
    property ReadOnly[Index: Integer]: Boolean read GetReadOnly;
    property ExpandState[Index: Integer]: TExpandState read GetExpandState;
    property Index: Integer read FIndex write SetIndex;
    property Clicked: Boolean read FClicked write FClicked;
    property PaintStyle: TPaintStyle read FPaintStyle write SetPaintStyle default psClassic;
  end;

  TCommonInspector = class(TCustomInspector)
  published
    {$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 ItemCount;
    property CheckBoxes;
    property PaintStyle;
    property Splitter;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnStartDrag;
    property OnUpdate;
    property OnValidateChar;
    property OnChangeValue;
    property OnDrawName;
    property OnDrawValue;
    property OnGetName;
    property OnGetValue;
    property OnGetNextValue;
    property OnSetValue;
    property OnGetButtonType;
    property OnGetMaxLength;
    property OnGetEditMask;
    property OnGetInplaceEditorType;
    property OnGetEnableExternalEditor;
    property OnGetReadOnly;
    property OnGetExpandState;
    property OnGetLevel;
    property OnGetData;
    property OnGetValuesList;
    property OnGetSortValuesList;
    property OnGetSelectedValue;
    property OnGetAutoApply;
    property OnGetNameFont;
    property OnGetNameColor;
    property OnGetValueFont;
    property OnGetValueColor;
    property OnCallEditor;
    property OnExpand;
    property OnCollapse;
    property OnSelectItem;
    property OnDeselectItem;
    property OnValueDoubleClick;
    property OnDragValue;
  end;

implementation

{$R *.RES}
{$R-}

//{$IFDEF GOITRIAL}
//const
//  WM_TRIALMESSAGE = WM_USER + 1234;
//{$ENDIF}

const
  crUpDown = 1;

function StringToBoolean(const S: string): Boolean;
begin
  Result:=GetEnumValue(TypeInfo(Boolean),S)>0;
end;

function TInspectorPopup.Inspector: TCustomInspector;
begin
  if Assigned(Owner) then Result:=TCustomInspector(Owner)
  else Result:=nil;
end;

procedure TInspectorPopup.DrawItem(TheIndex: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  Canvas.FillRect(Rect);
  with Inspector do DrawPopupItem(Self,TheIndex,Rect,ItemIndex);
end;

procedure TInspectorPopup.WndProc(var Message: TMessage);

  procedure Close(OK: Boolean);
  begin
    if Visible then
    begin
      Hide;
      with Inspector do
      begin
        if OK and (Self.ItemIndex>-1) then
//          {$IFDEF GOITRIAL}
//          TrialMessage;
//          {$ELSE}
          FEdit.FEditing:=True;
          if (Self.ItemIndex<>-1) and (Self.ItemIndex<Self.Items.Count) then
          begin
            SetValue(ItemIndex,Self.Items[Self.ItemIndex]);
            Invalidate;
          end;
//          {$ENDIF}
        if Showing and CanFocus then
        begin
          SetFocus;
          FocusControl;
        end;
        UpdateControls;
      end;
    end;
  end;

begin
  with Message do
    case Msg of
      CM_CANCELMODE:
        if TCMCancelMode(Message).Sender<>Self then Close(False);
      CM_DIALOGCHAR,WM_ACTIVATEAPP: Close(False);
      WM_KEYDOWN:
        case wParam of
          VK_ESCAPE,VK_TAB: Close(False);
          VK_RETURN: Close(True);
        end;
      WM_LBUTTONUP: Close(PtInRect(ClientRect,Point(LoWord(lParam),HiWord(lParam))));
    end;
  inherited;
end;

constructor TInspectorPopup.Create(AOwner: TComponent);
begin
  inherited;
  ParentCtl3D:=False;
  Ctl3D:=False;
  Style:=lbOwnerDrawFixed;
  IntegralHeight:=True;
end;

function TInspectorEdit.Inspector: TCustomInspector;
begin
  if Assigned(Owner) then Result:=TCustomInspector(Owner)
  else Result:=nil;
end;

procedure TInspectorEdit.WndProc(var Message: TMessage);
begin
  with Message do
    case Msg of
      WM_LBUTTONDOWN:
      begin
        if Inspector.Clicked then Inspector.Clicked:=False
        else
        begin
          inherited;
          Inspector.HidePopup;
          if not Inspector.IsFocused then
          begin
            if Parent.CanFocus then Parent.SetFocus;
            if CanFocus then SetFocus;
          end;
        end;
      end;
      WM_LBUTTONDBLCLK:
      begin
        inherited;
        Inspector.Action(iaDoubleClick);
      end;
    else inherited;
    end;
end;

procedure TInspectorEdit.KeyPress(var Key: Char);
begin
  with Inspector do
  begin
    if not ValidateChar(ItemIndex,Key) then
    begin
      Key:=#0;
      MessageBeep(0);
    end;
    FEditing:=True;
  end;
end;

procedure TInspectorEdit.Change;
begin
  with Inspector do ChangeValue(ItemIndex,FEditing,Self.Text);
  FEditing:=False;
end;

function TInspectorCheckBox.Inspector: TCustomInspector;
begin
  if Assigned(Owner) then Result:=TCustomInspector(Owner)
  else Result:=nil;
end;

procedure TInspectorCheckBox.Click;
begin
  inherited;
  with Inspector do
    if Boolean(GetEnumValue(TypeInfo(Boolean),GetValue(ItemIndex)))<>Checked then
    begin