Tải tài nguyên phong cách FireMonkey với RTTI

Question

Tôi đang cố viết lớp kế thừa từ FMX TStyledControl. Khi kiểu được cập nhật, nó sẽ tải các đối tượng tài nguyên kiểu vào bộ đệm.

Tôi đã tạo nhóm dự án cho gói với các điều khiển tùy chỉnh và kiểm tra dự án FMX HD như mô tả trong trợ giúp Delphi. Sau khi cài đặt gói và đặt TsgSlideHost vào mẫu thử tôi chạy thử nghiệm ứng dụng. Nó hoạt động tốt, nhưng khi tôi đóng nó và cố gắng xây dựng lại gói RAD Studio nói "Lỗi trong rtl160.bpl" hoặc "hoạt động con trỏ không hợp lệ".

Có vẻ như vấn đề trong quy trình LoadToCacheIfNeeded từ TsgStyledControl, nhưng tôi không hiểu tại sao. Có hạn chế nào khi sử dụng RTTI với các kiểu FMX hay gì không?

nguồn 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. 

Sử dụng các 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

Sử dụng TRttiField.GetAttributes dẫn đến sai sót trong thiết kế thời gian. Đó là một lỗi trong Delphi XE2. Xem QC Report.