Özel TSetProperty özellik düzenleyicisi oluşturma

Question

Bazı özel bileşenler için bir özel özellik düzenleyicisi oluşturmaya çalışıyorum. özel özellik editörü

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

benim özellik düzenleyici TSetProperty sınıfından iner gibi bazı dizi özellik düzenlemek için tasarlanmıştır. Sorun şu ki: özel mülk düzenleyicim kayıt altına alınmadı ve Delphi IDE kendi varsayılan set özellik düzenleyicisini kullanıyor gibi görünüyor, çünkü ShowMessage() özelliği, özellik düzenleyicisi yöntemlerini çağırmaz; Bu sorunu göstererek, olabildiğince basit bir örnek paket/bileşen oluşturdum.

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. 

lütfen unutmayın:

1. Bir TButtonOptions özelliğine sahip TÜM bileşenler için yeni özellik editörü (TMySetProperty) kayıt ediyorum İşte kodudur. Bunu sadece TButtonEx için yapmaya çalıştım, ancak sonuç aynı.
2. Özel özellik düzenleyicimin tüm geçersiz yöntemlerinin içinde ShowMessage() çağrılarını ve bu yöntemleri ASLA aramamayı ekledim.
3. Zaten paketi debugged ettik ve RegisterPropertyEditor() yürütür. Yine de, geçersiz kılınan yöntemlerde özel kodum asla yürütülmez.
4. Eski Delphi IDE'lerinde çalışan bu tür bir özellik düzenleyicisi (TSetProperty) kullanarak diğer üçüncü taraf bileşenleri gördüm ve kodla ilgili herhangi bir farklılık bulamadım. Belki Delphi XE2 + başka bir şey ister?

Soru şu: Neden özel özellik düzenleyicim kayıt/çalışma yapmıyor?

Not: Bu sorun en azından Delphi XE2, XE3, XE4 ve XE5'te gerçekleşir. Diğer IDE'ler test edilmemişti ama muhtemelen aynı davranışa sahipti.

Answer 1

Sonunda bir çözüm buldum ... Hayal edebileceğim herşeyi test ettikten sonra - başarı olmadan - DesignEditors.pas ve DesignIntf.pas birimlerinde "yeni" bir şey aramaya başladım. GetEditorClass() işlevini okuma, ilk olarak bir PropertyMapper için denetlediğini keşfettim. Bir özellik eşleyicisi, RegisterPropertyMapper() işlevi kullanılarak kaydedilebilir. RegisterPropertyEditor() yerine kullanmak, beklendiği gibi çalışır.

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.