rm_propinsp.pas

这是一个功能强大

{*******************************************************}
{                                                       }
{       Extension Library                               }
{       Property Inspector and                          }
{       Standard property editors Unit                  }
{                                                       }
{       (c) 2002, Balabuyev Yevgeny                     }
{       E-mail: [e-mail]                      }
{                                                       }
{*******************************************************}

unit RM_PropInsp;

interface

{$I RM.INC}

uses
  Classes, Controls, Grids, Graphics, Windows, Messages, Forms, StdCtrls,
  SysUtils, Dialogs, TypInfo, ComCtrls, Menus, RM_PropAdds
{$IFDEF COMPILER6_UP}, Types, Variants{$ENDIF};

const
  SELDsgnrControlLockedDel = 'Control "%s" or some of it chidrens can ' +
    'not' + #13 + ' be deleted becouse they are locked';
  SELDsgnrControlsLockedDel = 'Some controls is locked. Can not delete' +
    ' controls.';
  SELDsgnrClipboardFormat = 'Extension Library designer components';

  { TELPropsPage }

type
  EELPropsPage = class(Exception);
  EELObjectList = class(Exception);
  TELItemByProc = procedure(AItem: TObject; AData: Pointer; var AResult: Boolean) of object;
  TRMOnBeforeModifyEvent = procedure(Sender: TObject; const aPropName: string) of object;
  TRMOnAfterModifyEvent = procedure(Sender: TObject; const aPropName, aPropValue: string) of object;

{$IFNDEF COMPILER5_UP}
  TIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;
  EPropertyError = class(Exception);
{$ENDIF}

  PRMPropInfo = ^TRMPropInfo;
  TRMPropInfo = packed record
    ObjectClass: string;
    PropTrueName: string;
    PropName: string;
    PropCommon: string;
  end;

  { TRMPropInfoList }
  TRMPropInfoList = class(TList)
  private
  protected
  public
    constructor Create;
    procedure Clear; {$IFDEF COMPILER5_UP} override; {$ENDIF}
    procedure GetResource;
  end;

  TELObjectList = class
  private
    FItems: TList;
    FChangingCount: Boolean;
    function GetItems(AIndex: Integer): TObject;
    function GetCount: Integer;
    procedure SetCount(const Value: Integer);
  protected
    function CreateItem: TObject; virtual;
    procedure ValidateAddition; virtual;
    procedure ValidateDeletion; virtual;
    procedure Change; virtual;
    procedure Added; virtual;
    procedure Deleted; virtual;
    function DoItemBy(AData: Pointer; AItemByProc: TELItemByProc): TObject;
    function DoFind(AData: Pointer; AItemByProc: TELItemByProc): TObject;
    function DoSearch(AData: Pointer; AItemByProc: TELItemByProc): TObject;
  public
    constructor Create;
    destructor Destroy; override;
    function Add: Integer;
    procedure Remove(AItem: TObject);
    procedure Delete(AIndex: Integer);
    procedure Clear;
    function IndexOf(AItem: TObject): Integer;
    property Items[AIndex: Integer]: TObject read GetItems; default;
    property Count: Integer read GetCount write SetCount;
  end;

  TELCustomPropsPage = class;
  TELPropsPageItems = class;

  TELPropsPageInplaceEdit = class(TInplaceEditList)
  private
    FChangingBounds: Boolean;
    FReadOnlyStyle: Boolean;
    procedure PickListMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    procedure PickListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure WMLButtonDblClk(var Message: TWMMouse); message WM_LBUTTONDBLCLK;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DropDown; override;
    procedure UpdateContents; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DoEditButtonClick; override;
    procedure DoGetPickListItems; override;
    procedure CloseUp(Accept: Boolean); override;
    procedure DblClick; override;
    procedure BoundsChanged; override;
  public
    constructor Create(AOwner: TComponent); override;
    property ReadOnlyStyle: Boolean read FReadOnlyStyle;
  end;

  TELPropsPageItemExpandable = (mieAuto, mieYes, mieNo);

  TELPropsPageItem = class(TELObjectList)
  private
    FParent: TELPropsPageItem;
    FOwner: TELCustomPropsPage;
    FExpandable: TELPropsPageItemExpandable;
    FCaption, FVirtualCaption, FPropCommon: string;
    FExpanded: Boolean;
    FDisplayValue: string;
    FEditStyle: TEditStyle;
    FRow: Integer;
    FReadOnly: Boolean;
    FAutoUpdate: Boolean;
    FOwnerDrawPickList: Boolean;
    function CanExpand: Boolean;
    function Ident: Integer;
    function IsOnExpandButton(AX: Integer): Boolean;
    function GetItems(AIndex: Integer): TELPropsPageItem;
    procedure SetExpandable(const Value: TELPropsPageItemExpandable);
    procedure SetCaption(const Value: string);
    function GetLevel: Integer;
    procedure SetEditStyle(const Value: TEditStyle);
    procedure SetReadOnly(const Value: Boolean);
    procedure SetAutoUpdate(const Value: Boolean);
    procedure SetOwnerDrawPickList(const Value: Boolean);
  protected
    function CreateItem: TObject; override;
    procedure Change; override;
    procedure Deleted; override;
    function GetDisplayValue: string; virtual;
    procedure SetDisplayValue(const Value: string); virtual;
    procedure EditButtonClick; dynamic;
    procedure EditDblClick; dynamic;
    procedure GetEditPickList(APickList: TStrings); virtual;
    procedure PickListMeasureHeight(const AValue: string; ACanvas: TCanvas; var AHeight: Integer); virtual;
    procedure PickListMeasureWidth(const AValue: string; ACanvas: TCanvas; var AWidth: Integer); virtual;
    procedure PickListDrawValue(const AValue: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); virtual;
  public
    constructor Create(AOwner: TELCustomPropsPage; AParent: TELPropsPageItem); virtual;
    destructor Destroy; override;
    procedure Expand;
    procedure Collapse;
    property Owner: TELCustomPropsPage read FOwner;
    property Parent: TELPropsPageItem read FParent;
    property Expandable: TELPropsPageItemExpandable read FExpandable write SetExpandable;
    property Expanded: Boolean read FExpanded;
    property Level: Integer read GetLevel;
    property Caption: string read FCaption write SetCaption;
    property VirtualCaption: string read FVirtualCaption;
    property PropCommon: string read FPropCommon;
    property DisplayValue: string read GetDisplayValue write SetDisplayValue;
    property EditStyle: TEditStyle read FEditStyle write SetEditStyle;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly;
    property AutoUpdate: Boolean read FAutoUpdate write SetAutoUpdate;
    property OwnerDrawPickList: Boolean read FOwnerDrawPickList write SetOwnerDrawPickList;
    property Items[AIndex: Integer]: TELPropsPageItem read GetItems; default;
  end;

  TELPropsPageItems = class(TELObjectList)
  private
    FOwner: TELCustomPropsPage;
    function GetItems(AIndex: Integer): TELPropsPageItem;
  protected
    function CreateItem: TObject; override;
    procedure Change; override;
  public
    constructor Create(AOwner: TELCustomPropsPage);
    property Owner: TELCustomPropsPage read FOwner;
    property Items[AIndex: Integer]: TELPropsPageItem read GetItems; default;
  end;

  TELPropsPageState = set of (ppsMovingSplitter, ppsChanged, ppsDestroying,
    ppsUpdatingEditorContent);

{$IFDEF COMPILER6_UP}
  TELCustomGrid = TCustomGrid;
{$ELSE}
  TELCustomGrid = TD6CustomGrid;
{$ENDIF}

  TELCustomPropsPage = class(TELCustomGrid)
  private
    FState: TELPropsPageState;
    FOldRow: Integer;
    FSplitterOffset: Integer;
    FEditText: string;
    FItems: TELPropsPageItems;
    FRows: array of TELPropsPageItem;
    FUpdateCount: Integer;
    FValuesColor: TColor;
    FBitmap: Graphics.TBitmap;
    FBitmapBkColor: TColor;
//    FBrush: HBRUSH;
    FCellBitmap: Graphics.TBitmap;

    FCellHints: Boolean;
    FHintWnd: THintWindow;
    FLastXPos, FLastYPos: Integer;

    procedure ItemsChange;
    function IsOnSplitter(AX: Integer): Boolean;
    procedure UpdateColWidths;
    procedure UpdateScrollBar;
    procedure AdjustTopRow;
    function ItemByRow(ARow: Integer): TELPropsPageItem;
    procedure UpdateData(ARow: Integer);
    procedure UpdatePattern;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMExit(var Message: TMessage); message CM_EXIT;

    procedure SetCellHints(Value: Boolean);
    procedure CMMouseLeave(var Msg: TMessage); message cm_MouseLeave;
    procedure WMMouseMove(var Msg: TWMMouseMove); message wm_MouseMove;
    procedure DoHint(X, Y: Integer);

    function GetActiveItem: TELPropsPageItem;
    function GetSplitter: Integer;
    procedure SetSplitter(const Value: Integer);
    procedure SetValuesColor(const Value: TColor);
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    function SelectCell(ACol, ARow: Longint): Boolean; override;
    function CreateEditor: TInplaceEdit; override;
    procedure Paint; override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function GetEditStyle(ACol, ARow: Longint): TEditStyle; override;
    function CanEditModify: Boolean; override;
    function GetEditText(ACol, ARow: Longint): string; override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    procedure CreateHandle; 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 TopLeftChanged; override;
    procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
    function CreateItem(AParent: TELPropsPageItem): TELPropsPageItem; virtual;
    procedure ItemExpanded(AItem: TELPropsPageItem); virtual;
    procedure ItemCollapsed(AItem: TELPropsPageItem); virtual;
    function GetItemCaptionColor(AItem: TELPropsPageItem): TColor; virtual;
    property Items: TELPropsPageItems read FItems;
    property Splitter: Integer read GetSplitter write SetSplitter;
    property ValuesColor: TColor read FValuesColor write SetValuesColor default clNavy;
    property Color default clBtnFace;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure ClosePopup;

    property ActiveItem: TELPropsPageItem read GetActiveItem;
    property CellHints: Boolean read FCellHints write SetCellHints;
    property State: TELPropsPageState read FState write FState;
  end;

  TELPropsPage = class(TELCustomPropsPage)
  public
    property Items;
    property ActiveItem;
  published
    property Splitter;
    property ValuesColor;
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnStartDock;
    property OnStartDrag;
  end;

    { TELPropEditor }

type
  TELPropEditor = class;
  TELPropEditorClass = class of TELPropEditor;

  EELPropEditor = class(Exception);

  TELPropAttr = (praValueList, praSubProperties, praDialog, praMultiSelect,
    praSortList, praReadOnly, praVolatileSubProperties, praNotNestable, praAutoUpdate,
    praOwnerDrawValues, praComponentRef, praMethodProp);
  TELPropAttrs = set of TELPropAttr;

  TELGetEditorClassProc = function(AInstance: TPersistent; APropInfo: PPropInfo): TELPropEditorClass of object;

  TELOnGetComponent = procedure(Sender: TObject; const AComponentName: string; var AComponent: TComponent) of object;
  TELOnGetComponentNames = procedure(Sender: TObject; AClass: TComponentClass; AResult: TStrings) of object;
  TELOnGetComponentName = procedure(Sender: TObject; AComponent: TComponent; var AName: string) of object;

  TELPropEditorPropListItem = packed record
    Instance: TPersistent;
    PropInfo: PPropInfo;
  end;

  PELPropEditorPropList = ^TELPropEditorPropList;
  TELPropEditorPropList = array[0..1023 { Range not used }] of TELPropEditorPropListItem;

  TELPropEditor = class
  private
    FPropList: PELPropEditorPropList;
    FPropCount: Integer;
    FOnModified: TNotifyEvent;
    FOnGetComponent: TELOnGetComponent;
    FOnGetComponentNames: TELOnGetComponentNames;
    FOnGetComponentName: TELOnGetComponentName;
    FDesigner: Pointer;
    function GetPropTypeInfo: PTypeInfo;
    function DoGetValue: string;
  protected
    procedure SetPropEntry(AIndex: Integer; AInstance: TPersistent; APropInfo: PPropInfo);
    function GetComponent(const AComponentName: string): TComponent;
    procedure GetComponentNames(AClass: TComponentClass; AResult: TStrings);
    function GetComponentName(AComponent: TComponent): string;
    function GetValue: string; virtual;
    procedure SetValue(const Value: string); virtual;
    function GetAttrs: TELPropAttrs; virtual;
    procedure GetValues(AValues: TStrings); virtual;
    procedure GetSubProps(AGetEditorClassProc: TELGetEditorClassProc; AResult: TList); virtual; // Returns a list of TELPropEditor
    function GetPropName: string; virtual;
    function AllEqual: Boolean; virtual;
    procedure Edit; virtual;
    procedure ValuesMeasureHeight(const AValue: string; ACanvas: TCanvas; var AHeight: Integer); virtual;
    procedure ValuesMeasureWidth(const AValue: string; ACanvas: TCanvas; var AWidth: Integer); virtual;
    procedure ValuesDrawValue(const AValue: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); virtual;
  protected
    function GetPropInfo(AIndex: Integer): PPropInfo;
    function GetInstance(AIndex: Integer): TPersistent;
    function GetFloatValue(AIndex: Integer): Extended;
    function GetInt64Value(AIndex: Integer): Int64;
    function GetOrdValue(AIndex: Integer): Longint;
    function GetStrValue(AIndex: Integer): string;
    function GetVarValue(AIndex: Integer): Variant;
    procedure SetFloatValue(Value: Extended);
    procedure SetInt64Value(Value: Int64);
    procedure SetOrdValue(Value: Longint);
    procedure SetStrValue(const Value: string);
    procedure SetVarValue(const Value: Variant);
  public
    constructor Create(ADesigner: Pointer; APropCount: Integer); virtual;
    destructor Destroy; override;
    procedure Modified;
    property PropName: string read GetPropName;
    property PropTypeInfo: PTypeInfo read GetPropTypeInfo;
    property PropCount: Integer read FPropCount;
    property Value: string read DoGetValue write SetValue;
    property Designer: Pointer read FDesigner;
    property OnModified: TNotifyEvent read FOnModified write FOnModified;
    property OnGetComponent: TELOnGetComponent read FOnGetComponent write FOnGetComponent;
    property OnGetComponentNames: TELOnGetComponentNames read FOnGetComponentNames write FOnGetComponentNames;
    property OnGetComponentName: TELOnGetComponentName read FOnGetComponentName write FOnGetComponentName;
  end;

  TELNestedPropEditor = class(TELPropEditor)
  protected
    function GetPropName: string; override;
  public