How to correctly stream a TCollection property of a subcomponent, e.g. the Columns property of an embedded TDBGrid

倖福魔咒の 提交于 2019-11-29 14:34:47

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.

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.

Inspecting that method reveals that, although it also calls WriteCollection, the content of FPropPath is not cleared before. This is somewhat expected as FPropPath is a private field.

The reason why it nonetheless works in the standard use case is that at the moment of writing FPropPath is just empty.

As even Delphi 10.1 Berlin behaves the same as Delphi 7, I suggest filing a QP report together with just this example.

Sertac Akyuz

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,

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.

Then override GetChildren for the panel to stream the grid through the panel. GetChildren, as documented, is used to determine which child controls are saved (streamed) of a control. 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;


Then remains resolving subcomponent complications. Complication here was a second grid being created sitting in front of the panel which assumes streamed properties. Very much like in this unanswered question. Note that this problem is not related to the solution provided above. The original code displays the same problem.

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. Below is the entire unit having TMyPanel2 (TMyPanel couldn't make it... ).

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.
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!