如何正确流式传输子组件的 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 Griddoes 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.ExpandedGrid 前缀和其他列属性导致了问题。

我认为问题与 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.

看来您对此无能为力。当您查看过程 WriteCollectionPropTWriter.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.