I have fixed your sample, it now saves and loads the components, haven't tested to see if they are the same primarily because I use the same trick in my own collections and I know it works. I tried to make sure that there are no memory leaks but you should check it out your self.
program gridlayout;
{$mode objfpc}{$H+}
uses
heaptrc,
Classes, SysUtils, fpjson, fpjsonrtti, variants;
Var
JS : TJSONStreamer;
Type
{ TGridColumnItem}
TGridColumn = Class(TCollectionItem)
private
FIndex: Integer;
FFieldName: string;
FColumnTitle: string;
FVisible: Boolean;
FPresent: Boolean;
FWidth: Integer;
published
property ColumnIndex: Integer read FIndex write FIndex;
property FieldName: string read FFieldName write FFieldName;
property ColumnTitle: string read FColumnTitle write FColumnTitle;
property Visible: Boolean read FVisible write FVisible;
property Present: Boolean read FPresent write FPresent;
property Width: Integer read FWidth write FWidth;
end;
{ TGridColumnCollection }
TGridColumnCollection = class(TOwnedCollection)
private
function GetItem(AIndex: Integer): TGridColumn;
procedure SetItem(AIndex : Integer; aValue : TGridColumn);
public
constructor Create(AOwner : TPersistent);
function Add: TGridColumn;
property Items[AIndex: Integer]: TGridColumn read GetItem write SetItem;
end;
{ TGridLayoutItem }
TGridLayoutItem = Class(TCollectionItem)
private
FName, FDescription: String;
FColumnCollection: TGridColumnCollection;
procedure SetColumnCollection(aValue : TGridColumnCollection);
public
constructor Create(ACollection : TCollection); override;
destructor Destroy;override;
published
property Name: string read FName write FName;
property Description: string read FDescription write FDescription;
property ColumnCollection: TGridColumnCollection read FColumnCollection write SetColumnCollection;
end;
{ TGridLayoutCollection }
TGridLayoutCollection = Class(TOwnedCollection)
public
constructor Create(AOwner : TPersistent);
published
function Add: TGridLayoutItem;
end;
TGridLayout = Class(TComponent)
private
FFilename: string;
FGridLayoutCollection: TGridLayoutCollection;
procedure SetGridLayoutCollection(aValue : TGridLayoutCollection);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property Filename: string read FFilename write FFilename;
property GridLayoutCollection: TGridLayoutCollection read FGridLayoutCollection write SetGridLayoutCollection;
end;
Procedure DumpObject(const Header : String; var O : TJSONData);
begin
Writeln(Header,' : ');
Writeln(O.FormatJSON());
writeln();
FreeAndNil(O);
JS.Options:=[];
end;
function TGridColumnCollection.GetItem(AIndex: Integer): TGridColumn;
begin
result := TGridColumn(inherited GetItem(AIndex));
end;
procedure TGridColumnCollection.SetItem(AIndex : Integer; aValue : TGridColumn);
begin
inherited Items[AIndex] := aValue;
end;
constructor TGridColumnCollection.Create(AOwner : TPersistent);
begin
inherited Create(AOwner, TGridColumn);
end;
function TGridColumnCollection.Add: TGridColumn;
begin
result := TGridColumn(inherited Add);
end;
constructor TGridLayoutCollection.Create(AOwner : TPersistent);
begin
inherited Create(AOwner, TGridLayoutItem);
end;
function TGridLayoutCollection.Add: TGridLayoutItem;
begin
result := TGridLayoutItem(inherited Add);
end;
procedure TGridLayoutItem.SetColumnCollection(aValue : TGridColumnCollection);
begin
if aValue = FColumnCollection then Exit;
FColumnCollection.Assign(aValue);
end;
constructor TGridLayoutItem.Create(ACollection : TCollection);
begin
inherited Create(ACollection);
FColumnCollection := TGridColumnCollection.Create(Self);
end;
destructor TGridLayoutItem.Destroy;
begin
FColumnCollection.Free;
inherited Destroy;
end;
procedure TGridLayout.SetGridLayoutCollection(aValue : TGridLayoutCollection);
begin
if aValue = FGridLayoutCollection then Exit;
FGridLayoutCollection.Assign(aValue);
end;
constructor TGridLayout.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FGridLayoutCollection := TGridLayoutCollection.Create(Self);
end;
destructor TGridLayout.Destroy;
begin
FGridLayoutCollection.Free;
inherited Destroy;
end;
Procedure DemoGridLayoutCollection;
Var
glc: TGridLayoutCollection;
glCI: TGridLayoutItem;
//glcColumnCollection : TGridColumnCollection;
glcColumnItem: TGridColumn;
O: TJSONData;
gridLayout: TGridLayout;
AStream: TFileStream;
gridFilename: string;
aComponent: TComponent;
begin
gridLayout := TGridLayout.Create(nil);
gridLayout.Name := 'NiceGridLayout';
gridLayout.FileName := gridLayout.Name;
gridFilename := gridLayout.Name;
glc := gridLayout.GridLayoutCollection;//.Add;
glcI := glc.Add;
glcI.Name := 'First Layout Name';
glcI.Description := 'First Layout Description';
//glcColumnCollection := TGridColumnCollection.Create(TGridColumn);
glcColumnItem := glCI.ColumnCollection.Add;
with glcColumnItem do
begin
ColumnIndex := 1;
Width := 20;
Visible :=True;
Present := True;
ColumnTitle:= 'This Title';
FieldName:= 'Price';
end;
glcColumnItem := glCI.ColumnCollection.Add;
with glcColumnItem do
begin
ColumnIndex := 2;
Width := 20;
Visible :=True;
Present := True;
ColumnTitle:= 'Second Column';
FieldName:= 'Quantity';
end;
//glcI.ColumnCollection := glcColumnCollection;
//glcColumnCollection.Free;
//glcColumnItem.Free;
glcI := glc.Add;
glcI.Name := 'Second Layout Name';
glcI.Description := 'Second Layout Description';
//glcColumnCollection := glCI.ColumnCollection.Add;//TGridColumnCollection.Create(TGridColumn);
glcColumnItem := glCI.ColumnCollection.Add;
with glcColumnItem do
begin
ColumnIndex := 1;
Width := 20;
Visible :=True;
Present := True;
ColumnTitle:= 'This Title 2';
FieldName:= 'Price 2';
end;
glcColumnItem := glCI.ColumnCollection.Add;
with glcColumnItem do
begin
ColumnIndex := 2;
Width := 20;
Visible :=True;
Present := True;
ColumnTitle:= 'Second Column';
FieldName:= 'Quantity';
end;
//glcI.ColumnCollection := glcColumnCollection;
O := JS.ObjectToJSON(glc);
DumpObject('grid layout collection', O);
//gridLayout := TGridLayout.Create(nil);
//gridLayout.Name := 'NiceGridLayout';
//gridLayout.FileName := gridLayout.Name;
//gridFilename := gridLayout.Name;
//gridLayout.GridLayoutCollection := glc;
//O := JS.ObjectToJSON(gridLayout);
//DumpObject('grid layout component', O);
AStream:= TFileStream.Create(gridLayout.Filename, fmCreate);
try
AStream.WriteComponent(gridLayout);
finally
AStream.Free;
end;
//glc.Free;
//glcColumnCollection.Free;
gridLayout.Free;
gridLayout := nil;
// this is where it crashes, unless writing is faulty as well
AStream:= TFileStream.Create(gridFileName, fmOpenRead);
try
gridLayout := TGridLayout(AStream.ReadComponent(gridLayout));
finally
AStream.Free;
end;
O := JS.ObjectToJSON(gridLayout);
DumpObject('Reloaded Grid Layout', O);
gridLayout.Free;
end;
procedure DumpHeapTraceOutput;
begin
SetHeapTraceOutput('tracefile.txt');
end;
begin
AddExitProc(@DumpHeapTraceOutput);
JS:=TJSONStreamer.Create(Nil);
try
RegisterClass(Tgridlayout);
DemoGridLayoutCollection;
Finally
FreeAndNil(JS);
end;
end.
@TurboRascal you do understand that he uses the json only to dump the objects on screen so he can check that everything worked right?
Recent
