6

FMXTStyledControlから継承するクラスを作成しようとしています。スタイルが更新されると、スタイルリソースオブジェクトがキャッシュに読み込まれます。

Delphiヘルプで説明されているように、カスタムコントロールを使用してパッケージのプロジェクトグループを作成し、FMXHDプロジェクトをテストしました。パッケージをインストールしてTsgSlideHostをテストフォームに配置した後、テストアプリを実行します。正常に動作しますが、閉じてパッケージを再構築しようとすると、RADStudioに「rtl160.bplのエラー」または「無効なポインター操作」と表示されます。

TsgStyledControlのLoadToCacheIfNeededプロシージャにどのような問題があるようですが、その理由がわかりません。FMXスタイルなどでRTTIを使用することに制限はありますか？

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.

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;
4

1 に答える 1

0

TRttiField.GetAttributesを使用すると、設計時にエラーが発生します。これはDelphiXE2のバグです。QCレポートを参照してください。

于 2012-06-25T14:32:12.490 に答える