Delphi 创建自定义TSetProperty属性编辑器

我正在尝试为某些自定义组件创建自定义属性编辑器。自定义特性编辑器用于编辑某些集合特性，如

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

我的属性编辑器是从TSetProperty类派生的。问题是：我的自定义属性编辑器没有注册，Delphi IDE似乎使用它自己的默认集属性编辑器，因为属性编辑器方法中的ShowMessage（）调用永远不会执行！我从头开始创建了一个示例包/组件，尽可能简单，显示了这个问题。代码如下：

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.

单元按钮1；
接口
使用
System.SysUtils、System.Class、Vcl.Controls、Vcl.StdCtrls、DesignIntf、DesignEditor；
类型
t按钮选项=（boOption1、boOption2、boOption3）；
TButtonOptions=TButtonOptions的集合；
TButtonEx=类别（TButton）
私有的
选项：t按钮选项；
函数GetOptions:TButtonOptions；
程序设置选项（值：TButtonOptions）；
出版
属性选项：TButtonOptions读取GetOptions写入SetOptions默认值[]；
结束；
TMySetProperty=class（TSetProperty）
公众的
函数GetAttributes:TPropertyAttributes；推翻
过程GetProperties（Proc:TGetPropProc）；推翻
函数GetValue:string；推翻
结束；
程序登记册；
实施
使用
对话；
//TButtonEx-样本组件
函数TButtonEx.GetOptions:TButtonOptions；
开始
结果：=选项；
结束；
程序TButtonEx.SetOptions（值：TButtonOptions）；
开始
如果选项值为
开始
选项：=值；
结束；
结束；
//登记资料
程序登记册；
开始
注册表组件（'样本'，[TButtonEx]）；
RegisterPropertyEditor（TypeInfo（TButtonOptions），nil'，TMySetProperty）；
结束；
函数TMySetProperty.GetAttributes:TPropertyAttributes；
开始
ShowMessage（'GetAttributes'）；
结果：=继承的GetAttributes；
结束；
过程TMySetProperty.GetProperties（Proc:TGetPropProc）；
开始
ShowMessage（'GetProperties'）；
继承；
结束；
函数TMySetProperty.GetValue:string；
开始
ShowMessage（'GetValue'）；
结果：=继承的GetValue；
结束；
结束。

请注意：

我正在为所有具有TButtonOptions属性的组件注册新的属性编辑器（TMySetProperty）。我也试着只为TButtonEx做，但结果是一样的

我在自定义属性编辑器的所有重写方法中添加了ShowMessage（）调用，这些方法永远不会被调用

我已经调试了包，并执行RegisterPropertyEditor（）。然而，我在重写方法中的自定义代码永远不会执行

我见过其他第三方组件使用这种属性编辑器（TSetProperty后代）在旧的DelphiIDE中运行，我在代码中找不到任何相关的差异。也许Delphi XE2+还需要其他东西

因此，问题是： 为什么我的自定义属性编辑器不注册/工作

---

注意：此问题至少发生在Delphi XE2、XE3、XE4和XE5中。其他IDE没有经过测试，但可能具有相同的行为。

最后我得到了一个解决方案。。。在测试了我能想象到的一切之后——没有成功——我开始在DesignEditors.pas和DesignIntf.pas单元中寻找一些“新的”。在阅读GetEditorClass（）函数时，我发现它首先检查属性映射。可以使用RegisterPropertyMapper（）函数注册属性映射器。使用它而不是registerPropertyEdit（）的效果与预期一样。这是我修改过的工作代码，也展示了一些有趣的应用程序：根据一些条件显示或隐藏我的基于集合的属性的一些选项：

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.

单元按钮1；
接口
使用
System.SysUtils、System.Class、Vcl.Controls、Vcl.stdctrl、，
设计编辑；
类型
TButtonOption=（boOptionA、boOptionB、boOptionC）；
TButtonOptions=TButtonOptions的集合；
类型
TButtonEx=类别（TButton）
私有的
选项：t按钮选项；
函数GetOptions:TButtonOptions；
程序设置选项（值：TButtonOptions）；
出版
属性选项：TButtonOptions读取GetOptions写入SetOptions默认值[]；
结束；
TMySetProperty=class（TSetProperty）
私有的
FProc:TGetPropProc；
过程InternalGetProperty（常量属性：IProperty）；
公众的
过程GetProperties（Proc:TGetPropProc）；推翻
结束；
程序登记册；
实施
使用
TypInfo；
//TButtonEx-样本组件
函数TButtonEx.GetOptions:TButtonOptions；
开始
结果：=选项；
结束；
程序TButtonEx.SetOptions（值：TButtonOptions）；
开始
如果选项值为
开始
选项：=值；
结束；
结束；
//返回TMySetProperty作为用于TButtonEx类中的选项的属性编辑器
函数MyCustomPropMapper（Obj:TPersistent；PropInfo:PPropInfo）：tpPropertyEditorClass；
开始
结果：=无；
如果指定了（Obj）和（Obj是TButtonEx）以及SameText（String（PropInfo.Name），“Options”），则开始
结果：=TMySetProperty；
结束；
结束；
程序登记册；
开始
注册表组件（'样本'，[TButtonEx]）；
//RegisterPropertyEditor不适用于基于集合的属性。
//我们改用RegisterPropertyMapper
RegisterPropertyMapper（MyCustomPropMapper）；
结束；
过程TMySetProperty.GetProperties（Proc:TGetPropProc）；
开始
//保存收到的原始方法
FProc:=Proc；
//调用继承，但将内部方法作为参数传递
继承的GetProperties（InternalGetProperty）；
结束；
过程TMySetProperty.InternalGetProperty（const Prop:IProperty）；
变量
i：整数；
开始
如果未分配（FProc），则开始//以防万一
出口
结束；
//现在是有趣的事情。我只想在对象检查器中显示boOptionA和boOptionB
//所以我只在这些情况下调用原始Proc
//boOptionC仍然存在，但在对象检查器中不可见
对于i:=0到PropCount-1，请开始
如果SameText（Prop.GetName，'boOptionA'）或SameText（Prop.GetName，'boOptionB'），则开始
FProc（道具）；//卡尔