[英]How to correctly stream a TCollection property of a subcomponent, e.g. the Columns property of an embedded TDBGrid
I've been trying to boil down to an MCVE some code the author of another q sent me to illustrate a problem with a custom component. 我一直在尝试将一些代码简化为MCVE,另一个q的作者发给我的代码说明了自定义组件的问题。
The component is simply a TPanel descendant which includes an embedded TDBGrid. 该组件只是一个包含嵌入式TDBGrid的TPanel后代。 My version of its source, and a test project are below. 我的源代码版本和测试项目如下。
The problem is that if the embedded DBGrid has been created with persistent columns, when its test project is re-opened in the IDE, an exception is raised 问题是,如果嵌入式DBGrid已使用持久性列创建,则在IDE中重新打开其测试项目时,将引发异常
Error reading
TColumn.Grid.Expanded
. 读取TColumn.Grid.Expanded
出错。 PropertyGrid
does not exist. 属性Grid
不存在。
Executing the Stream
method of the test project shows how this problem arises: 执行测试项目的Stream
方法将显示此问题的产生方式:
For comparison purposes, I also have a normal TDBGrid, DBGrid1, on my form. 为了进行比较,我在表单上也有一个普通的TDBGrid DBGrid1。 Whereas the Columns of this DBGrid1 are streamed as 与此DBGrid1的列流为
Columns = <
item
Expanded = False
FieldName = 'ID'
Visible = True
end
[...]
the embedded grid's columns are streamed like this 嵌入式网格的列像这样流式传输
Grid.Columns = <
item
Grid.Expanded = False
Grid.FieldName = 'ID'
Grid.Visible = True
end
[...]
It's obviously the Grid
prefix of Grid.Expanded
and the other column properties which is causing the problem. 显然是导致问题的Grid.Expanded
和其他列属性的Grid
前缀。
I imagine that the problem is something to do with the fact that DBGridColumns is a TCollection descendant and that the embedded grid isn't the top-level object in the DFM. 我认为问题与以下事实有关:DBGridColumns是TCollection的后代,并且嵌入式网格不是DFM中的顶级对象。
My question is: How should the code of TMyPanel
be modified so that the grid's columns get correctly streamed? 我的问题是:应该如何修改TMyPanel
的代码,以便正确地传输网格的列?
Component source: 组件来源:
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.
Test project source: 测试项目来源:
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.
Seems there is not much you can do about it. 似乎您对此无能为力。 When you look into procedure WriteCollectionProp
(local to TWriter.WriteProperties
) you see that FPropPath
is cleared before the call to WriteCollection
. 当你看着程序WriteCollectionProp
(本地TWriter.WriteProperties
),你看到FPropPath
被调用之前清除WriteCollection
。
The problem with TDBGrid
, or better TCustomDBGrid
, is that the collection is marked as stored false
and the streaming is delegated to DefineProperties
, which uses TCustomDBGrid.WriteColumns
to do the work. TDBGrid
或更好的TCustomDBGrid
的问题在于,将集合标记为stored false
并且将流委托给DefineProperties
,后者使用TCustomDBGrid.WriteColumns
进行工作。
Inspecting that method reveals that, although it also calls WriteCollection
, the content of FPropPath
is not cleared before. 检查该方法表明,虽然它也要求WriteCollection
,内容FPropPath
不前清零。 This is somewhat expected as FPropPath
is a private field. 由于FPropPath
是私有字段,因此在某种程度上可以预料。
The reason why it nonetheless works in the standard use case is that at the moment of writing FPropPath
is just empty. 尽管如此,它在标准用例中仍然有效的原因是,在编写FPropPath
它只是空的。
As even Delphi 10.1 Berlin behaves the same as Delphi 7, I suggest filing a QP report together with just this example. 由于甚至Delphi 10.1 Berlin的行为与Delphi 7相同,因此我建议仅在此示例的同时提交一份QP报告。
The solution would involve the embedded grid not having the form that owns the panel as the streaming root, but the panel itself. 解决方案将涉及嵌入式网格不具有将面板作为流传输根的形式,而是面板本身。 This will prevent the grid's properties being qualified by 'Grid', which, in effect, will eliminate column properties being wrongly qualified by the same. 这将防止网格的属性被“网格”限定,实际上,它将消除被列错误限定的列属性。 That is to say, the below is a workaround for faulty behavior. 也就是说,以下是错误行为的解决方法。
To achieve the above, remove the SetSubComponent
call, 为此,请删除SetSubComponent
调用,
constructor TMyPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGrid := TDBGrid.Create(Self);
// FGrid.SetSubcomponent(True);
FGrid.Parent := Self;
end;
The csSubComponent
style being removed, now the grid is not streamed at all. 删除了csSubComponent
样式,现在根本不流处理网格。
Then override GetChildren
for the panel to stream the grid through the panel. 然后为面板覆盖GetChildren
,以使网格流过面板。 GetChildren
, as documented , is used to determine which child controls are saved (streamed) of a control. 如记录所示 , GetChildren
用于确定要保存(流式传输)控件的哪些子控件。 Since we have only one control (the grid) we don't need to make a distinction and instead can call the inherited handler modifying the root. 由于我们只有一个控件(网格),因此不需要区分,而是可以调用继承的处理程序来修改根。
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;
Having read the question mentioned above, and this one, and this one, and this one, and still not being able to resolve with the help of the code, clues, advices in them, I traced the streaming system and came up with my solution as below. 阅读了上面提到的问题以及这个 , 这个 , 这个和那个问题,但仍然无法在其中的代码,线索,建议的帮助下解决了问题,我跟踪了流系统并提出了解决方案如下。
I'm not claiming it is how it is supposed to be. 我并不是说这应该是这样。 It is just how I could make this to work. 这就是我可以使它起作用的方式。 Main modifications are, the sub-grid is now writable (which would require a setter in production code), the conditional creation of the grid, and the overriden GetChildOwner
of the panel. 主要修改是,该子网格现在可写(这将需要在生产代码中使用设置器),有条件地创建网格以及覆盖面板的GetChildOwner
。 Below is the entire unit having TMyPanel2
( TMyPanel
couldn't make it... ). 以下是具有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.
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.