Sto provando a scrivere una classe che eredita da FMX TStyledControl. Quando lo stile viene aggiornato, carica gli oggetti risorsa di stile nella cache.Caricamento risorse in stile FireMonkey con RTTI
Ho creato un gruppo di progetto per il pacchetto con controlli personalizzati e testato il progetto FMX HD come descritto nella guida di Delphi. Dopo aver installato il pacchetto e aver posizionato TsgSlideHost sul modulo di test, eseguo l'app di test. Funziona bene, ma quando lo chiudo e provo a ricostruire il pacchetto RAD Studio dice "Errore in rtl160.bpl" o "operazione del puntatore non valida".
Sembra che problema nella procedura LoadToCacheIfNeeded da TsgStyledControl, ma non capisco perché. C'è qualche restrizione sull'uso di RTTI con stili FMX o altro?
fonti 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.
Utilizzando dei 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;
Il problema potrebbe essere che non si sta verificando che StyleObj sia assegnato prima di assegnarlo a Val? In caso contrario, suggerisco di test in fase di esecuzione piuttosto che in fase di progettazione in modo da poter utilizzare il debugger o ottenere uno strumento che intrappoli gli errori in fase di progettazione. –
Se StyleObj è nullo, anche il campo cache sarà nullo. TsgSlideHost controlla questo. Ho provato a eseguire il debug di questo in fase di esecuzione e sta funzionando bene. Il logger di CodeSite dice quali 3 campi sono stati caricati e il tipo di StyleObj è TLayout con proprietà corrette. AQTime profiler inoltre non rileva alcuna perdita di memoria. – HeMet