如何正确流式传输子组件的 TCollection 属性,例如嵌入式 TDBGrid 的列 属性
How to correctly stream a TCollection property of a subcomponent, e.g. the Columns property of an embedded TDBGrid
我一直在尝试将另一个 q 的作者发给我的一些代码归结为 MCVE
来说明自定义组件的问题。
该组件只是一个包含嵌入式 TDBGrid 的 TPanel 后代。
下面是我的源码版本和测试项目。
问题是,如果嵌入式 DBGrid 是用持久列创建的,
当其测试项目在 IDE 中重新打开时,引发异常
Error reading TColumn.Grid.Expanded
. Property Grid
does not exist.
执行测试项目的Stream
方法可以看出这个问题是怎么产生的:
为了比较,我的表单上还有一个普通的 TDBGrid,即 DBGrid1。而此 DBGrid1 的列流式传输为
Columns = <
item
Expanded = False
FieldName = 'ID'
Visible = True
end
[...]
嵌入式网格的列是这样流式传输的
Grid.Columns = <
item
Grid.Expanded = False
Grid.FieldName = 'ID'
Grid.Visible = True
end
[...]
显然是 Grid.Expanded
的 Grid
前缀和其他列属性导致了问题。
我认为问题与 DBGridColumns
是 TCollection 后代,嵌入的网格不是中的顶级对象
DFM.
我的问题是:TMyPanel
的代码应该怎么修改才能让grid的
列是否正确流式传输?
组件来源:
unit MAGridu;
interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls, DBGrids;
type
TMyPanel = class(TPanel)
private
FGrid : TDBGrid;
public
constructor Create(AOwner : TComponent); override;
published
property Grid : TDBGrid read FGrid;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TMyPanel]);
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGrid := TDBGrid.Create(Self);
FGrid.SetSubcomponent(True);
FGrid.Parent := Self;
end;
end.
测试项目来源:
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
CDS1: TClientDataSet;
DataSource1: TDataSource;
MyPanel1: TMyPanel;
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Stream;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Stream;
end;
procedure TForm1.Stream;
// This method is included as an easy way of getting at the contents of the project's
// DFM. It saves the form to a stream, and loads it into a memo on the form.
var
SS : TStringStream;
MS : TMemoryStream;
Writer : TWriter;
begin
SS := TStringStream.Create('');
MS := TMemoryStream.Create;
Writer := TWriter.Create(MS, 4096);
try
Writer.Root := Self;
Writer.WriteSignature;
Writer.WriteComponent(Self);
Writer.FlushBuffer;
MS.Position := 0;
ObjectBinaryToText(MS, SS);
Memo1.Lines.Text := SS.DataString;
finally
Writer.Free;
MS.Free;
SS.Free;
end;
end;
end.
procedure TForm1.FormCreate(Sender: TObject);
var
Field : TField;
begin
Field := TIntegerField.Create(Self);
Field.FieldName := 'ID';
Field.FieldKind := fkData;
Field.DataSet := CDS1;
Field := TStringField.Create(Self);
Field.FieldName := 'Name';
Field.Size := 20;
Field.FieldKind := fkData;
Field.DataSet := CDS1;
CDS1.CreateDataSet;
CDS1.InsertRecord([1, 'One']);
end;
end.
看来您对此无能为力。当您查看过程 WriteCollectionProp
(TWriter.WriteProperties
的本地)时,您会看到 FPropPath
在调用 WriteCollection
之前被清除。
TDBGrid
或更好的 TCustomDBGrid
的问题是集合被标记为 stored false
并且流式传输被委托给 DefineProperties
,它使用 TCustomDBGrid.WriteColumns
来完成工作。
查看那个方法发现,虽然它也调用了WriteCollection
,但是之前并没有清除FPropPath
的内容。这在某种程度上是意料之中的,因为 FPropPath
是私有字段。
它在标准用例中仍然有效的原因是在撰写本文时 FPropPath
只是空的。
因为甚至 Delphi 10.1 Berlin 的行为与 Delphi 7 相同,我建议将 QP 报告与此示例一起提交。
解决方案涉及的嵌入式网格不是拥有作为流根的面板的窗体,而是面板本身。这将防止网格的属性被 'Grid' 限定,这实际上将消除列属性被错误限定的情况。也就是说,以下是错误行为的解决方法。
要实现上述目标,请删除 SetSubComponent
调用,
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGrid := TDBGrid.Create(Self);
// FGrid.SetSubcomponent(True);
FGrid.Parent := Self;
end;
删除了 csSubComponent
样式,现在网格根本没有流式传输。
然后为面板覆盖 GetChildren
,以通过面板流式传输网格。 GetChildren
,与documented一样,用于确定一个控件的哪些子控件被保存(流式传输)。由于我们只有一个控件(网格),因此我们不需要进行区分,而是可以调用继承的处理程序修改根。
type
TMyPanel = class(TPanel)
private
FGrid : TDBGrid;
public
constructor Create(AOwner : TComponent); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
published
property Grid : TDBGrid read FGrid;
end;
...
procedure TMyPanel.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
inherited GetChildren(Proc, Self);
end;
然后继续解决子组件并发症。这里的复杂性是在面板前面创建了第二个网格,该面板假定流媒体属性。非常像 this 未回答的问题。请注意,此问题与上面提供的解决方案无关。原代码显示同样的问题。
阅读了上面提到的问题和 this one, and this one, and this 一个,但仍然无法借助其中的代码、线索和建议解决,我跟踪了流系统并提出了我的解决方案如下。
我并不是说它应该是这样的。这就是我如何使它起作用的方法。主要的修改是,子网格现在是可写的(这将需要在生产代码中使用 setter)、网格的条件创建以及面板的覆盖 GetChildOwner
。下面是具有 TMyPanel2
的整个单元(TMyPanel
无法做到...)。
unit TestPanel2;
interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls, DBGrids;
type
TMyPanel2 = class(TPanel)
private
FGrid : TDBGrid;
protected
function GetChildOwner: TComponent; override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
published
property Grid : TDBGrid read FGrid write FGrid;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Test', [TMyPanel2]);
end;
constructor TMyPanel2.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if not (csReading in AOwner.ComponentState) then begin
FGrid := TDBGrid.Create(Self);
FGrid.Name := 'InternalDBGrid';
FGrid.Parent := Self;
end else
RegisterClass(TDBGrid);
end;
destructor TMyPanel2.Destroy;
begin
FGrid.Free;
inherited;
end;
function TMyPanel2.GetChildOwner: TComponent;
begin
Result := Self;
end;
procedure TMyPanel2.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
Proc(Grid);
end;
end.
我一直在尝试将另一个 q 的作者发给我的一些代码归结为 MCVE 来说明自定义组件的问题。
该组件只是一个包含嵌入式 TDBGrid 的 TPanel 后代。 下面是我的源码版本和测试项目。
问题是,如果嵌入式 DBGrid 是用持久列创建的, 当其测试项目在 IDE 中重新打开时,引发异常
Error reading
TColumn.Grid.Expanded
. PropertyGrid
does not exist.
执行测试项目的Stream
方法可以看出这个问题是怎么产生的:
为了比较,我的表单上还有一个普通的 TDBGrid,即 DBGrid1。而此 DBGrid1 的列流式传输为
Columns = <
item
Expanded = False
FieldName = 'ID'
Visible = True
end
[...]
嵌入式网格的列是这样流式传输的
Grid.Columns = <
item
Grid.Expanded = False
Grid.FieldName = 'ID'
Grid.Visible = True
end
[...]
显然是 Grid.Expanded
的 Grid
前缀和其他列属性导致了问题。
我认为问题与 DBGridColumns 是 TCollection 后代,嵌入的网格不是中的顶级对象 DFM.
我的问题是:TMyPanel
的代码应该怎么修改才能让grid的
列是否正确流式传输?
组件来源:
unit MAGridu;
interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls, DBGrids;
type
TMyPanel = class(TPanel)
private
FGrid : TDBGrid;
public
constructor Create(AOwner : TComponent); override;
published
property Grid : TDBGrid read FGrid;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TMyPanel]);
end;
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGrid := TDBGrid.Create(Self);
FGrid.SetSubcomponent(True);
FGrid.Parent := Self;
end;
end.
测试项目来源:
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
CDS1: TClientDataSet;
DataSource1: TDataSource;
MyPanel1: TMyPanel;
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Stream;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Stream;
end;
procedure TForm1.Stream;
// This method is included as an easy way of getting at the contents of the project's
// DFM. It saves the form to a stream, and loads it into a memo on the form.
var
SS : TStringStream;
MS : TMemoryStream;
Writer : TWriter;
begin
SS := TStringStream.Create('');
MS := TMemoryStream.Create;
Writer := TWriter.Create(MS, 4096);
try
Writer.Root := Self;
Writer.WriteSignature;
Writer.WriteComponent(Self);
Writer.FlushBuffer;
MS.Position := 0;
ObjectBinaryToText(MS, SS);
Memo1.Lines.Text := SS.DataString;
finally
Writer.Free;
MS.Free;
SS.Free;
end;
end;
end.
procedure TForm1.FormCreate(Sender: TObject);
var
Field : TField;
begin
Field := TIntegerField.Create(Self);
Field.FieldName := 'ID';
Field.FieldKind := fkData;
Field.DataSet := CDS1;
Field := TStringField.Create(Self);
Field.FieldName := 'Name';
Field.Size := 20;
Field.FieldKind := fkData;
Field.DataSet := CDS1;
CDS1.CreateDataSet;
CDS1.InsertRecord([1, 'One']);
end;
end.
看来您对此无能为力。当您查看过程 WriteCollectionProp
(TWriter.WriteProperties
的本地)时,您会看到 FPropPath
在调用 WriteCollection
之前被清除。
TDBGrid
或更好的 TCustomDBGrid
的问题是集合被标记为 stored false
并且流式传输被委托给 DefineProperties
,它使用 TCustomDBGrid.WriteColumns
来完成工作。
查看那个方法发现,虽然它也调用了WriteCollection
,但是之前并没有清除FPropPath
的内容。这在某种程度上是意料之中的,因为 FPropPath
是私有字段。
它在标准用例中仍然有效的原因是在撰写本文时 FPropPath
只是空的。
因为甚至 Delphi 10.1 Berlin 的行为与 Delphi 7 相同,我建议将 QP 报告与此示例一起提交。
解决方案涉及的嵌入式网格不是拥有作为流根的面板的窗体,而是面板本身。这将防止网格的属性被 'Grid' 限定,这实际上将消除列属性被错误限定的情况。也就是说,以下是错误行为的解决方法。
要实现上述目标,请删除 SetSubComponent
调用,
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGrid := TDBGrid.Create(Self);
// FGrid.SetSubcomponent(True);
FGrid.Parent := Self;
end;
删除了 csSubComponent
样式,现在网格根本没有流式传输。
然后为面板覆盖 GetChildren
,以通过面板流式传输网格。 GetChildren
,与documented一样,用于确定一个控件的哪些子控件被保存(流式传输)。由于我们只有一个控件(网格),因此我们不需要进行区分,而是可以调用继承的处理程序修改根。
type
TMyPanel = class(TPanel)
private
FGrid : TDBGrid;
public
constructor Create(AOwner : TComponent); override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
published
property Grid : TDBGrid read FGrid;
end;
...
procedure TMyPanel.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
inherited GetChildren(Proc, Self);
end;
然后继续解决子组件并发症。这里的复杂性是在面板前面创建了第二个网格,该面板假定流媒体属性。非常像 this 未回答的问题。请注意,此问题与上面提供的解决方案无关。原代码显示同样的问题。
阅读了上面提到的问题和 this one, and this one, and this 一个,但仍然无法借助其中的代码、线索和建议解决,我跟踪了流系统并提出了我的解决方案如下。
我并不是说它应该是这样的。这就是我如何使它起作用的方法。主要的修改是,子网格现在是可写的(这将需要在生产代码中使用 setter)、网格的条件创建以及面板的覆盖 GetChildOwner
。下面是具有 TMyPanel2
的整个单元(TMyPanel
无法做到...)。
unit TestPanel2;
interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls, DBGrids;
type
TMyPanel2 = class(TPanel)
private
FGrid : TDBGrid;
protected
function GetChildOwner: TComponent; override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
published
property Grid : TDBGrid read FGrid write FGrid;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Test', [TMyPanel2]);
end;
constructor TMyPanel2.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if not (csReading in AOwner.ComponentState) then begin
FGrid := TDBGrid.Create(Self);
FGrid.Name := 'InternalDBGrid';
FGrid.Parent := Self;
end else
RegisterClass(TDBGrid);
end;
destructor TMyPanel2.Destroy;
begin
FGrid.Free;
inherited;
end;
function TMyPanel2.GetChildOwner: TComponent;
begin
Result := Self;
end;
procedure TMyPanel2.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
Proc(Grid);
end;
end.