Cargando recursos de estilo FireMonkey con RTTI

Question

Estoy tratando de escribir una clase que herede de FMX TStyledControl. Cuando se actualiza el estilo, carga objetos de recursos de estilo en la memoria caché.

Creé el grupo de proyectos para el paquete con controles personalizados y probé el proyecto FMX HD como se describe en la ayuda de Delphi. Después de instalar el paquete y colocar TsgSlideHost en el formulario de prueba, ejecuto la aplicación de prueba. Funciona bien, pero cuando lo cierro y trato de reconstruir el paquete, RAD Studio dice "Error en rtl160.bpl" o "operación de puntero no válida".

Parece que hay un problema en el procedimiento LoadToCache IfNeeded de TsgStyledControl, pero no entiendo por qué. ¿Hay alguna restricción sobre el uso de RTTI con estilos FMX o algo así?

fuentes TsgStyledControl:

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. 

El uso de TsgStyledControl:

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

Uso TRttiField.GetAttributes conduce a errores en tiempo de diseño. Es un error en Delphi XE2. Ver QC Report.