save open records to disk

Forum > General

<< < (5/5)

karaba:
you can add an entry at the wiki, under file access methods or something along those lines. Also the forums are indexed by google so searching using their engine should bring up this thread.

lainz:

--- Quote from: clemmi on March 29, 2014, 11:01:31 pm ---I didn't see the last post until now, because it went to a new page, but I printed the wiki link and I'll digest it. - Thanks!

--- End quote ---

Maybe you can digest it with an example you'll understand.

First this unit:

--- Code: ---unit usaving;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, LResources;

type

{ TBookItem }

TBookItem = class(TCollectionItem)
private
FCode: string;
FTitle: string;
public
constructor Create(ACollection: TCollection); override;
published
property Code: string read FCode write FCode;
property Title: string read FTitle write FTitle;
end;

{ TPeopleItem }

TPeopleItem = class(TCollectionItem)
private
FName: string;
FChoice: string;
public
constructor Create(ACollection: TCollection); override;
published
property Name: string read FName write FName;
property Choice: string read FChoice write FChoice;
end;

{ TBookCollection }

TBookCollection = class(TCollection)
private
function GetItems(Index: integer): TBookItem;
procedure SetItems(Index: integer; AValue: TBookItem);
public
constructor Create;
public
function Add: TBookItem;
function AddEx(aCode, aTitle: string): TBookItem;
public
property Items[Index: integer]: TBookItem read GetItems write SetItems; default;
end;

{ TPeopleCollection }

TPeopleCollection = class(TCollection)
private
function GetItems(Index: integer): TPeopleItem;
procedure SetItems(Index: integer; AValue: TPeopleItem);
public
constructor Create;
public
function Add: TPeopleItem;
function AddEx(aName, aChoice: string): TPeopleItem;
public
property Items[Index: integer]: TPeopleItem read GetItems write SetItems; default;
end;

{ TBookAndPeople }

TBookAndPeople = class(TComponent)
private
FBook: TBookCollection;
FPeople: TPeopleCollection;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
public
procedure SaveToFile(AFileName: string);
procedure LoadFromFile(AFileName: string);
procedure OnFindClass(Reader: TReader; const AClassName: string;
var ComponentClass: TComponentClass);
published
property Book: TBookCollection read FBook write FBook;
property People: TPeopleCollection read FPeople write FPeople;
end;

implementation

{ TBookAndPeople }

constructor TBookAndPeople.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Book := TBookCollection.Create;
People := TPeopleCollection.Create;
end;

destructor TBookAndPeople.Destroy;
begin
Book.Free;
People.Free;
inherited Destroy;
end;

procedure TBookAndPeople.SaveToFile(AFileName: string);
var
AStream: TMemoryStream;
begin
AStream := TMemoryStream.Create;
try
WriteComponentAsTextToStream(AStream, Self);
AStream.SaveToFile(AFileName);
finally
AStream.Free;
end;
end;

procedure TBookAndPeople.LoadFromFile(AFileName: string);
var
AStream: TMemoryStream;
begin
AStream := TMemoryStream.Create;
try
AStream.LoadFromFile(AFileName);
ReadComponentFromTextStream(AStream, TComponent(Self), @OnFindClass);
finally
AStream.Free;
end;
end;

procedure TBookAndPeople.OnFindClass(Reader: TReader; const AClassName: string;
var ComponentClass: TComponentClass);
begin
if CompareText(AClassName, 'TBookAndPeople') = 0 then
ComponentClass := TBookAndPeople;
end;

{ TPeopleCollection }

function TPeopleCollection.GetItems(Index: integer): TPeopleItem;
begin
Result := TPeopleItem(inherited Items[Index]);
end;

procedure TPeopleCollection.SetItems(Index: integer; AValue: TPeopleItem);
begin
Items[Index].Assign(AValue);
end;

constructor TPeopleCollection.Create;
begin
inherited Create(TPeopleItem);
end;

function TPeopleCollection.Add: TPeopleItem;
begin
Result := inherited Add as TPeopleItem;
end;

function TPeopleCollection.AddEx(aName, aChoice: string): TPeopleItem;
begin
Result := inherited Add as TPeopleItem;
Result.Name := aName;
Result.Choice := aChoice;
end;

{ TBookCollection }

function TBookCollection.GetItems(Index: integer): TBookItem;
begin
Result := TBookItem(inherited Items[Index]);
end;

procedure TBookCollection.SetItems(Index: integer; AValue: TBookItem);
begin
Items[Index].Assign(AValue);
end;

constructor TBookCollection.Create;
begin
inherited Create(TBookItem);
end;

function TBookCollection.Add: TBookItem;
begin
Result := inherited Add as TBookItem;
end;

function TBookCollection.AddEx(aCode, aTitle: string): TBookItem;
begin
Result := inherited Add as TBookItem;
Result.Code := aCode;
Result.Title := aTitle;
end;

{ TPeopleItem }

constructor TPeopleItem.Create(ACollection: TCollection);
begin
if Assigned(ACollection) and (ACollection is TPeopleCollection) then
inherited Create(ACollection);
end;

{ TBookItem }

constructor TBookItem.Create(ACollection: TCollection);
begin
if Assigned(ACollection) and (ACollection is TBookCollection) then
inherited Create(ACollection);
end;

end.

--- End code ---

This form:

--- Code: ---unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
usaving;//<-- this is our saving unit

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
FData: TBookAndPeople;
public
{ public declarations }
property Data: TBookAndPeople read FData write FData;
end;

var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
Data := TBookAndPeople.Create(Self);

with Data.Book do
begin
AddEx('ORD', 'Order in Chaos');
AddEx('FBI', 'History of the FBI');
AddEx('RAN', 'Randomnes in life');
end;

with Data.People do
begin
AddEx('Moe', 'FBI');
AddEx('Larry', 'ORD');
AddEx('Curly', 'ORD');
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Data.SaveToFile('data.txt');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Data.LoadFromFile('data.txt');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
// Data is freed automatically
end;

end.

--- End code ---

This output (can be binary if you change 'Text' to 'Binary' in Save/Load):

--- Code: ---object TBookAndPeople
Book = <
item
Code = 'ORD'
Title = 'Order in Chaos'
end
item
Code = 'FBI'
Title = 'History of the FBI'
end
item
Code = 'RAN'
Title = 'Randomnes in life'
end>
People = <
item
Name = 'Moe'
Choice = 'FBI'
end
item
Name = 'Larry'
Choice = 'ORD'
end
item
Name = 'Curly'
Choice = 'ORD'
end>
end

--- End code ---

And when you finish maybe you're interested on using Generics, for example, if you want to add more collections quickly: http://wiki.lazarus.freepascal.org/TCollection#Generics

Navigation

[0] Message Index

[*] Previous page