创建自定义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.
请注意：
所以问题是：为什么我的自定义属性编辑器不注册/工作？
注意：这个问题至少发生在Delphi XE2，XE3，XE4以及XE5中。 其他IDE未经测试，但可能具有相同的行为。
最后，我得到了一个解决方案......经过测试我可以想象的所有事情 - 没有成功 - 我开始在DesignEditors.pas和DesignIntf.pas单元中搜索“新”。 读取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.