Próbuję napisać klasę dziedziczącą po FMX TStyledControl. Po zaktualizowaniu stylu ładuje obiekty zasobów stylów do pamięci podręcznej.Ładowanie zasobów stylu FireMonkey za pomocą RTTI
Utworzono grupę projektową dla paczki z niestandardowymi kontrolkami i przetestowałem projekt FMX HD tak, jak opisuje pomoc Delphi. Po zainstalowaniu pakietu i umieszczeniu TsgSlideHost na formularzu testowym uruchamiam aplikację testową. Działa to dobrze, ale kiedy go zamykam i próbuję odbudować pakiet RAD Studio mówi "Błąd w rtl160.bpl" lub "nieprawidłowa operacja wskaźnika".
Wygląda na to, że problem w procedurze LoadToCacheIfNeeded z TsgStyledControl, ale nie rozumiem dlaczego. Czy istnieją jakiekolwiek ograniczenia dotyczące używania RTTI ze stylami FMX lub czymkolwiek?
źródła 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.
Korzystanie z 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;
Czy możliwe jest, że nie potwierdzasz, że stylObj jest przypisany przed przypisaniem go do Val? Jeśli to nie jest to proponuję testowanie w czasie wykonywania, a nie projektowanie - czas, abyś mógł użyć debuggera lub uzyskać narzędzie, które wychwytuje błędy w czasie projektowania. –
Jeśli StylObj jest zerowy, to pole pamięci podręcznej będzie również zerowe. TsgSlideHost sprawdza to. Próbowałem debugować to w czasie wykonywania i działało dobrze. Rejestrator CodeSite mówi, jakie 3 pola zostały załadowane, a typ StyleObj to TLayout z poprawnymi właściwościami. Profiler AQTime również nie wykrywa żadnych wycieków pamięci. – HeMet