zproplst.pas

强大的皮肤控件 能做出美观的界面

{*******************************************************}
{       Run-Time Object Inspector component v1.2        }
{       Author: Gennadie Zuev                           }
{	E-mail: [e-mail]                           }
{	Web: http://unicorn.micex.ru/users/gena         }
{                                                       }
{       Copyright (c) 1999 Gennadie Zuev     	        }
{       Copyright (c) 2001 Evgeny Kryukov               }
{                                                       }
{*******************************************************}

{ Revision History:

  Version 2.0
  ===========
+ Delphi 6 Support

  Version 1.2
  ===========
+ Fixed rare "division by zero" error in VisibleRowCount function
+ When setting CurObj any unsaved changes in InplaceEdit are discarded
+ Added events OnChanging, OnChange
+ Fixed bug with visible scrollbar on empty PropList
+ Added "autocomplete" feature for enum properties
+ Fixed bug with changing Ctl3D property at run-time

  Version 1.1
  ===========
+ Now compatible with Delphi 2, 3, 4 and 5. In Delphi 5 you may need to compile
  Delphi5\Source\Toolsapi\DsgnIntf.pas and put resulting DCU in Delphi5\Lib
  folder
+ In Delphi 5 TPropertyEditor custom drawing is supported
+ if ShowHint is True, hint window will be shown when you move the mouse over
  a long property value (not working in D2)
+ Vertical scrollbar can be flat now (in D4, D5)
+ "+"/"-" button next to collapsed property can look like that found in Delphi 5
+ Two events were added (in D2 only one event)
+ Corrected some bugs in destructor

  Version 1.0
  ===========
  Initial Delphi 4 version.


  TZPropList property & events
  ============================

 (public)
  CurObj          - determines the object we are viewing|editing
  Modified        - True if any property of CurObj was modified
  VisibleRowCount - idicates number of rows that can fit in the visible area
  RowHeight       - height of a single row

 (published)
  Filter          - determines what kind of properties to show
  IntegralHeight  - determines whether to display the partial items
  Middle          - width of first column (containing property names)
  NewButtons      - determines whether to use D4 or D5 style when
                    displaing "+"/"-" button next to collapsed property
  PropColor       - color used to display property values
  ScrollBarStyle  - can make vertical scrollbar flat (D4&5)

  OnNewObject     - occurs when a new value is assigned to CurObj
  OnHint          - occurs when the mouse pauses over the property, whose
                    value is too long and doesn't fit in view. You can change
                    hint color, position and text here (absent in D2)
}

unit ZPropLst;

{$IFDEF VER90}
  {$DEFINE Delphi2}
  {$DEFINE Prior4}
{$ENDIF}

{$IFDEF VER100}
  {$DEFINE Delphi3}
  {$DEFINE Prior4}
{$ENDIF}

{$IFDEF VER120}
  {$DEFINE Delphi4}
  {$DeFINE Post4}
{$ENDIF}

{$IFDEF VER125}
  {$DEFINE Delphi4}
  {$DeFINE Post4}
  {$ObjExportAll On}
{$ENDIF}

{$IFDEF VER130}
  {$DEFINE Delphi5}
  {$DeFINE Post4}
  {$IFDEF BCB}
    {$ObjExportAll On}
  {$ENDIF}
{$ENDIF}

{$IFDEF VER140}
  {$DEFINE Delphi5}
  {$DEFINE Delphi6}
  {$DeFINE Post4}
{$ENDIF}

{$IFDEF VER150}
  {$DEFINE Delphi5}
  {$DEFINE Delphi6}
  {$DEFINE Delphi7}
  {$DeFINE Post4}
{$ENDIF}

interface

uses
{ !!! In Delphi 5 you may need to compile Delphi5\Source\Toolsapi\DsgnIntf.pas
  and put resulting DCU in Delphi5\Lib folder }
  Windows, Messages, Classes, Graphics, Controls, TypInfo, StdCtrls,
  {$IFDEF DELPHI6} DesignIntf, DesignEditors, DesignMenus, VCLEditors {$ELSE} DsgnIntf {$ENDIF},
  SysUtils, Forms {$IFDEF Delphi5}, Menus {$ENDIF}, INIFiles;

type
  TZPropList = class;

  TZPropType = (ptSimple, ptEllipsis, ptPickList);

  TZPopupList = class(TCustomListBox)
  private
    FSearchText: string;
    FSearchTickCount: Integer;
  protected
    procedure CreateWnd; override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Hide;
  end;

  TZInplaceEdit = class;
  TZListButton = class(TCustomControl)
  private
    FButtonWidth: Integer;
    FPressed: Boolean;
    FArrow: Boolean;
    FTracking: Boolean;
    FActiveList: TZPopupList;
    FListVisible: Boolean;
    FEditor: TZInplaceEdit;
    FPropList: TZPropList;
{$IFDEF Delphi5}
    FListItemHeight: Integer;
{$ENDIF}
    procedure TrackButton(X, Y: Integer);
    procedure StopTracking;
    procedure DropDown;
    procedure CloseUp(Accept: Boolean);
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
    {$IFDEF Delphi6}
    function Editor: IProperty;
    {$ELSE}
    function Editor: TPropertyEditor;
    {$ENDIF}
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMCancelMode(var Msg: TWMKillFocus); message WM_CANCELMODE;
{$IFDEF Delphi5}
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure MeasureHeight(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure DrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
      State: TOwnerDrawState);
{$ENDIF}
  protected
    procedure KeyPress(var Key: Char); override;
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Hide;
  end;

  TZInplaceEdit = class(TCustomEdit)
  private
    FPropList: TZPropList;
    FClickTime: Integer;
    FListButton: TZListButton;
    FAutoUpdate: Boolean;
    FPropType: TZPropType;
    FIgnoreChange: Boolean;
    procedure InternalMove(const Loc: TRect; Redraw: Boolean);
    procedure BoundsChanged;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure DblClick; override;
    procedure WndProc(var Message: TMessage); override;
    procedure Change; override;
    procedure AutoComplete(const S: string);
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Move(const Loc: TRect);
    procedure UpdateLoc(const Loc: TRect);
    procedure SetFocus; override;
  end;

  PZEditor = ^TZEditor;
  TZEditor = record
    {$IFDEF Delphi6}
    peEditor: IProperty;
    {$ELSE}
    peEditor: TPropertyEditor;
    {$ENDIF}
    peIdent: Integer;
    peNode: Boolean;
    peExpanded: Boolean;
  end;

  TZEditorList = class(TList)
  private
    FPropList: TZPropList;
    function GetEditor(AIndex: Integer): PZEditor;
  public
    procedure Clear;{$IFDEF Post4}override;{$ENDIF}
    procedure Add(Editor: PZEditor);
    procedure DeleteEditor(Index: Integer);
    function IndexOfPropName(const PropName: string;
      StartIndex: Integer): Integer;
    function FindPropName(const PropName: string): Integer;
    constructor Create(APropList: TZPropList);
    property Editors[AIndex: Integer]: PZEditor read GetEditor; default;
  end;

  {$IFDEF Delphi6}
  MyDesigner = IDesigner;
  MyComponent = TComponent;
  MyFilter = TLocalMenuTypes;
  {$ELSE}
  {$IFDEF Delphi5}
  MyDesigner = IFormDesigner;
  MyComponent = IComponent;
  MyFilter = TLocalMenuFilters;
  {$ENDIF}
  {$IFDEF Delphi4}
  MyDesigner = IFormDesigner;
  MyComponent = IComponent;
  {$ENDIF}
  {$ENDIF}

{$IFDEF Prior4}
  TZFormDesigner = class(TFormDesigner)
{$ELSE}
  TZFormDesigner = class(TInterfacedObject, MyDesigner)
{$ENDIF}
  private
    FPropList: TZPropList;
    procedure Modified; {$IFDEF Prior4} override; {$ENDIF}
{$IFDEF Prior4}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure GetSelections(List: TComponentList); override;
    procedure SetSelections(List: TComponentList); override;
  {$IFDEF Delphi3}
    procedure AddInterfaceMember(const MemberText: string); override;
  {$ENDIF}
{$ELSE}
    procedure Notification(AnObject: TPersistent; Operation: TOperation);
    procedure GetSelections(const List: IDesignerSelections);
    procedure SetSelections(const List: IDesignerSelections);
    function GetCustomForm: TCustomForm;
    procedure SetCustomForm(Value: TCustomForm);
    function GetIsControl: Boolean;
    procedure SetIsControl(Value: Boolean);
    procedure AddToInterface(InvKind: Integer; const Name: string; VT: Word;
      const TypeInfo: string);
    procedure GetProjectModules(Proc: TGetModuleProc);
    function GetAncestorDesigner: MyDesigner;
    function IsSourceReadOnly: Boolean;
{$ENDIF}
    function IsDesignMsg(Sender: TControl; var Message: TMessage): Boolean; {$IFDEF Prior4} override; {$ENDIF}
    procedure PaintGrid; {$IFDEF Prior4} override; {$ENDIF}
    procedure ValidateRename(AComponent: TComponent;
      const CurName, NewName: string); {$IFDEF Prior4} override; {$ENDIF}
    { IFormDesigner }
    function CreateMethod(const Name: string; TypeData: PTypeData): TMethod; {$IFDEF Prior4} override; {$ENDIF}
    function GetMethodName(const Method: TMethod): string; {$IFDEF Prior4} override; {$ENDIF}
    procedure GetMethods(TypeData: PTypeData; Proc: TGetStrProc); {$IFDEF Prior4} override; {$ENDIF}
    function GetPrivateDirectory: string; {$IFDEF Prior4} override; {$ENDIF}
    function MethodExists(const Name: string): Boolean; {$IFDEF Prior4} override; {$ENDIF}
    procedure RenameMethod(const CurName, NewName: string); {$IFDEF Prior4} override; {$ENDIF}
    procedure SelectComponent(Instance: {$IFDEF Delphi2}TComponent{$ELSE}TPersistent{$ENDIF}); {$IFDEF Prior4} override; {$ENDIF}
    procedure ShowMethod(const Name: string); {$IFDEF Prior4} override; {$ENDIF}
    function UniqueName(const BaseName: string): string; {$IFDEF Prior4} override; {$ENDIF}
    procedure GetComponentNames(TypeData: PTypeData; Proc: TGetStrProc); {$IFDEF Prior4} override; {$ENDIF}
    function GetComponent(const Name: string): TComponent; {$IFDEF Prior4} override; {$ENDIF}
    function GetComponentName(Component: TComponent): string; {$IFDEF Prior4} override; {$ENDIF}
    function MethodFromAncestor(const Method: TMethod): Boolean; {$IFDEF Prior4} override; {$ENDIF}
    function CreateComponent(ComponentClass: TComponentClass; Parent: TComponent;
      Left, Top, Width, Height: Integer): TComponent; {$IFDEF Prior4} override; {$ENDIF}
    function IsComponentLinkable(Component: TComponent): Boolean; {$IFDEF Prior4} override; {$ENDIF}
    procedure MakeComponentLinkable(Component: TComponent); {$IFDEF Prior4} override; {$ENDIF}
    function GetRoot: TComponent; {$IFDEF Prior4} override; {$ENDIF}
    procedure Revert(Instance: TPersistent; PropInfo: PPropInfo); {$IFDEF Prior4} override; {$ENDIF}
{$IFNDEF Delphi2}
    function GetObject(const Name: string): TPersistent; {$IFDEF Prior4} override; {$ENDIF}
    function GetObjectName(Instance: TPersistent): string; {$IFDEF Prior4} override; {$ENDIF}
    procedure GetObjectNames(TypeData: PTypeData; Proc: TGetStrProc); {$IFDEF Prior4} override; {$ENDIF}
    function GetIsDormant: Boolean; {$IFDEF Prior4} override; {$ENDIF}
    function HasInterface: Boolean; {$IFDEF Prior4} override; {$ENDIF}
    function HasInterfaceMember(const Name: string): Boolean; {$IFDEF Prior4} override; {$ENDIF}
{$ENDIF}
{$IFDEF Delphi5}
    function GetContainerWindow: TWinControl;
    procedure SetContainerWindow(const NewContainer: TWinControl);
    function GetScrollRanges(const ScrollPosition: TPoint): TPoint;
    procedure Edit(const Component: MyComponent);
    function BuildLocalMenu(Base: TPopupMenu; Filter: MyFilter): TPopupMenu;
    procedure ChainCall(const MethodName, InstanceName, InstanceMethod: string;
      TypeData: PTypeData);
    procedure CopySelection;
    procedure CutSelection;
    function CanPaste: Boolean;
    procedure PasteSelection;
    procedure ClearSelection;
    procedure NoSelection;
    procedure ModuleFileNames(var ImplFileName, IntfFileName, FormFileName: string);
    function GetRootClassName: string;
{$ENDIF}

    {$IFDEF Delphi6}
    procedure Activate;
    function GetPathAndBaseExeName: string;
    function GetBaseRegKey: string;
    function GetIDEOptions: TCustomIniFile;
    function CreateCurrentComponent(Parent: TComponent; const Rect: TRect): TComponent;
    function IsComponentHidden(Component: TComponent): Boolean;
    function GetShiftState: TShiftState;
    procedure ModalEdit(EditKey: Char; const ReturnWindow: IActivatable);
    procedure SelectItemName(const PropertyName: string);
    procedure Resurrect;
    procedure DeleteSelection(ADoAll: Boolean = False);
    {$ELSE}
    {$IFDEF Delphi5}
    procedure DeleteSelection;
    {$ENDIF}
    {$ENDIF}
  public
    constructor Create(APropList: TZPropList);
  end;

  TNewObjectEvent = procedure (Sender: TZPropList; OldObj,
    NewObj: TObject) of object;
{$IFNDEF Delphi2}
  THintEvent = procedure (Sender: TZPropList; Prop: TPropertyEditor;
    HintInfo: PHintInfo) of object;
{$ENDIF}
{$IFDEF Delphi6}
  TChangingEvent = procedure (Sender: TZPropList; var CanChange: Boolean) of object;
  TChangeEvent = procedure (Sender: TZPropList; Prop: IProperty) of object;
{$ELSE}
  TChangingEvent = procedure (Sender: TZPropList; var CanChange: Boolean) of object;
  TChangeEvent = procedure (Sender: TZPropList; Prop: TPropertyEditor) of object;
{$ENDIF}

  TZPropList = class(TCustomControl)
  private
    FCurObj: TObject;
    FPropCount: Integer;
    FEditors: TZEditorList;
    FRowHeight: Integer;
    FHasScrollBar: Boolean;
    FTopRow: Integer;
    FCurrent: Integer;
    FVertLine: Integer;
    FHitTest: TPoint;
    FDividerHit: Boolean;
    FInplaceEdit: TZInplaceEdit;
    FInUpdate: Boolean;
    FPropColor: TColor;
    FDesigner: TZFormDesigner;
    FIntegralHeight: Boolean;
    FDefFormProc: Pointer;
    FFormHandle: HWND;
    FFilter: TTypeKinds;
    FModified: Boolean;
    FCurrentIdent: Integer;
    FCurrentPos: Integer;
    FTracking: Boolean;
    FNewButtons: Boolean;
    FDestroying: Boolean;
    FBorderStyle: TBorderStyle;
{$IFDEF Post4}
    FScrollBarStyle: TScrollBarStyle;
{$ENDIF}
    FOnNewObject: TNewObjectEvent;
{$IFNDEF Delphi2}
    FOnHint: THintEvent;
{$ENDIF}
    FOnChanging: TChangingEvent;
    FOnAdvancedChange: TChangeEvent; 
    FOnChange: TNotifyEvent;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
{$IFNDEF Delphi2}
    procedure CMHintShow(var Msg: TCMHintShow); message CM_HINTSHOW;
{$ENDIF}    
    procedure SetCurObj(const Value: TObject);
    procedure UpdateScrollRange;
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
    procedure WMCancelMode(var Msg: TMessage); message WM_CANCELMODE;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure ModifyScrollBar(ScrollCode: Integer);
    procedure MoveTop(NewTop: Integer);
    function MoveCurrent(NewCur: Integer): Boolean;
    procedure InvalidateSelection;
    function VertLineHit(X: Integer): Boolean;
    function YToRow(Y: Integer): Integer;
    procedure SizeColumn(X: Integer);
    function GetValue(Index: Integer): string;
    function GetPrintableValue(Index: Integer): string;
    {$IFDEF Delphi6}
    procedure DoEdit(E: IProperty; DoEdit: Boolean; const Value: string);
    {$ELSE}
    procedure DoEdit(E: TPropertyEditor; DoEdit: Boolean; const Value: string);
    {$ENDIF}
    procedure SetValue(Index: Integer; const Value: string);
    procedure CancelMode;
    function GetEditRect: TRect;
    function UpdateText(Exiting: Boolean): Boolean;
    procedure SetPropColor(const Value: TColor);
    function ColumnSized(X: Integer): Boolean;
    procedure FreePropList;
    procedure InitPropList;
    {$IFDEF Delphi6}
    procedure PropEnumProc(const Prop: IProperty);
    {$ELSE}
    procedure PropEnumProc(Prop: TPropertyEditor);
    {$ENDIF}
    procedure SetIntegralHeight(const Value: Boolean);
    procedure FormWndProc(var Message: TMessage);
    procedure SetFilter(const Value: TTypeKinds);
    procedure ChangeCurObj(const Value: TObject);
    function GetName(Index: Integer): string;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    function GetValueRect(ARow: Integer): TRect;
    procedure SetNewButtons(const Value: Boolean);
    procedure SetMiddle(const Value: Integer);
{$IFDEF Post4}
    procedure SetScrollBarStyle(const Value: TScrollBarStyle);