Recent

Author Topic: I need some Pascalish method for saving the state of grids to disk.  (Read 12668 times)

vfclists

  • Hero Member
  • *****
  • Posts: 1146
    • HowTos Considered Harmful?
I want to implement some Pascal oriented way of saving the state of data grids to disk, and be able to name the column views, describe them, add them and delete them. However I want something native to Object Pascal, ie no database oriented, json/xml, or ini files etcetera. Even if they are saved in those formats, it must be handled by the persistence mechanism transparently.

As the saying goes when you only tool is a hammer, everything looks like a name, I need to get out the everything is an (SQL) database mentality thing. I need to get my Pascal mojo going

I want to use proper objects, streams, collections etc and just save them or stream them to disk directly, so here goes.

At the top level is
Views:
  view - a short name
  description - a description of that view and when and how it the most appropriate
  column_list - consisting of a list of column_view
     colum_view - fieldname,visible,column width

So basically it is a list of views each of which have a list column layouts attached to it.

Another option appears to be saving the TDBGrid.Columns collection directly and modifying it to set the visible property of a TColumn to false when saving if the width is below a certain threshold.

How do I get started. I am checking out a few online articles but if you have any thoughts do post them.
Lazarus 3.0/FPC 3.2.2

Dibo

  • Hero Member
  • *****
  • Posts: 1048
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #1 on: March 09, 2013, 06:12:10 pm »
I think there is no ready solution for your case (like component wrapper etc). You can always create your config tables for your application in some embedded SQL (like SQLite, FireBird embedded). In "column_list" field based on TEXT type you can store what ever you want. JSON, XML, or comma separated string list, it depends on your needs. Then parse it by free pascal wrappers. For example, simple "," separated list:
Code: [Select]
var
  sl: TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Delimiter := ',';
    sl.Text := MyQuery.FieldByName('column_list').AsString;
    // Enumerate columns
    for i:=0 to Pred(sl.Count) do
    begin
      // Do somethig with sl.String[i] item
    end;
  finally
    sl.Free;
  end;
end;

vfclists

  • Hero Member
  • *****
  • Posts: 1146
    • HowTos Considered Harmful?
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #2 on: March 09, 2013, 06:26:01 pm »
You missed the main point of the question: I don't want to use database, json/xml, ini files etc.
Quote
However I want something native to Object Pascal, ie no database oriented, json/xml, or ini files etcetera. Even if they are saved in those formats, it must be handled by the persistence mechanism transparently.

As the saying goes when you only tool is a hammer, everything looks like a name, I need to get out the everything is an (SQL) database mentality thing. I need to get my Pascal mojo going

I want to use proper objects, streams, collections etc and just save them or stream them to disk directly, so here goes.

I think there is no ready solution for your case (like component wrapper etc). You can always create your config tables for your application in some embedded SQL (like SQLite, FireBird embedded). In "column_list" field based on TEXT type you can store what ever you want. JSON, XML, or comma separated string list, it depends on your needs. Then parse it by free pascal wrappers. For example, simple "," separated list:
Code: [Select]
var
  sl: TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Delimiter := ',';
    sl.Text := MyQuery.FieldByName('column_list').AsString;
    // Enumerate columns
    for i:=0 to Pred(sl.Count) do
    begin
      // Do somethig with sl.String[i] item
    end;
  finally
    sl.Free;
  end;
end;
Lazarus 3.0/FPC 3.2.2

Dibo

  • Hero Member
  • *****
  • Posts: 1048
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #3 on: March 09, 2013, 06:30:27 pm »
Sorry, I misunderstood your question

vfclists

  • Hero Member
  • *****
  • Posts: 1146
    • HowTos Considered Harmful?
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #4 on: March 09, 2013, 06:45:12 pm »
No need to apologize. I still await your ideas about my approach
Sorry, I misunderstood your question
Lazarus 3.0/FPC 3.2.2

Dibo

  • Hero Member
  • *****
  • Posts: 1048
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #5 on: March 09, 2013, 07:13:48 pm »
I supose that you want similar solution like WST SOAP:
http://wiki.freepascal.org/Web_Service_Toolkit

This is wrapper for multilanguage communication. It convert low level XML api to Pascal objects and methods. Of course this is not solution for your case, but you need something similar?
Just curious, why you can't use SQL? You don't want provide whole SQL libs? So maybe DBF? It doesn't need any external libs

vfclists

  • Hero Member
  • *****
  • Posts: 1146
    • HowTos Considered Harmful?
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #6 on: March 09, 2013, 07:37:33 pm »
It isn't about SQL. It is about thinking about programming constructs and facilities in a purer more abstract way, rather than in terms of what tools are available. I have done a lot of database programming and to be honest it can seriously damage ones outlook on computing, when one reflexively approaches all kinds data persistence in tabular terms, ie rows,columns, grids, one->one, one->many etc.

The internet and all the tools which have developed and are focused only serves narrow a whole generation's outlook on what information systems should be about. I mean when you understand that 20 years ago computer and operating systems were designed to run LISP, Prolog and Smalltalk from the very lowest level CPU level all the way to the application level, you get to realize how little progress is made as to what computing should be about and how it is seen at the programming level. We are still stuck on building everything from C. As a Pascal programmer can you imagine how easy your life would be even if the OS and all the applications you used could be  programmed in Pascal from bottom up, even what you use your bash scripts for?

Anyway I am rambling and digressing.
I supose that you want similar solution like WST SOAP:
http://wiki.freepascal.org/Web_Service_Toolkit

This is wrapper for multilanguage communication. It convert low level XML api to Pascal objects and methods. Of course this is not solution for your case, but you need something similar?
Just curious, why you can't use SQL? You don't want provide whole SQL libs? So maybe DBF? It doesn't need any external libs
Lazarus 3.0/FPC 3.2.2

BigChimp

  • Hero Member
  • *****
  • Posts: 5740
  • Add to the wiki - it's free ;)
    • FPCUp, PaperTiger scanning and other open source projects
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #7 on: March 10, 2013, 08:08:23 am »
You can think about using records, objects, collections (tfplists etc)... and let them have child records, objects and/or collections.

Perhaps records is a bit old-school..

AFAIU, if your objects have published properties, they can get streamed to/from disk using RTTI.

Of course, whenever you change the structure, you'll have to change the program.

Rereading my answer, it seems it more or less mirrors your question. What exactly is the problem? Which objects etc to use? How to do streaming? Etc.
Want quicker answers to your questions? Read http://wiki.lazarus.freepascal.org/Lazarus_Faq#What_is_the_correct_way_to_ask_questions_in_the_forum.3F

Open source including papertiger OCR/PDF scanning:
https://bitbucket.org/reiniero

Lazarus trunk+FPC trunk x86, Windows x64 unless otherwise specified

CaptBill

  • Sr. Member
  • ****
  • Posts: 435
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #8 on: March 10, 2013, 09:04:42 am »
You can think about using records, objects, collections (tfplists etc)... and let them have child records, objects and/or collections.

Perhaps records is a bit old-school..

AFAIU, if your objects have published properties, they can get streamed to/from disk using RTTI.

Of course, whenever you change the structure, you'll have to change the program.

Rereading my answer, it seems it more or less mirrors your question. What exactly is the problem? Which objects etc to use? How to do streaming? Etc.

Good points.
I like the spirit of the question if I understand correctly.
Vcflists is asking "what is the best way (Pascalish) of rolling-my-own object database, which I know is Pascal is capable of like no other language"

It is a case of doing a master>>detail class structure where you have a global wrapper component with it's own internally defined/managed sub-classes (or records here).

I think you can get some good ideas by looking at any examples of "compound components" you can find. Concept is simple, take a group of components, wrap them in a Tpanel, ripple the interfacing to the public section of the "master" tpanel. So you are imitating the class "public" section at the global level, for multiple components.

Fascinating question.


vfclists

  • Hero Member
  • *****
  • Posts: 1146
    • HowTos Considered Harmful?
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #9 on: March 10, 2013, 01:21:53 pm »
This is what I have come up with based on collections the demortti.pp in the fcl-json examples as a means to visualize the structure.
The next step is saving it to disk and loading it back, via regular Object Pascal streaming and as JSON as well.

My questions are:

1. Does the structure have to be redesigned as a component to enable it to be streamed?

2. If I make it a component does TGridLayoutCollection have to be subcomponent and TGridColumnCollections in turn be a subcomponent of TGridLayoutItem or does it simply require TGridLayoutCollection to be a field published as a property?

3. Whether streamed as native Object Pascal or JSON streaming and loading it back how do I go about implementing that?

The demo doesn't give an example of loading it back :(

Code: [Select]
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 Index: 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 = class(TCollection)
  private
   function GetItem(AIndex: Integer): TGridColumn;
  public
   function Add: TGridColumn;
   property Items[AIndex: Integer]: TGridColumn read GetItem; default;
  end;


  { TGridLayoutItem }

  TGridLayoutItem = Class(TCollectionItem)
  private
    FName, FDescription: String;
    FColumnCollection: TGridColumnCollection;
  published
    property Name: string read FName write FName;
    property Description: string read FDescription write FDescription;
    property ColumnCollection: TGridColumnCollection read FColumnCollection write FColumnCollection;
  end;

  { TGridLayoutCollection }

  TGridLayoutCollection = Class(TCollection)
  private
    FGridLayoutItems: TCollection;
  published
    function Add: TGridLayoutItem;
    property GridLayoutItems: TCollection read FGridLayoutItems write FGridLayoutItems;
  end;



Procedure DumpObject(const Header : String; var O : TJSONData);

begin
  Writeln(Header,' : ');
  Writeln(O.FormatJSON());
  writeln();
  FreeAndNil(O);
  JS.Options:=[];
end;

Procedure DemoObject;

Var
  C : TComponent;
  O : TJSONData;

begin
  C:=TComponent.Create(Nil);
  try
    C.Name:='DemoComponent';
    C.Tag:=23;
    O:=JS.ObjectToJSON(C);
    DumpObject('Complete component',O);
  finally
    FreeAndNil(C);
  end;
end;


function TGridColumnCollection.GetItem(AIndex: Integer): TGridColumn;
begin
  result := TGridColumn(inherited GetItem(AIndex));
end;

function TGridColumnCollection.Add: TGridColumn;
begin
  result := TGridColumn(inherited Add);
end;

function TGridLayoutCollection.Add: TGridLayoutItem;
begin
  result := TGridLayoutItem(inherited Add);
end;


Procedure DemoGridLayoutCollection;
Var
  glc: TGridLayoutCollection;
  glCI: TGridLayoutItem;
  glcColumnCollection : TGridColumnCollection;
  glcColumnItem: TGridColumn;
  O: TJSONData;
begin
  glc := TGridLayoutCollection.Create(TGridLayoutItem);
  glcI := glc.Add;
  glcI.Name := 'First Layout Name';
  glcI.Description := 'First Layout Description';
  glcColumnCollection := TGridColumnCollection.Create(TGridColumn);
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 1;
    Width := 20;
    Visible :=True;
    Present := True;
    ColumnTitle:= 'This Title';
    FieldName:= 'Price';
  end;
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 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 := TGridColumnCollection.Create(TGridColumn);
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 1;
    Width := 20;
    Visible :=True;
    Present := True;
    ColumnTitle:= 'This Title 2';
    FieldName:= 'Price 2';
  end;
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 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);

  glc.Free;
//  glCI.Free;
  glcColumnCollection.Free;
  //glcColumnItem.Free;


end;

procedure DumpHeapTraceOutput;
begin
  SetHeapTraceOutput('tracefile.txt');
end;

begin
  AddExitProc(@DumpHeapTraceOutput);
  JS:=TJSONStreamer.Create(Nil);
  try
    DemoGridLayoutCollection;
  Finally
    FreeAndNil(JS);
  end;
end.

Lazarus 3.0/FPC 3.2.2

vfclists

  • Hero Member
  • *****
  • Posts: 1146
    • HowTos Considered Harmful?
This where I have got so far. I have been able to turn it into a component, display it and stream it to disk, but reading it back results in a crash. Any ideas?

Code: [Select]
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 Index: 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 = class(TCollection)
  private
   function GetItem(AIndex: Integer): TGridColumn;
  public
   function Add: TGridColumn;
   property Items[AIndex: Integer]: TGridColumn read GetItem; default;
  end;


  { TGridLayoutItem }

  TGridLayoutItem = Class(TCollectionItem)
  private
    FName, FDescription: String;
    FColumnCollection: TGridColumnCollection;
  published
    property Name: string read FName write FName;
    property Description: string read FDescription write FDescription;
    property ColumnCollection: TGridColumnCollection read FColumnCollection write FColumnCollection;
  end;

  { TGridLayoutCollection }

  TGridLayoutCollection = Class(TCollection)
  private
    FGridLayoutItems: TCollection;
  published
    function Add: TGridLayoutItem;
    property GridLayoutItems: TCollection read FGridLayoutItems write FGridLayoutItems;
  end;

  TGridLayout = Class(TComponent)
  private
    FFilename: string;
    FGridLayoutCollection: TGridLayoutCollection;
  published
    property Filename: string read FFilename write FFilename;
    property GridLayoutCollection: TGridLayoutCollection read FGridLayoutCollection write FGridLayoutCollection;
  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;

function TGridColumnCollection.Add: TGridColumn;
begin
  result := TGridColumn(inherited Add);
end;

function TGridLayoutCollection.Add: TGridLayoutItem;
begin
  result := TGridLayoutItem(inherited Add);
end;


Procedure DemoGridLayoutCollection;
Var
  glc: TGridLayoutCollection;
  glCI: TGridLayoutItem;
  glcColumnCollection : TGridColumnCollection;
  glcColumnItem: TGridColumn;
  O: TJSONData;
  gridLayout: TGridLayout;
  AStream: TFileStream;
  gridFilename: string;
  aComponent: TComponent;
begin
  glc := TGridLayoutCollection.Create(TGridLayoutItem);
  glcI := glc.Add;
  glcI.Name := 'First Layout Name';
  glcI.Description := 'First Layout Description';
  glcColumnCollection := TGridColumnCollection.Create(TGridColumn);
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 1;
    Width := 20;
    Visible :=True;
    Present := True;
    ColumnTitle:= 'This Title';
    FieldName:= 'Price';
  end;
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 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 := TGridColumnCollection.Create(TGridColumn);
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 1;
    Width := 20;
    Visible :=True;
    Present := True;
    ColumnTitle:= 'This Title 2';
    FieldName:= 'Price 2';
  end;
  glcColumnItem := glcColumnCollection.Add;
  with glcColumnItem do
  begin
    Index := 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
    DemoGridLayoutCollection;
  Finally
    FreeAndNil(JS);
  end;
end.
Lazarus 3.0/FPC 3.2.2

taazz

  • Hero Member
  • *****
  • Posts: 5368
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #11 on: March 11, 2013, 12:35:39 am »
From a quick look around I suggest to change all the TCollection to TOwnedCollection eg

TGridLayoutCollection = class(TOwnedCollection)
....

also make sure that the collection you create inside other components have an owner assinged.
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

taazz

  • Hero Member
  • *****
  • Posts: 5368
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #12 on: March 11, 2013, 01:29:43 am »
ok took a closer look on your code it has to many problems for me to solve at this time let me tell you a few things

1) in order for the streaming mechanism to create your object it needs to be able to translate the class name which is a string to a class type to do that it keeps a map of class names, classtype in memory. So to recognize your TGridLayout class you need to register it in that map use RegisterClass function to that.

2) a TCollection can not be streamed effectively it has no owner and the mechanism can not create the path required for streaming, the path usually is rootcomponentName.ChildComponentName.ChildComponentName..(multiple childrent)...CollectionPropertyName this helps the mechanism to select the correct in memory component and apply the property values if you do not use a TOwnedCollection this path gets broken and a number of errors will raise. So use TOwnedCollection.

3) Collections are not handle the same as TComponents the streaming mechanism handles them as simple TPersistent classes with an exception on saving the items it has. This means 2 things for you
a) Collection creation and destruction is expected to be handled by the owning object no auto creation from the streaming mechanism.
b) You can not change the CollectionItem in between executions and expect the file to be loaded correctly.

If I find some time I'll write a simple hierarchy for you that will be able to save and load correctly.
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

TurboRascal

  • Hero Member
  • *****
  • Posts: 672
  • "Good sysadmin. Bad programmer."™
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #13 on: March 11, 2013, 08:25:02 am »
OP: You said you didn't want a json (or any db-oriented) solution, but it seems you are going for a json solutio now, so perhaps you should rephrase your original question? :)

Otherwise, you could have gone simply with CSV, support for which is included in FPC/Lazarus; or if you want truly "pascalish" solution, well, the only option which would work on any Pascal compiler would be dumping the native data structure. In this case that would mean saving an array of fixed-length field records to a file...
Regards, ArNy the Turbo Rascal
-
"The secret is to give them what they need, not what they want." - Scotty, STTNG:Relics

taazz

  • Hero Member
  • *****
  • Posts: 5368
Re: I need some Pascalish method for saving the state of grids to disk.
« Reply #14 on: March 11, 2013, 08:50:27 am »
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.

Code: [Select]
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?
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

 

TinyPortal © 2005-2018