cxoi.pas

delphi的的三方控件

  protected
    function HasSubProperties: Boolean;
  public
    function GetAttributes: TcxPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  EcxPropertyError = class(Exception);

  { TcxPropertyRow }

  TcxPropertyRow = class(TcxEditorRow)
  private
    FIsDefaultValue: Boolean;
    FPropertyEditor: TcxPropertyEditor;
  public
    property IsDefaultValue: Boolean read FIsDefaultValue;
    property PropertyEditor: TcxPropertyEditor read FPropertyEditor;
  end;

  { TcxRTTIInspectorEditingController }

  TcxRTTIInspectorEditingController = class(TcxEditingController)
  private
    FDeactivating: Boolean;
    function GetController: TcxRTTIInspectorController;
    function GetInspector: TcxCustomRTTIInspector;
  protected
    property Controller: TcxRTTIInspectorController read GetController;
    property Deactivating: Boolean read FDeactivating;
    property Inspector: TcxCustomRTTIInspector read GetInspector;
  public
    procedure HideEdit(Accept: Boolean); override;
  end;

  { TcxRTTIInspectorController }

  TcxRTTIInspectorController = class(TcxvgController)
  private
    FFocusChanging: Boolean;
    FNeedCorrect: Boolean;
    function GetEditingController: TcxRTTIInspectorEditingController;
    function GetFocusedRowIndex: Integer;
    function GetInspector: TcxCustomRTTIInspector;
    function GetRowIndexFromCellEdit(Value: TcxCustomInplaceEditContainer): Integer;
    procedure SetFocusedRowIndex(AIndex: Integer);
  protected
    procedure BeforeEditKeyDown(var Key: Word; var Shift: TShiftState); override;
    procedure DoEditDblClick(Sender: TObject); override;
    procedure DoUpdateRowAndCell(ANewRow: TcxCustomRow; ANewCellIndex: Integer); override;
    procedure FocusChanged; override;
    function IsKeyForController(AKey: Word; AShift: TShiftState): Boolean; override;
    procedure SetFocusedItem(Value: TcxCustomInplaceEditContainer); override;
    procedure SetFocusedRowAndCell(Value: TcxCustomRow; ACellIndex: Integer); override;
  public
    procedure SetFocusedRecordItem(ARecordIndex: Integer;
      AItem: TcxCustomInplaceEditContainer); override;
    property EditingController: TcxRTTIInspectorEditingController read GetEditingController;
    property Inspector: TcxCustomRTTIInspector read GetInspector;
  end;

  { TcxRTTIInspectorOptionsView }

  TcxRTTIInspectorOptionsView = class(TcxvgOptionsView)
  public
    constructor Create(AOwner: TPersistent); override;
  published
    property PaintStyle default psDelphi;
    property ShowEditButtons default ecsbFocused;
  end;

  { TcxRTTIInspectorOptionsBehavior }

  TcxRTTIInspectorOptionsBehavior = class(TcxvgOptionsBehavior)
  public
    constructor Create(AOwner: TPersistent); override;
  published
    property AlwaysShowEditor default True;
  end;

  { TcxCustomRTTIInspector }
  IcxRTTIInspectorHelper = interface
  ['{EA7182FA-139D-4525-9C5F-4D8BBAB5FEEE}']
    procedure CloseNonModal(AInspector: TcxCustomRTTIInspector);
    procedure PropertyChanged(AInspector: TcxCustomRTTIInspector);
  end;

  TcxFilterPropertyEvent = procedure(Sender: TObject; const PropertyName: string;
    var Accept: Boolean) of object;

  TcxCustomRTTIInspector = class(TcxUnboundVerticalGrid)
  private
    FBoldFont: TFont;
    FCurrentRow: TcxPropertyRow;
    FListeners: TList;
    FLockRefresh: Boolean;
    FInspectedObject: TPersistent;
    FParentRow: TcxCustomRow;
    FReloaded: Boolean;
    FSaveTopRowIndex: Integer;
    FSettingValue: Boolean;
    FOnFilterProperty: TcxFilterPropertyEvent;
    FOnFilterPropertyEx: TcxFilterPropertyEvent;
    FOnPropertyChanged: TNotifyEvent;
    function CanInvokePropertyEditorDlg: Boolean;
    procedure CNPropertyChanged(var AMessage: TMsg); message CN_PropertyChanged;
    procedure CreatePropertyRows(AOldInspectedObject: TPersistent);
    procedure CreateRows(APropertyEditor: TcxPropertyEditor);
    procedure GetComponentsProperties(const AInstances: array of TPersistent);
    function GetController: TcxRTTIInspectorController;
    function GetPropertyEditor: TcxPropertyEditor;
    procedure GetStrProc(const S: string);
    procedure ReleaseComponentProperties;
    procedure RowButtonClick(Sender: TObject; AbsoluteIndex: Integer);
    procedure SetInspectedObject(Value: TPersistent);
    procedure TryInvokePropertyEditorDlg;
    function TrySetValue(AEdit: TcxCustomEdit; AUseText: Boolean): Boolean;
  protected
    //override VCL
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      {$IFNDEF VCL}const{$ENDIF} MousePos: TPoint): Boolean; override;
    procedure FontChanged; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
    procedure DataChanged; override;
    procedure DoPropertyChanged;
    procedure EditChange(Sender: TObject);
    procedure EditValueChanged(Sender: TObject);
    function GetControllerClass: TcxCustomControlControllerClass; override;
    procedure GetDefaultViewParams(Index: Integer; AData: TObject; out AParams: TcxViewParams); override;
    function GetEditingControllerClass: TcxEditingControllerClass; override;
    function GetOptionsBehaviorClass: TcxControlOptionsBehaviorClass; override;
    function GetOptionsViewClass: TcxControlOptionsViewClass; override;

    function FilterProperty(const APropertyName: string): Boolean; virtual;
    function FilterPropertyEx(const AFullPropertyName: string): Boolean; virtual;
    function FindRowByPropertyName(const APropertyName: string): TcxPropertyRow;
    procedure FocusRowByPropertyName(const APropertyName: string);
    function GetEditPropertiesClass(APropertyEditor: TcxPropertyEditor): TcxCustomEditPropertiesClass; virtual;
    procedure PostChangedNotification;
    procedure PrepareEditProperties(AProperties: TcxCustomEditProperties; APropertyEditor: TcxPropertyEditor); virtual;

    property Controller: TcxRTTIInspectorController read GetController;
    property PropertyEditor: TcxPropertyEditor read GetPropertyEditor;
    property Reloaded: Boolean read FReloaded;
    property LockRefresh: Boolean read FLockRefresh;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddListener(AListener: TPersistent);
    procedure CloseNonModalEditors;
    procedure RefreshInspectedProperties;
    procedure RemoveListener(AListener: TPersistent);
    property InspectedObject: TPersistent read FInspectedObject write SetInspectedObject;
    property OnFilterProperty: TcxFilterPropertyEvent read FOnFilterProperty write FOnFilterProperty;
    property OnFilterPropertyEx: TcxFilterPropertyEvent read FOnFilterPropertyEx write FOnFilterPropertyEx;
    property OnPropertyChanged: TNotifyEvent read FOnPropertyChanged write FOnPropertyChanged;
  end;

  { TcxRTTIInspector }

  TcxRTTIInspector = class(TcxCustomRTTIInspector)
  published
    property Align;
    property Anchors;
    property Constraints;
  {$IFDEF VCL}
    property DragCursor;
    property DragKind;
  {$ENDIF}
    property DragMode;
    property Enabled;
    property Font;
    property Images;
    property InspectedObject;
    property LayoutStyle;
    property LookAndFeel;
    property OptionsView; //before OptionsBehavior
    property OptionsBehavior;
    property OptionsData;
    property ParentFont;
    property PopupMenu;
    property Styles;
    property TabOrder;
    property TabStop;
    property Visible;

    property OnClick;
  {$IFDEF DELPHI5}
    property OnContextPopup;
  {$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawBackground;
    property OnDrawRowHeader;
    property OnDrawValue;
    property OnEdited;
    property OnEditing;
    property OnEditValueChanged;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnFilterProperty;
    property OnFilterPropertyEx;
    property OnItemChanged;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnLayoutChanged;
    property OnLeftVisibleBandIndexChanged;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnPropertyChanged;
    property OnResize;
  {$IFDEF VCL}
    property OnStartDock;
  {$ENDIF}
    property OnStartDrag;
    property OnTopRowIndexChanged;
  end;

procedure cxRegisterPropertyEditor(APropertyType: PTypeInfo; AComponentClass: TClass;
  const APropertyName: string; AEditorClass: TcxPropertyEditorClass);

type
  TcxPropertyMapperFunc = function(Obj: TPersistent; PropInfo: PPropInfo): TcxPropertyEditorClass;

procedure cxRegisterPropertyMapper(AMapper: TcxPropertyMapperFunc);
procedure cxGetComponentProperties(AOwner: TComponent;
  AInspector: TcxCustomRTTIInspector; AComponents: TcxComponentList;
  AFilter: TTypeKinds; AProc: TcxGetPropEditProc);

function cxGetPropertiesClassByEditor(APropertyEditor: TcxPropertyEditor): TcxCustomEditPropertiesClass;
procedure cxRegisterEditPropertiesClass(AEditorClass: TcxPropertyEditorClass; AEditPropertiesClass: TcxCustomEditPropertiesClass);
function HasProperty(AClass: TClass; const APropertyName: string): Boolean;
function IsUniquePropertyRelativeTo(AClass, ARelativeClass: TClass; const APropertyName: string): Boolean;
function IsUniquePropertyRelativeParent(AClass: TClass; const APropertyName: string): Boolean;

function IsValidInspectedObject(AObject: TPersistent; AInspector: TcxCustomRTTIInspector): Boolean;

procedure cxDotNetInspectObject(AObject: TPersistent; AInspector: TcxRTTIInspector);

implementation

uses
  Menus, Clipbrd, Dialogs, Consts, Registry, MPlayer,
  cxOIStringsEd, cxOIPictureEd, cxOICollectionEd, cxColorComboBox,
{$IFDEF DELPHI6}
  Variants,
{$ELSE}
  cxVariants,
{$ENDIF}
  cxTextEdit, cxDropDownEdit, cxCalendar, cxSpinEdit, cxTimeEdit, cxButtonEdit,
  cxControls, cxCustomData, cxGeometry, cxClasses, cxVGridConsts;

const
  cxSString = 'String';
  cxSNull = '(Null)';
  cxSUnassigned = '(Unassigned)';

type
  TcxCustomRowAccess = class(TcxCustomRow);
  TcxCustomEditPropertiesAccess = class(TcxCustomEditProperties);
  TcxEditCellViewInfoAccess = class(TcxEditCellViewInfo);
  TcxColorComboBoxPropertiesAccess = class(TcxColorComboBoxProperties);
{$IFNDEF DELPHI6}
  IInterface = IUnknown;
{$ENDIF}

  TcxIntegerSet = set of 0..SizeOf(Integer) * 8 - 1;

  TcxPropertyClassRec = class
    Group: Integer;
    PropertyType: PTypeInfo;
    PropertyName: string;
    ComponentClass: TClass;
    EditorClass: TcxPropertyEditorClass;
  end;

  TcxPropertyMapperRec = class
    Group: Integer;
    Mapper: TcxPropertyMapperFunc;
  end;

  TcxEditPropertiesMapperRec = class
    EditorClass: TcxPropertyEditorClass;
    EditPropertiesClass: TcxCustomEditPropertiesClass;
  end;

  TcxInspectedObjectPropertyEditor = class(TcxComponentProperty)
  protected
    function IsValidComponent(AComponent: TComponent): Boolean; override;
  end;

const
  cxPropClassMap: array[TTypeKind] of TcxPropertyEditorClass = (
    nil, TcxIntegerProperty, TcxCharProperty, TcxEnumProperty,
    TcxFloatProperty, TcxStringProperty, TcxSetProperty, TcxClassProperty,
    nil, TcxPropertyEditor, TcxStringProperty, TcxStringProperty,
    TcxPropertyEditor, nil, nil, nil, TcxInt64Property, nil);

var
  FPropertyClasses: TList = nil;
  FPropertyMappers: TList = nil;
  FEditPropertiesClasses: TList = nil;

{$IFNDEF DELPHI5}
function SameText(const S1, S2: string): Boolean; assembler;
asm
        CMP     EAX,EDX
        JZ      @1
        OR      EAX,EAX
        JZ      @2
        OR      EDX,EDX
        JZ      @3
        MOV     ECX,[EAX-4]
        CMP     ECX,[EDX-4]
        JNE     @3
        CALL    CompareText
        TEST    EAX,EAX
        JNZ     @3
@1:     MOV     AL,1
@2:     RET
@3:     XOR     EAX,EAX
end;
{$ENDIF}

function HasProperty(AClass: TClass; const APropertyName: string): Boolean;
var
  TypeKinds: TTypeKinds;
  PropCount: Integer;
  PropList: PPropList;
  I: Integer;
begin
  TypeKinds := tkProperties;
  PropCount := GetPropList(AClass.ClassInfo, TypeKinds, nil);
  if PropCount > 0 then
  begin
    PropList := AllocMem(PropCount * SizeOf(PPropInfo));
    try
      PropCount := GetPropList(AClass.ClassInfo, TypeKinds, PropList);
      I := 0;
      while (I < PropCount) and (CompareText(PropList^[I].Name, APropertyName) <> 0) do
        Inc(I);
      Result := I < PropCount;
    finally
      FreeMem(PropList, PropCount * SizeOf(PPropInfo));
    end;
  end
  else
    Result := False;
end;

function IsUniquePropertyRelativeTo(AClass, ARelativeClass: TClass; const APropertyName: string): Boolean;  
begin
  Result := HasProperty(AClass, APropertyName) and
    ((ARelativeClass = nil) or not HasProperty(ARelativeClass, APropertyName));
end;

function IsUniquePropertyRelativeParent(AClass: TClass; const APropertyName: string): Boolean;
begin
  Result := IsUniquePropertyRelativeTo(AClass, AClass.ClassParent, APropertyName);
end;

function IsValidInspectedObject(AObject: TPersistent; AInspector: TcxCustomRTTIInspector): Boolean;
begin
  Result := AObject <> AInspector;
  if Result and (AObject is TcxCustomRTTIInspector) then
    Result := IsValidInspectedObject(TcxCustomRTTIInspector(AObject).InspectedObject, AInspector);
end;

{ TComponentList }

constructor TcxComponentList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TcxComponentList.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TcxComponentList.GetItem(Index: Integer): TPersistent;
begin
  Result := FList[Index];
end;

function TcxComponentList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TcxComponentList.Add(Item: TPersistent): Integer;
begin
  Result := FList.Add(Item);
end;

function TcxComponentList.Equals(List: TcxComponentList): Boolean;
var
  I: Integer;
begin
  Result := False;
  if List.Count <> FList.Count then Exit;
  for I := 0 to List.Count - 1 do
    if List[I] <> FList[I] then Exit;
  Result := True;
end;

function cxGetPropertiesClassByEditor(APropertyEditor: TcxPropertyEditor): TcxCustomEditPropertiesClass;
var
  I: Integer;
  Item: TcxEditPropertiesMapperRec;
begin
  Result := nil;
  if FEditPropertiesClasses <> nil then
    for I := 0 to FEditPropertiesClasses.Count - 1 do
    begin
      Item := TcxEditPropertiesMapperRec(FEditPropertiesClasses[I]);
      if Item.EditorClass.InheritsFrom(APropertyEditor.ClassType) then
        Result := Item.EditPropertiesClass;
      if Item.EditorClass = APropertyEditor.ClassType then
        Exit;
    end;
end;

procedure cxRegisterEditPropertiesClass(
  AEditorClass: TcxPropertyEditorClass;
  AEditPropertiesClass: TcxCustomEditPropertiesClass);
var
  Item: TcxEditPropertiesMapperRec;
begin
  if FEditPropertiesClasses = nil then FEditPropertiesClasses := TList.Create;
  Item := TcxEditPropertiesMapperRec.Create;
  Item.EditorClass := AEditorClass;
  Item.EditPropertiesClass := AEditPropertiesClass;
  FEditPropertiesClasses.Insert(0, Item);
end;

procedure ListFreeAndNil(var List: TList);
var
  I: Integer;
begin
  if List <> nil then