Creating custom TSetProperty property editor

I'm trying to create a custom property editor for some custom component. The custom property editor is intended to edit some set property, like

type
  TButtonOption = (boOption1, boOption2, boOption3);
  TButtonOptions = set of TButtonOption;

my property editor descends from TSetProperty class. The problem is: my custom property editor doesn't get registered and Delphi IDE seems to use its own default set property editor, because ShowMessage() calls inside property editor methods never executes! I've created a sample package/component from scratch, as simple as possible, showing this issue. Here is the code:

unit Button1;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, DesignIntf, DesignEditors;

type
  TButtonOption = (boOption1, boOption2, boOption3);

  TButtonOptions = set of TButtonOption;

  TButtonEx = class(TButton)
  private
    FOptions: TButtonOptions;
    function GetOptions: TButtonOptions;
    procedure SetOptions(Value: TButtonOptions);
  published
    property Options: TButtonOptions read GetOptions write SetOptions default [];
  end;

  TMySetProperty = class(TSetProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetProperties(Proc: TGetPropProc); override;
    function GetValue: string; override;
  end;

procedure Register;

implementation

uses
  Dialogs;

// TButtonEx - sample component

function TButtonEx.GetOptions: TButtonOptions;
begin
  Result := FOptions;
end;

procedure TButtonEx.SetOptions(Value: TButtonOptions);
begin
  if FOptions <> Value then
  begin
    FOptions := Value;
  end;
end;

// register stuff

procedure Register;
begin
  RegisterComponents('Samples', [TButtonEx]);
  RegisterPropertyEditor(TypeInfo(TButtonOptions), nil, '', TMySetProperty);
end;

function TMySetProperty.GetAttributes: TPropertyAttributes;
begin
  ShowMessage('GetAttributes');
  Result := inherited GetAttributes;
end;

procedure TMySetProperty.GetProperties(Proc: TGetPropProc);
begin
  ShowMessage('GetProperties');
  inherited;
end;

function TMySetProperty.GetValue: string;
begin
  ShowMessage('GetValue');
  Result := inherited GetValue;
end;

end.

Please note that:

  • I'm registering the new property editor (TMySetProperty) for ALL components having a TButtonOptions property. I also tried to do it for TButtonEx only, but the result is the same.
  • I've added ShowMessage() calls inside all overriden methods of my custom property editor and those methods NEVER get called.
  • I've already debugged the package and RegisterPropertyEditor() executes. Nevertheless, my custom code in overridden methods never execute.
  • I've seen other 3rd party components using such property editor (TSetProperty descendants) running in older Delphi IDEs and I could not find any relevant difference in code. Maybe Delphi XE2+ requires something else?
  • So the question is: Why my custom property editor does not register/work?

    Note: This issue happens in Delphi XE2, XE3, XE4 and also XE5 at least. Other IDEs were not tested but probably have the same behavior.


    Finally I got a solution... After testing everything I could imagine - without success - I started searching for something "new" in DesignEditors.pas and DesignIntf.pas units. Reading GetEditorClass() function, I discovered that it first checks for a PropertyMapper. A property mapper can be registered using RegisterPropertyMapper() function. Using it instead of RegisterPropertyEditor() works just as expected. Here is my modified, working code, also showing some interesting application for this: show or hide some options of my set-based property, based on some criteria:

    unit Button1;
    
    interface
    
    uses
      System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls,
      DesignIntf, DesignEditors;
    
    type
      TButtonOption = (boOptionA, boOptionB, boOptionC);
      TButtonOptions = set of TButtonOption;
    
    type
      TButtonEx = class(TButton)
      private
        FOptions: TButtonOptions;
        function GetOptions: TButtonOptions;
        procedure SetOptions(Value: TButtonOptions);
      published
        property Options: TButtonOptions read GetOptions write SetOptions default [];
      end;
    
      TMySetProperty = class(TSetProperty)
      private
        FProc: TGetPropProc;
        procedure InternalGetProperty(const Prop: IProperty);
      public
        procedure GetProperties(Proc: TGetPropProc); override;
      end;
    
    procedure Register;
    
    implementation
    
    uses
      TypInfo;
    
    // TButtonEx - sample component
    
    function TButtonEx.GetOptions: TButtonOptions;
    begin
      Result := FOptions;
    end;
    
    procedure TButtonEx.SetOptions(Value: TButtonOptions);
    begin
      if FOptions <> Value then
      begin
        FOptions := Value;
      end;
    end;
    
    // Returns TMySetProperty as the property editor used for Options in TButtonEx class
    function MyCustomPropMapper(Obj: TPersistent; PropInfo: PPropInfo): TPropertyEditorClass;
    begin
      Result := nil;
      if Assigned(Obj) and (Obj is TButtonEx) and SameText(String(PropInfo.Name), 'Options') then begin
        Result := TMySetProperty;
      end;
    end;
    
    procedure Register;
    begin
      RegisterComponents('Samples', [TButtonEx]);
      // RegisterPropertyEditor does not work for set-based properties.
      // We use RegisterPropertyMapper instead
      RegisterPropertyMapper(MyCustomPropMapper);
    end;
    
    procedure TMySetProperty.GetProperties(Proc: TGetPropProc);
    begin
      // Save the original method received
      FProc := Proc;
      // Call inherited, but passing our internal method as parameter
      inherited GetProperties(InternalGetProperty);
    end;
    
    procedure TMySetProperty.InternalGetProperty(const Prop: IProperty);
    var
      i: Integer;
    begin
      if not Assigned(FProc) then begin   // just in case
        Exit;
      end;
    
      // Now the interesting stuff. I just want to show boOptionA and boOptionB in Object inspector
      // So I call the original Proc in those cases only
      // boOptionC still exists, but won't be visible in object inspector
      for i := 0 to PropCount - 1 do begin
        if SameText(Prop.GetName, 'boOptionA') or SameText(Prop.GetName, 'boOptionB') then begin
          FProc(Prop);       // call original method
        end;
      end;
    end;
    
    end.
    
    链接地址: http://www.djcxy.com/p/63138.html

    上一篇: 像TPageControl一样编辑属性

    下一篇: 创建自定义TSetProperty属性编辑器