delphi - 创建自定义 TSetProperty 属性编辑器

Question

我正在尝试为某些自定义组件创建自定义属性编辑器。自定义属性编辑器旨在编辑一些设置属性，例如

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. 我正在为所有具有 TButtonOptions 属性的组件注册新的属性编辑器 (TMySetProperty)。我也尝试仅对 TButtonEx 执行此操作，但结果是相同的。
2. 我已在自定义属性编辑器的所有重写方法中添加了 ShowMessage() 调用，并且这些方法永远不会被调用。
3. 我已经调试了包并执行了 RegisterPropertyEditor()。尽管如此，我在重写方法中的自定义代码永远不会执行。
4. 我见过其他第 3 方组件使用此类属性编辑器(TSetProperty 后代)在较旧的 Delphi IDE 中运行，但我在代码中找不到任何相关差异。也许 Delphi XE2+ 还需要其他东西？

所以问题是:为什么我的自定义属性编辑器无法注册/工作？

注意:这个问题至少发生在Delphi XE2、XE3、XE4以及XE5中。其他 IDE 未经过测试，但可能具有相同的行为。

Answer 1

最后我得到了一个解决方案......在测试了我能想象到的所有内容之后 - 但没有成功 - 我开始在 DesignEditors.pas 和 DesignIntf​​.pas 单元中寻找"new"的东西。阅读 GetEditorClass() 函数，我发现它首先检查 PropertyMapper。可以使用 RegisterPropertyMapper() 函数注册属性映射器。使用它代替 RegisterPropertyEditor() 可以按预期工作。这是我修改后的工作代码，还显示了一些有趣的应用程序:根据某些条件显示或隐藏基于集合的属性的某些选项:

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.