Question

我想在此example之后在FireMonkey中创建一个复合控件，其中从资源文件中读取控件样式。这个例子在使用Delphi XE6安装组件时运行良好，但是当我在Delphi 10中安装时，Seattle会在加载表单时生成访问冲突错误，而我无法确定问题所在。提出的错误是：

模块＆＃39; fmx230.bpl＆＃39;中地址0885133F的访问冲突。阅读地址00000004。

我已经调整了示例，使得非常简单并且错误仍在继续。我希望得到这样的结果：

TwoRectLayout.pas代码文件是：

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.

TwoRectLayout.rc包含：

TwoRectstyle RCDATA  "TwoRectLayout.style"

样式的定义（TwoRectLayout.style）是：

  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

正如我所说，在Delphi XE6中，相同的组件没有问题，Delphi 10 Seattle引发了这个错误，我无法在设计时看到渲染控件。如果我编译程序似乎没问题。错误详情如下：

[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

我发现了问题，用于从DelphiXE6中的资源加载样式的代码是：

结果：= TFmxObject（TStyleManager.LoadFromResource（HInstance， DecisionTreeCompstyleName，RT_RCDATA））

我将该代码更改为此，因为之前的函数不在Delphi 10 Seattle中：

结果：= TStyleManager.GetStyleResource（TwoRectstyleName）

但正确的代码是：

结果：= TStyleStreaming.LoadFromResource（HInstance， DecisionTreestyleName，RT_RCDATA）;

在Delphi 10 Seattle中创建复合firemonkey控件

0 个答案: