Create a composite firemonkey control in Delphi 10 Seattle

  

I want to create a composite control in FireMonkey following this example, where the control style is read from a resource file. This example works well when install the component with Delphi XE6, but when I install in Delphi 10 Seattle generates an acces violation error when load the form, and I can not figure out where the problem is. The error raised is:

Access violation at address 0885133F in module ‘fmx230.bpl’. Read of
address 00000004.

I have adapted the example to make very simple and error continues. I want to get as a result something like this:

TwoRectLayout.pas code file is:

unit TwoRectLayout;

interface

uses
System.SysUtils, System.Classes,System.Types, System.UITypes, System.Math.Vectors,
FMX.Types, FMX.Controls, FMX.Styles, FMX.Objects, FMX.Layouts, FMX.Graphics, FMX.Dialogs;

type

TTwoRect = class(TStyledControl)
private
FColorTop: TAlphaColor;
FColorClient: TAlphaColor;
FRectTop: TRectangle;
FRectClient: TRectangle;
procedure SetColorTop(const Value: TAlphaColor);
procedure SetColorClient(const Value: TAlphaColor);
protected
function GetDefaultSize: TSizeF; override;
function GetStyleObject(const Clone: Boolean): TFmxObject; override;
procedure ApplyStyle; override;
procedure FreeStyle; override;
public
constructor Create(AOwner: TComponent); override;
published
property Align;
property Anchors;
property Cursor;
property Height;
property Position;
property StyleLookup;
property Visible;
property Width;
property Size;
property ColorTop: TAlphaColor read FColorTop write SetColorTop;
property ColorClient: TAlphaColor read FColorClient write SetColorClient;
end;

procedure Register;

implementation

{$R TwoRectLayout.res}

const
TwoRectstyleName = ‘TwoRectstyle’;

procedure Register;
begin
RegisterComponents(‘Samples’, [TTwoRect]);
end;

procedure TTwoRect.ApplyStyle;
begin
inherited;

if not Assigned(FRectTop) then
FRectTop:= FindStyleResource(‘RectTopstyle’) as TRectangle;

if Assigned(FRectTop) then
begin
FRectTop.Fill.Color:= FColorTop;
end;

if not Assigned(FRectClient) then
FRectClient:= FindStyleResource(‘RectClientstyle’) as TRectangle;

if Assigned(FRectClient) then
begin
FRectClient.Fill.Color:= FColorClient;
end;

end;

constructor TTwoRect.Create(AOwner: TComponent);
begin
inherited;
Width:= 500;
Height:= 400;

FColorTop:= TAlphaColors.Blue;
FColorClient:= TAlphaColors.Gold;
end;

procedure TTwoRect.FreeStyle;
begin
inherited;
FRectTop := nil;
FRectClient := nil;
end;

function TTwoRect.GetDefaultSize: TSizeF;
begin
Result:= TSizeF.Create(500, 400);
end;

function TTwoRect.GetStyleObject(const Clone: Boolean): TFmxObject;
begin
if (StyleLookup = ”) then
Result:= TStyleManager.GetStyleResource(TwoRectstyleName)
else
Result:= inherited GetStyleObject(Clone);
end;

procedure TTwoRect.SetColorTop(const Value: TAlphaColor);
begin
if (FColorTop <> Value) then
begin
FColorTop:= Value;
ApplyStyle;
end;
end;

procedure TTwoRect.SetColorClient(const Value: TAlphaColor);
begin
if (FColorClient <> Value) then
begin
FColorClient:= Value;
ApplyStyle;
end;
end;

end.

The TwoRectLayout.rc contains this:

TwoRectstyle RCDATA “TwoRectLayout.style”

And the definition of style (TwoRectLayout.style) is:

object TLayout
StyleName = ‘TwoRectstyle’
Position.X = 488.000000000000000000
Position.Y = 281.000000000000000000
Size.Width = 382.000000000000000000
Size.Height = 283.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object TRectangle
StyleName = ‘RectTopstyle’
Align = Top
HitTest = False
Size.Width = 382.000000000000000000
Size.Height = 32.000000000000000000
Size.PlatformDefault = False
end
object TRectangle
StyleName = ‘RectClientstyle’
Align = Client
HitTest = False
Size.Width = 382.000000000000000000
Size.Height = 251.000000000000000000
Size.PlatformDefault = False
end
end

As I said the same component works without problem in Delphi XE6, with Delphi 10 Seattle raise this error and I can’t see rendered the control at design time. If I compile the program it seems ok. The error details are:

[082F133F]{fmx230.bpl } FMX.Controls.TControl.DoGetUpdateRect (Line 2184, “FMX.Controls.pas” + 44) + $9
[5016FBB9]{rtl230.bpl } System.Classes.TComponent.Remove (Line 15599, “System.Classes.pas” + 7) + $B
[50060708]{rtl230.bpl } System.TMonitor.TryEnter (Line 18154, “System.pas” + 10) + $0
[5016FC2F]{rtl230.bpl } System.Classes.TComponent.Remove (Line 15609, “System.Classes.pas” + 17) + $15
[50060288]{rtl230.bpl } System.TMonitor.Enter (Line 17847, “System.pas” + 4) + $2
[5016FF1E]{rtl230.bpl } System.Classes.TComponent.Notification (Line 15712, “System.Classes.pas” + 8) + $1D
[50060288]{rtl230.bpl } System.TMonitor.Enter (Line 17847, “System.pas” + 4) + $2
[50060467]{rtl230.bpl } System.TMonitor.Exit (Line 17973, “System.pas” + 2) + $7
[5005F77C]{rtl230.bpl } System.TObject.Free (Line 16261, “System.pas” + 1) + $4
[082F0570]{fmx230.bpl } FMX.Controls.TControl.Destroy (Line 1860, “FMX.Controls.pas” + 15) + $19
[5005A19C]{rtl230.bpl } System.@FreeMem (Line 4650, “System.pas” + 20) + $0
[500619A0]{rtl230.bpl } System.@UStrClr (Line 24673, “System.pas” + 14) + $0
[50063CEC]{rtl230.bpl } System.@FinalizeArray (Line 31875, “System.pas” + 80) + $0
[50060708]{rtl230.bpl } System.TMonitor.TryEnter (Line 18154, “System.pas” + 10) + $0
[50060288]{rtl230.bpl } System.TMonitor.Enter (Line 17847, “System.pas” + 4) + $2
[50067110]{rtl230.bpl } System.@IntfClear (Line 36557, “System.pas” + 10) + $0
[50579B15]{rtl230.bpl } .rtl. (Line 296, “” + 0) + $4AC5
[5006010C]{rtl230.bpl } System.TMonitor.CheckOwningThread (Line 17765, “System.pas” + 2) + $0
[50060708]{rtl230.bpl } System.TMonitor.TryEnter (Line 18154, “System.pas” + 10) + $0
[50060288]{rtl230.bpl } System.TMonitor.Enter (Line 17847, “System.pas” + 4) + $2
[50060467]{rtl230.bpl } System.TMonitor.Exit (Line 17973, “System.pas” + 2) + $7
[5006010C]{rtl230.bpl } System.TMonitor.CheckOwningThread (Line 17765, “System.pas” + 2) + $0
[50060416]{rtl230.bpl } System.TMonitor.Exit (Line 17951, “System.pas” + 1) + $2
[50060467]{rtl230.bpl } System.TMonitor.Exit (Line 17973, “System.pas” + 2) + $7
[50063CEC]{rtl230.bpl } System.@FinalizeArray (Line 31875, “System.pas” + 80) + $0
[50063C34]{rtl230.bpl } System.@FinalizeRecord (Line 31637, “System.pas” + 25) + $0
[5006017C]{rtl230.bpl } System.TMonitor.Destroy (Line 17787, “System.pas” + 0) + $0
[5005F7FF]{rtl230.bpl } System.TObject.CleanupInstance (Line 16405, “System.pas” + 24) + $0
[5005A19C]{rtl230.bpl } System.@FreeMem (Line 4650, “System.pas” + 20) + $0
[5005F5F8]{rtl230.bpl } System.TObject.FreeInstance (Line 16193, “System.pas” + 2) + $2
[5005FECE]{rtl230.bpl } System.@ClassDestroy (Line 17542, “System.pas” + 0) + $2
[082F05A2]{fmx230.bpl } FMX.Controls.TControl.Destroy (Line 1863, “FMX.Controls.pas” + 18) + $9

I found the problem, the code used to load the style from a resource in DelphiXE6 was :

Result:= TFmxObject(TStyleManager.LoadFromResource(HInstance,
DecisionTreeCompstyleName, RT_RCDATA))

I changed that code to this, because the previous function isn’t in Delphi 10 Seattle:

Result:= TStyleManager.GetStyleResource(TwoRectstyleName)

but the correct code to use is:

Result:= TStyleStreaming.LoadFromResource(HInstance,
DecisionTreestyleName, RT_RCDATA);

Comments are closed.