FireMonkey stil kaynaklarını RTTI ile yükleme

Question

FMX TStyledControl'den miras alan sınıf yazmaya çalışıyorum. Stil güncellendiğinde, stil kaynak nesnelerini önbelleğe yükler.

Özel denetimler içeren paket için proje grubu oluşturdum ve Delphi yardımında açıklandığı gibi FMX HD projesini test ediyorum. Paketi yükledikten ve test formuna TsgSlideHost yerleştirdikten sonra test uygulamasını çalıştırıyorum. İyi çalışıyor, ancak kapatıp RAD Studio paketini yeniden yüklemeyi denediğimde “rtl160.bpl'de hata” veya “geçersiz işaretçi işlemi” yazıyor.

TsgStyledControl tarafından LoadToCacheIfNeeded yordamında ne gibi bir sorun var gibi görünüyor, ama nedenini anlamıyorum. FMX stilleri veya herhangi bir şey ile RTTI kullanımı konusunda herhangi bir kısıtlama var mı?

TsgStyledControl kaynaklar: TsgStyledControl kullanılması

unit SlideGUI.TsgStyledControl; 

interface 

uses 
    System.SysUtils, System.Classes, System.Types, FMX.Types, FMX.Layouts, FMX.Objects, 
    FMX.Effects, System.UITypes, FMX.Ani, System.Rtti, System.TypInfo; 

type 
    TCachedAttribute = class(TCustomAttribute) 
    private 
    fStyleName: string; 
    public 
    constructor Create(const aStyleName: string); 
    property StyleName: string read fStyleName; 
    end; 

    TsgStyledControl = class(TStyledControl) 
    private 
    procedure CacheStyleObjects; 
    procedure LoadToCacheIfNeeded(aField: TRttiField); 
    protected 
    function FindStyleResourceAs<T: class>(const AStyleLookup: string): T; 
    function GetStyleName: string; virtual; abstract; 
    function GetStyleObject: TControl; override; 
    public 
    procedure ApplyStyle; override; 
    published 
    { Published declarations } 
    end; 

implementation 

{ TsgStyledControl } 

procedure TsgStyledControl.ApplyStyle; 
begin 
    inherited; 
    CacheStyleObjects; 
end; 

procedure TsgStyledControl.CacheStyleObjects; 
var 
    ctx: TRttiContext; 
    typ: TRttiType; 
    fld: TRttiField; 
begin 
    ctx := TRttiContext.Create; 
    try 
    typ := ctx.GetType(Self.ClassType); 
    for fld in typ.GetFields do 
     LoadFromCacheIfNeeded(fld); 
    finally 
    ctx.Free 
    end; 
end; 

function TsgStyledControl.FindStyleResourceAs<T>(const AStyleLookup: string): T; 
var 
    fmxObj: TFmxObject; 
begin 
    fmxObj := FindStyleResource(AStyleLookup); 
    if Assigned(fmxObj) and (fmxObj is T) then 
    Result := fmxObj as T 
    else 
    Result := nil; 
end; 

function TsgStyledControl.GetStyleObject: TControl; 
var 
    S: TResourceStream; 
begin 
    if (FStyleLookup = '') then 
    begin 
    if FindRCData(HInstance, GetStyleName) then 
    begin 
     S := TResourceStream.Create(HInstance, GetStyleName, RT_RCDATA); 
     try 
     Result := TControl(CreateObjectFromStream(nil, S)); 
     Exit; 
     finally 
     S.Free; 
     end; 
    end; 
    end; 
    Result := inherited GetStyleObject; 
end; 

procedure TsgStyledControl.LoadToCacheIfNeeded(aField: TRttiField); 
var 
    attr: TCustomAttribute; 
    styleName: string; 
    styleObj: TFmxObject; 
    val: TValue; 
begin 
    for attr in aField.GetAttributes do 
    begin 
    if attr is TCachedAttribute then 
    begin 
     styleName := TCachedAttribute(attr).StyleName; 
     if styleName <> '' then 
     begin 
     styleObj := FindStyleResource(styleName); 
     val := TValue.From<TFmxObject>(styleObj); 
     aField.SetValue(Self, val); 
     end; 
    end; 
    end; 
end; 

{ TCachedAttribute } 

constructor TCachedAttribute.Create(const aStyleName: string); 
begin 
    fStyleName := aStyleName; 
end; 

end. 

:

type 
    TsgSlideHost = class(TsgStyledControl) 
    private 
    [TCached('SlideHost')] 
    fSlideHost: TLayout; 
    [TCached('SideMenu')] 
    fSideMenuLyt: TLayout; 
    [TCached('SlideContainer')] 
    fSlideContainer: TLayout; 
    fSideMenu: IsgSideMenu; 
    procedure ReapplyProps; 
    procedure SetSideMenu(const Value: IsgSideMenu); 
    protected 
    function GetStyleName: string; override; 
    function GetStyleObject: TControl; override; 
    procedure UpdateSideMenuLyt; 
    public 
    constructor Create(AOwner: TComponent); override; 
    procedure ApplyStyle; override; 
    published 
    property SideMenu: IsgSideMenu read fSideMenu write SetSideMenu; 
    end; 

Answer 1

TRttiField.GetAttributes Kullanarak tasarım zamanlı olarak hatalara yol açar. Delphi XE2'de bir hata. Bakınız QC Report.