創建自定義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. 我已經看到其他第三方組件使用這種屬性編輯器（TSetProperty後代）在舊的Delphi IDE中運行，我無法找到任何相關的代碼差異。也許Delphi XE2 +需要別的東西？

所以問題是： 爲什麼我的自定義屬性編輯器沒有註冊/工作？

注意：至少在Delphi XE2，XE3，XE4和XE5中會發生此問題。其他IDE未經測試，但可能具有相同的行爲。

Answer 1

最後我得到了一個解決方案......經過測試我能想象的所有事情 - 沒有成功 - 我開始在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.