rm_propinsp.pas

这是一个功能强大

    constructor Create(AParent: TELPropEditor); reintroduce;
    destructor Destroy; override;
  end;

    { Standart property editors }

  TELOrdinalPropEditor = class(TELPropEditor)
  protected
    function AllEqual: Boolean; override;
  end;

  TELIntegerPropEditor = class(TELOrdinalPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  TELCharPropEditor = class(TELOrdinalPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  TELEnumPropEditor = class(TELOrdinalPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TELFloatPropEditor = class(TELPropEditor)
  protected
    function AllEqual: Boolean; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  TELStringPropEditor = class(TELPropEditor)
  protected
    function AllEqual: Boolean; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
  end;

  TELSetElemPropEditor = class(TELNestedPropEditor)
  private
    FElement: Integer;
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
    function GetPropName: string; override;
    function AllEqual: Boolean; override;
  public
    constructor Create(AParent: TELPropEditor; AElement: Integer); reintroduce;
    property Element: Integer read FElement;
  end;

  TELSetPropEditor = class(TELOrdinalPropEditor)
  protected
    function GetValue: string; override;
    function GetAttrs: TELPropAttrs; override;
    procedure GetSubProps(AGetEditorClassProc: TELGetEditorClassProc; AResult: TList); override;
  end;

  TELClassPropEditor = class(TELPropEditor)
  protected
    function GetValue: string; override;
    function GetAttrs: TELPropAttrs; override;
    procedure GetSubProps(AGetEditorClassProc: TELGetEditorClassProc; AResult: TList); override;
  end;

  TELComponentPropEditor = class(TELPropEditor)
  protected
    function AllEqual: Boolean; override;
    function GetAttrs: TELPropAttrs; override;
    procedure GetSubProps(AGetEditorClassProc: TELGetEditorClassProc; AResult: TList); override;
    function GetValue: string; override;
    procedure GetValues(AValues: TStrings); override;
    procedure SetValue(const Value: string); override;
  end;

  TELVariantTypePropEditor = class(TELNestedPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    procedure GetValues(AValues: TStrings); override;
    function GetPropName: string; override;
    function GetAttrs: TELPropAttrs; override;
    function AllEqual: Boolean; override;
  end;

  TELVariantPropEditor = class(TELPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function GetAttrs: TELPropAttrs; override;
    procedure GetSubProps(AGetEditorClassProc: TELGetEditorClassProc; AResult: TList); override;
  end;

  TELInt64PropEditor = class(TELPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function AllEqual: Boolean; override;
  end;

  TELComponentNamePropEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
  end;

  TELDatePropEditor = class(TELPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function GetAttrs: TELPropAttrs; override;
  end;

  TELTimePropEditor = class(TELPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function GetAttrs: TELPropAttrs; override;
  end;

  TELDateTimePropEditor = class(TELPropEditor)
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    function GetAttrs: TELPropAttrs; override;
  end;

    { VCL property editors }

  TELCaptionPropEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
  end;

  TELColorPropEditor = class(TELIntegerPropEditor)
  private
    FValues: TStrings;
    procedure AddValue(const LS: string);
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    procedure GetValues(AValues: TStrings); override;
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
    procedure ValuesMeasureHeight(const AValue: string; ACanvas: TCanvas; var AHeight: Integer); override;
    procedure ValuesMeasureWidth(const AValue: string; ACanvas: TCanvas; var AWidth: Integer); override;
    procedure ValuesDrawValue(const AValue: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
  end;

  TELCursorPropEditor = class(TELIntegerPropEditor)
  private
    FValues: TStrings;
    procedure AddValue(const LS: string);
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    procedure GetValues(AValues: TStrings); override;
    function GetAttrs: TELPropAttrs; override;
    procedure ValuesMeasureHeight(const AValue: string; ACanvas: TCanvas; var AHeight: Integer); override;
    procedure ValuesMeasureWidth(const AValue: string; ACanvas: TCanvas; var AWidth: Integer); override;
    procedure ValuesDrawValue(const AValue: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
  end;

  TELFontCharsetPropEditor = class(TELIntegerPropEditor)
  private
    FValues: TStrings;
    procedure AddValue(const LS: string);
  protected
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
    procedure GetValues(AValues: TStrings); override;
    function GetAttrs: TELPropAttrs; override;
  end;

  TELFontNamePropEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TELImeNamePropEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TELFontPropEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TELModalResultPropEditor = class(TELIntegerPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    function GetValue: string; override;
    procedure GetValues(AValues: TStrings); override;
    procedure SetValue(const Value: string); override;
  end;

  TELPenStylePropEditor = class(TELEnumPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure ValuesMeasureHeight(const AValue: string; ACanvas: TCanvas; var AHeight: Integer); override;
    procedure ValuesMeasureWidth(const AValue: string; ACanvas: TCanvas; var AWidth: Integer); override;
    procedure ValuesDrawValue(const AValue: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
  end;

  TELBrushStylePropEditor = class(TELEnumPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure ValuesMeasureHeight(const AValue: string; ACanvas: TCanvas; var AHeight: Integer); override;
    procedure ValuesMeasureWidth(const AValue: string; ACanvas: TCanvas; var AWidth: Integer); override;
    procedure ValuesDrawValue(const AValue: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
  end;

  TELTabOrderPropEditor = class(TELIntegerPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
  end;

  TELShortCutPropEditor = class(TELOrdinalPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    function GetValue: string; override;
    procedure GetValues(AValues: TStrings); override;
    procedure SetValue(const Value: string); override;
  end;

  TELStringsPropEditor = class(TELClassPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

procedure ELGetObjectsProps(ADesigner: Pointer; AObjList: TList; AKinds: TTypeKinds;
  AOnlyNestable: Boolean; AGetEditorClassProc: TELGetEditorClassProc; AResult: TList);

{ TELPropertyInspector }

{
 ToDo ( TELPropertyInspector ):

}

type
  TELCustomPropertyInspector = class;

  TELPropertyInspectorItem = class(TELPropsPageItem)
  private
    FEditor: TELPropEditor;
    FDisplayValue: string;
    procedure EditorModified(Sender: TObject);
    procedure EditorGetComponent(Sender: TObject; const AComponentName: string; var AComponent: TComponent);
    procedure EditorGetComponentNames(Sender: TObject; AClass: TComponentClass; AResult: TStrings);
    procedure EditorGetComponentName(Sender: TObject; AComponent: TComponent; var AName: string);
    procedure DeGetPickList(AResult: TStrings);
    procedure SetEditor(const Value: TELPropEditor);
  protected
    function GetDisplayValue: string; override;
    procedure SetDisplayValue(const Value: string); override;
    procedure GetEditPickList(APickList: TStrings); override;
    procedure EditButtonClick; override;
    procedure EditDblClick; override;
    procedure PickListMeasureHeight(const AValue: string; ACanvas: TCanvas; var AHeight: Integer); override;
    procedure PickListMeasureWidth(const AValue: string; ACanvas: TCanvas; var AWidth: Integer); override;
    procedure PickListDrawValue(const AValue: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
  public
    destructor Destroy; override;
    procedure UpdateParams;
    property Editor: TELPropEditor read FEditor write SetEditor; // Editor is destroyed
        // with "Self"
  end;

  TELPropertyInspectorEditorDescr = record
    TypeInfo: PTypeInfo;
    ObjectClass: TClass;
    PropName: string;
    EditorClass: TELPropEditorClass;
  end;

  TELPropertyInspectorOnFilterProp = procedure(Sender: TObject;
    AInstance: TPersistent; APropInfo: PPropInfo; var AIncludeProp: Boolean) of object;
  TELPropertyInspectorOnGetCaptionColor = procedure(Sender: TObject; APropTypeInfo: PTypeInfo;
    const APropName: string; var AColor: TColor) of object;
  TELPropertyInspectorOnGetEditorClass = procedure(Sender: TObject;
    AInstance: TPersistent; APropInfo: PPropInfo; var AEditorClass: TELPropEditorClass) of object;

  TELPropertyInspectorPropKind = (pkProperties, pkEvents, pkReadOnly);
  TELPropertyInspectorPropKinds = set of TELPropertyInspectorPropKind;

  TELCustomPropertyInspector = class(TELCustomPropsPage)
  private
    FObjects: TList;
    FEditors: array of TELPropertyInspectorEditorDescr;
    FOnGetComponent: TELOnGetComponent;
    FOnGetComponentNames: TELOnGetComponentNames;
    FOnBeforeModify: TRMOnBeforeModifyEvent;
    FOnAfterModify: TRMOnAfterModifyEvent;
    FOnGetComponentName: TELOnGetComponentName;
    FPropKinds: TELPropertyInspectorPropKinds;
    FOnFilterProp: TELPropertyInspectorOnFilterProp;
    FComponentRefColor: TColor;
    FComponentRefChildColor: TColor;
    FExpandComponentRefs: Boolean;
    FReadOnly: Boolean;
    FDesigner: Pointer;
    FOnGetCaptionColor: TELPropertyInspectorOnGetCaptionColor;
    FObjectsLocked: Boolean;
    FOnGetEditorClass: TELPropertyInspectorOnGetEditorClass;
    procedure Change;
    procedure InternalModified;
    function IndexOfEditor(ATypeInfo: PTypeInfo; AObjectClass: TClass;
      const APropName: string; AEditorClass: TELPropEditorClass): Integer;
    procedure CheckObjectsLock;
    function GetObjects(AIndex: Integer): TPersistent;
    procedure SetObjects(AIndex: Integer; const Value: TPersistent);
    function GetObjectCount: Integer;
    procedure SetPropKinds(const Value: TELPropertyInspectorPropKinds);
    procedure SetComponentRefColor(const Value: TColor);
    procedure SetComponentRefChildColor(const Value: TColor);
    procedure SetExpandComponentRefs(const Value: Boolean);
    procedure SetReadOnly(const Value: Boolean);
    procedure SetDesigner(const Value: Pointer);
  protected
    function CreateItem(AParent: TELPropsPageItem): TELPropsPageItem; override;
    procedure ItemExpanded(AItem: TELPropsPageItem); override;
    procedure ItemCollapsed(AItem: TELPropsPageItem); override;
    function GetItemCaptionColor(AItem: TELPropsPageItem): TColor; override;
    function GetEditorClass(AInstance: TPersistent; APropInfo: PPropInfo): TELPropEditorClass; virtual;
    procedure GetComponent(const AComponentName: string; var AComponent: TComponent); virtual;
    procedure GetComponentNames(AClass: TComponentClass; AResult: TStrings); virtual;
    procedure GetComponentName(AComponent: TComponent; var AName: string); virtual;
    procedure FilterProp(AInstance: TPersistent; APropInfo: PPropInfo; var AIncludeProp: Boolean); virtual;
    procedure GetCaptionColor(APropTypeInfo: PTypeInfo; const APropName: string; var AColor: TColor); virtual;
    property Designer: Pointer read FDesigner write SetDesigner;
    property PropKinds: TELPropertyInspectorPropKinds read FPropKinds write SetPropKinds default [pkProperties];
    property ComponentRefColor: TColor read FComponentRefColor write SetComponentRefColor default clMaroon;
    property ComponentRefChildColor: TColor read FComponentRefChildColor write SetComponentRefChildColor default clGreen;
    property ExpandComponentRefs: Boolean read FExpandComponentRefs write SetExpandComponentRefs default True;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
    property OnGetComponent: TELOnGetComponent read FOnGetComponent write FOnGetComponent;
    property OnGetComponentNames: TELOnGetComponentNames read FOnGetComponentNames write FOnGetComponentNames;
    property OnGetComponentName: TELOnGetComponentName read FOnGetComponentName write FOnGetComponentName;
    property OnFilterProp: TELPropertyInspectorOnFilterProp read FOnFilterProp write FOnFilterProp;
    property OnBeforeModify: TRMOnBeforeModifyEvent read FOnBeforeModify write FOnBeforeModify;
    property OnAfterModify: TRMOnAfterModifyEvent read FOnAfterModify write FOnAfterModify;
    property OnGetCaptionColor: TELPropertyInspectorOnGetCaptionColor read FOnGetCaptionColor write FOnGetCaptionColor;
    property OnGetEditorClass: TELPropertyInspectorOnGetEditorClass read FOnGetEditorClass write FOnGetEditorClass;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Add(AObject: TPersistent);
    procedure AddObjects(aObjects: array of TPersistent);
    procedure Delete(AIndex: Integer);
    procedure Remove(AObject: TPersistent);
    procedure Clear;
    procedure UpdateItems;
    procedure AssignObjects(AObjects: TList);
    function IndexOf(AObject: TPersistent): Integer;
    procedure Modified;
    procedure RegisterPropEditor(ATypeInfo: PTypeInfo; AObjectClass: TClass;
      const APropName: string; AEditorClass: TELPropEditorClass);
    procedure UnregisterPropEditor(ATypeInfo: PTypeInfo; AObjectClass: TClass;
      const APropName: string; AEditorClass: TELPropEditorClass);
    property Objects[AIndex: Integer]: TPersistent read GetObjects write SetObjects;
    property ObjectCount: Integer read GetObjectCount;
  end;

  TELPropertyInspector = class(TELCustomPropertyInspector)
  public
    property Designer;
  published
    property PropKinds;
    property ComponentRefColor;
    property ComponentRefChildColor;
    property ExpandComponentRefs;
    property ReadOnly;
    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 OnBeforeModify;
    property OnAfterModify;
    property OnGetComponent;
    property OnGetComponentNames;
    property OnGetComponentName;