Is this economical? - delphi

Just wanting to see if there is a better way to do the following(there is always a better way for everything) because it does delay the application when loading due the amount of data.
I want to fill an array of records with data I have stored in csv file, I currently have it fixed length for the array but will later make it dynamic so I can add to the csv file.
type
TStarCoords = Packed record
szSystem: String[40];
fCoordX: Single;
fCoordY: Single;
fCoordZ: Single;
end;
SystemCoords: Array [0 .. 22379] of TStarCoords;
Const
SYSTEMS = 'Data\Systems.csv';
I then fill the array on the oncreate event
procedure TForm1.FormCreate(Sender: TObject);
var
szFile, sRecord: string;
Row, Index, i: Integer;
slList: TStringList;
begin
szFile := ExtractFilePath(ParamStr(0)) + SYSTEMS;
if FileExists(szFile) then
try
slList := TStringList.Create;
slList.LoadFromFile(szFile);
for Row := 0 to slList.Count - 1 do
begin
sRecord := slList[Row];
index := Pos(',', sRecord);
if index > 0 then
begin
SystemCoords[Row].szSystem := Copy(sRecord, 1, index - 1);
Delete(sRecord, 1, index);
end;
index := Pos(',', sRecord);
if index > 0 then
begin
SystemCoords[Row].fCoordX := StrToFloat(Copy(sRecord, 1, index - 1));
Delete(sRecord, 1, index);
end;
index := Pos(',', sRecord);
if index > 0 then
begin
SystemCoords[Row].fCoordY := StrToFloat(Copy(sRecord, 1, index - 1));
Delete(sRecord, 1, index);
end;
SystemCoords[Row].fCoordZ := StrToFloat(sRecord);
end;
finally
slList.Free;
end;
for i := Low(SystemCoords) to High(SystemCoords) do
begin
cbSystem.Items.Add(SystemCoords[i].szSystem);
end;
end;
As you can see I am using "Pos" function to parse the csv file and also loop the array at the end to add the Star name to a combobox, Is there a more economical way of doing this?
Any suggestions are welcomed

It doesn't look very efficient.
Allocating a fixed length global array looks poor. Use a dynamic array of length determined at runtime.
Short strings are not recommended. Don't use them in modern programming. They are legacy and don't handle Unicode.
Don't pack records. That results in misaligned data.
There seems to be far more heap allocations that are needed. Avoid Delete if you can.
Loading into a string list won't be efficient. Use a line reader based approach for speed. Delphi's built in class though is rubbish. If you want speed and effective use of memory, roll your own.
Probably the bulk of the time is spent populating the combo! Adding 22380 items to a combo will take a very long time. Don't do that. If the data set is smaller, only add as many items as there are in the data. Otherwise, use the virtual paradigm in your UI control.
Your next step though is to work out where the bottleneck is. We can only guess because we are missing so much information. We don't know if the data is static, how big it is, and so on.

Like others said, probably the majority of the time is spent populating the combo.
In my opinion, when dealing with big updates of a TStrings the BeginUpdate / EndUpdate technique proposed by the Jens Borrisholt's answer constitutes a valid approach.
As a minor issue, if your application is the only which writes and reads the data and neither machines nor humans care about the CSV format, you might consider to store the records adopting a different file format, using the BlockRead and BlockWrite functions.
type
TStarCoords = record
szSystem: string[40];
fCoordX,
fCoordY,
fCoordZ: Single;
end;
. . .
const
CFILENAME = '<your path to some file .dat>';
Reading the data:
procedure TForm1.FormCreate(Sender: TObject);
var
lstStarCoords: TList<TStarCoords>;
f: File;
starCoords: TStarCoords;
begin
lstStarCoords := TList<TStarCoords>.Create;
try
AssignFile(f, CFILENAME);
Reset(f, SizeOf(TStarCoords));
try
while not Eof(f) do begin
BlockRead(f, starCoords, 1);
lstStarCoords.Add(starCoords);
end;
finally
CloseFile(f);
end;
cbSystem.Items.BeginUpdate;
for starCoords in lstStarCoords do
cbSystem.Items.Add(starCoords.szSystem);
cbSystem.Items.EndUpdate;
finally
lstStarCoords.Free;
end;
end;
Writing the data:
procedure TForm1.WriteStarCoords;
var
lstStarCoords: TList<TStarCoords>;
f: File;
starCoords: TStarCoords;
i: Integer;
begin
lstStarCoords := TList<TStarCoords>.Create;
try
//let's insert 5k new items
for i:=1 to 5000 do begin
with starCoords do begin
szSystem := 'HYEL YE';
fCoordX := 122;
fCoordY := 12.375;
fCoordZ := 45.75;
end;
lstStarCoords.Add(starCoords);
end;
AssignFile(f, CFILENAME);
Rewrite(f, SizeOf(TStarCoords));
try
for starCoords in lstStarCoords do
BlockWrite(f, starCoords, 1);
finally
CloseFile(f);
end;
finally
lstStarCoords.Free;
end;
end;
EDIT: example using pointers to store the record information directly in the cbSystem component.
This approach is a little more "dangerous" since it allocates memory which has to be manually freed but allows to avoid the usage of a TDictionary to pair the TStarCoords.szSystem with the corresponding record.
Declare a new type which points to the TStarCoords record:
type
PStarCoords = ^TStarCoords;
Reading the data:
procedure TForm1.FormCreate(Sender: TObject);
var
lstStarCoords: TStringList;
f: File;
starCoords: PStarCoords;
begin
ClearCbSystem;
lstStarCoords := TStringList.Create(False);
{another minor enhancement:
since lstStarCoords does not own any TObject which needs to be freed
the OwnsObjects property of the TStringList can be set to False
in order to avoid some code to be execute in some method like Clear and Delete}
try
lstStarCoords.BeginUpdate;
AssignFile(f, CFILENAME);
Reset(f, SizeOf(TStarCoords));
try
while not Eof(f) do begin
New(starCoords);
BlockRead(f, starCoords^, 1);
lstStarCoords.AddObject(starCoords^.szSystem, TObject(starCoords));
end;
finally
CloseFile(f);
end;
lstStarCoords.EndUpdate;
cbSystem.Items.Assign(lstStarCoords);
finally
lstStarCoords.Free;
end;
end;
Clearing the list with cbSystem.Clear does not automatically dispose the underlying pointers which have to be manually freed. Use the ClearCbSystem procedure everytime the cbSystem list has to be cleared:
procedure TForm1.ClearCbSystem;
var
i: Integer;
begin
cbSystem.Items.BeginUpdate;
for i := cbSystem.Items.Count-1 downto 0 do
Dispose(PStarCoords(cbSystem.Items.Objects[i]));
cbSystem.Clear;
cbSystem.Items.EndUpdate;
end;
When the form is destroyed, a call to the ClearCbSystem procedure ensures the pointers are disposed before the cbSystem component is freed by the application itself:
procedure TForm1.FormDestroy(Sender: TObject);
begin
ClearCbSystem;
end;

You can use TStringlist for the parsing of the line. In the following I assume that you have you elements seperated by a comma.
Since you are putting the string representation of you records into a combobox I assunme you later on in your program needs to go the other way: Find a TStarCoords from string. Given that I woyls recoment you putting your elements in a TDictionary instread og a Array.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Generics.Collections, StdCtrls;
type
TStarCoords = packed record
szSystem: string[40];
fCoordX: Single;
fCoordY: Single;
fCoordZ: Single;
end;
const
SYSTEMS = 'Data\Systems.csv';
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
private
SystemCoords: TDictionary<string, TStarCoords>;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ComboBox1Change(Sender: TObject);
var
StarCoord: TStarCoords;
begin
if not SystemCoords.TryGetValue(ComboBox1.Text, StarCoord) then
exit; //todo : Make some error handling
Caption := FloatToStr(StarCoord.fCoordX);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Lines, Elements: TStringlist;
Line: string;
SystemCoord: TPair<string, TStarCoords>;
begin
if not FileExists(ExtractFilePath(ParamStr(0)) + SYSTEMS) then
exit; //todo: Some error handling
SystemCoords := TDictionary<string, TStarCoords > .Create;
Lines := TStringlist.Create;
Elements := TStringlist.Create;
Elements.LineBreak := ',';
try
for Line in Lines do
begin
Elements.Text := Line;
SystemCoord.Key := Elements[0];
with SystemCoord.Value do
begin
szSystem := string(Elements[0]);
fCoordX := StrToFloat(Elements[1]);
fCoordY := StrToFloat(Elements[2]);
fCoordZ := StrToFloat(Elements[3]);
end;
SystemCoords.Add(SystemCoord.Key, SystemCoord.Value);
end;
finally
Lines.Free;
Elements.Free;
end;
try
ComboBox1.Items.BeginUpdate;
for SystemCoord in SystemCoords do
ComboBox1.Items.Add(SystemCoord.Key);
finally
ComboBox1.Items.EndUpdate;
end;
end;
end.

Related

how to retain connections between controls when copying?

i want to ask how to retain controlls when im making a copy of a control. for example i have an edit box that can be controlled with a slider for value change. when i make a copy using this code i achieve a copy of the items but the slider stops controlling editbox values. how can i fix that?
TypInfo;
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
procedure CloneEvents(Source, Dest: TControl);
var
I: Integer;
PropList: TPropList;
begin
for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], #PropList) - 1 do
SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
end;
procedure DuplicateChildren(const ParentSource: TWinControl;
const WithEvents: Boolean = True);
var
I: Integer;
CurrentControl, ClonedControl: TControl;
begin
for I := ParentSource.ControlCount - 1 downto 0 do
begin
CurrentControl := ParentSource.Controls[I];
ClonedControl := TControlClass(CurrentControl.ClassType).Create(CurrentControl.Owner);
ClonedControl.Parent := ParentSource;
CloneProperties(CurrentControl, ClonedControl);
ClonedControl.Name := CurrentControl.Name + '_';
if WithEvents then
CloneEvents(CurrentControl, ClonedControl);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DuplicateChildren(Panel1);
end;
Unless I'm misunderstanding you, your CloneProperties doesn't seem to have anything to do with the question you're asking. In your example of an edit control E1 and a slider S1, you can clone both of them to produce E2 and S2, but somewhere in your code there must be a statement that changes the value in E1 depending on the value of S1. However, in the way you've most likely written it, that statement doesn't apply to E2 and S2.
The simplest way around that is to write a method which takes the component instances and links the operation of the two together. e.g.
procedure TForm1.SetEditControlFromSlider(AnEdit : TEdit; ASlider : { TWhatever the slider actually is);
begin
// Set AnEdit's value from ASlider's properties
end;
Then, you can call this with Edit/Slider pairs like this
SetEditControlFromSlider(E1, S1);
[...]
SetEditControlFromSlider(E2, S2);
I can imagine you might not like having to do that.
IMO, the cleanest solution is to avoid attempting to clone components altogether and create a TFrame containing the Edit, Slider and the code that connects them, and then add to your form as many instances of the frame as you need. It's as easy as falling off a log.
type
TEditFrame = class(TFrame) // needs to be in its own unit, Used by your form
Edit1: TEdit;
TrackBar1: TTrackBar;
procedure TrackBar1Change(Sender: TObject);
private
public
end;
[...]
procedure TEditFrame.TrackBar1Change(Sender: TObject);
begin
Edit1.Text := IntToStr(TrackBar1.Position)
end;
Then, you can add clones of the frame to TForm1 by
procedure TForm1.Button1Click(Sender: TObject);
var
AFrame : TEditFrame;
begin
Inc(FrameCount); // Field of TForm1
AFrame := TEditFrame.Create(Self);
AFrame.Name := AFrame.Name + IntToStr(FrameCount);
AFrame.Parent := Self;
AFrame.Top := AFrame.Height * FrameCount;
end;
Note that because the code which links the two components, TrackBar1Change, it compiled into the frame's unit, it is automatically shared by every instance of the frame you create, without any need to "clone" the code.

How to internally process filtered tDataSet records not to be shown on tDBGrid the result

In the following tFDMemTable I try to sum value of records whose ID field starting letter A. A1, A2 and the result should be 4.
type
TForm1 = class(TForm)
FDMemTable1: TFDMemTable;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
_FieldDef: TFieldDef;
begin
_FieldDef := FDMemTable1.FieldDefs.AddFieldDef;
_FieldDef.Name := 'ID';
_FieldDef.DataType := ftString;
_FieldDef.Size := 5;
_FieldDef := FDMemTable1.FieldDefs.AddFieldDef;
_FieldDef.Name :='value';
_FieldDef.DataType := ftInteger;
FDMemTable1.CreateDataSet;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'A1';
FDMemTable1.FieldValues['value'] := 1;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'B1';
FDMemTable1.FieldValues['value'] := 2;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'A2';
FDMemTable1.FieldValues['value'] := 3;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'B2';
FDMemTable1.FieldValues['value'] := 4;
end;
I wrote the following code but it changes tDBGrid as filtered. What I want is just an internal process that tDBGrid should stay without any change.
procedure TForm1.Button1Click(Sender: TObject);
var
_ValueSum: Integer;
i: Integer;
begin
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
FDMemTable1.Filtered := True;
_ValueSum := 0;
FDMemTable1.FindFirst;
for i := 0 to FDMemTable1.RecordCount - 1 do
begin
_ValueSum := _ValueSum + FDMemTable1.FieldValues['value'];
FDMemTable1.FindNext;
end;
Button1.Caption := IntToStr(_ValueSum);
end;
I know tDataSet.Locate doesn't allow NEXT SEARCH that I tried a primitive way like this. It works fine but seems a little stupid.
procedure TForm1.Button2Click(Sender: TObject);
var
_ValueSum: Integer;
i: Integer;
begin
_ValueSum := 0;
FDMemTable1.First;
for i := 0 to FDMemTable1.RecordCount do
begin
if Copy(FDMemTable1.FieldValues['ID'], 1, 1) = 'A' then
begin
_ValueSum := _ValueSum + FDMemTable1.FieldValues['value'];
end;
FDMemTable1.FindNext;
end;
Button2.Caption := IntToStr(_ValueSum);
end;
When I disconnect tFDMemTable and tDBGrid or set inactive before filtering to hold the last grid status, the grid changes to blank one. Is the last code the best solution or is there any better way which shows not filtered result while the filtering is working?
There are several things which, if not "wrong", are not quite right with your code.
You should be using Next, not FindNext to move to the next row in the dataset. Next moves to the next row in the dataset, whereas FindNext moves to the next row which matches search criteria you have already set up e.g. using DataSet.SetKey; ... - read the online help for FindKey usage.
You should NOT be trying to traverse the dataset using a For loop; use a While not FDMemData.Eof do loop. Eof stands for 'End of file' and returns true once the dataset is on its last row.
You should be calling FDMemTable1.DisableControls before the loop and FDMemTable1.EnableControls after it. This prevents db-aware controls like your DBGrid from updating inside the loop, which would otherwise slow the loop down as the grid is updating.
Unless you have a very good reason not to, ALWAYS clear a dataset filter in the same method as you set it, otherwise you can get some very confusing errors if you forget the filter is active.
Try to avoid using RecordCount when you don't absolutely need to. Depending on the RDMS you are using, it can cause a lot of avoidable processing overhead on the server and maybe the network (because with some server types it will cause the entire dataset to be retrieved to the client).
Change your first loop to
procedure TForm1.Button1Click(Sender: TObject);
var
_ValueSum : Integer;
begin
_ValueSum := 0;
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
try
FDMemTable1.DisableControls;
FDMemTable1.First;
while not FDMemTable1.Eof do begin
_ValueSum:= _ValueSum + FDMemTable1.FieldByName('Value').AsInteger;
FDMemTable1.Next;
end
finally
FDMemTable1.Filter := '';
FDMemTable1.Filtered := False;
FDMemTable1.EnableControls;
end;
Button1.Caption := IntToStr(_ValueSum);
end;
If you do that, you don't need your Button2Click method at all.
As noted in a comment, you can use a TBookMark to record your position in the dataset before the loop and return to it afterwards, as in
var
_ValueSum : Integer;
BM : TBookMark;
begin
_ValueSum := 0;
BM := FDMemTable.GetBookMark;
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
try
[etc]
finally
FDMemTable1.Filter := '';
FDMemTable1.Filtered := False;
FDMemTable1.GotoBookMark(BM);
FDMemTable1.FeeBookMark(BM);
FDMemTable1.EnableControls;
end;
By the way, you can save yourself some typing and get more concise code by using the InsertRecord method as in
FDMemTable1.InsertRecord(['A1', 1]);
FDMemTable1.InsertRecord(['B1', 2]);
FDMemTable1.InsertRecord(['A2', 3]);
FDMemTable1.InsertRecord(['B2', 4]);
Btw#2: The time to use FindKey is after you've set up a key to find, using by calling SetKey than then setting the key value(s).
For ordinary navigation of a dataset, use the standard navigation methods, e.g. Next, Prior, First, Last, MoveBy etc.
FireDAC has another interesting option - Aggregates:
procedure TForm1.Button1Click(Sender: TObject);
begin
FDMemTable1.Aggregates.Clear;
with FDMemTable1.Aggregates.Add do
begin
Name := 'SUM';
Expression := 'sum(iif(ID like ''A%'', value, 0))';
Active := True;
end;
FDMemTable1.AggregatesActive := True;
FDMemTable1.Refresh;
Button1.Caption := VarToStr(FDMemTable1.Aggregates[0].Value));
end;

Use object in different function Delphi

This is just a very simple question to which i can't find a good clear answer to. I don't quite have the time to read all the documentation for this since i'm in a time crunch.
But here it is.
I have made a new class on top of my TForm class like so:
Bucket = Class
glass: Integer;
steel: Integer;
End;
I then create a couple of objects in a method which belongs to TForm1
procedure TForm1.getMarbles;
var
objPlastic: Bucket;
objAlu: Bucket;
begin
// Initialize objects
objPlastic := Bucket.Create;
objAlu := Bucket.Create;
// Get Values from edtBox
val(Edit1.Text, objPlastic.steel, code);
val(Edit2.Text, objAlu.steel, code);
val(Edit3.Text, objPlastic.glass, code);
val(Edit4.Text, objAlu.glass, code);
end;
My problem is that I don't know how to use these objects in other methods. I tried defining them in every way i know so far in the other methods I want to use them in, but I can't get it to work.
Here is the method and what I have it currently set to (which returns 0 all the time):
procedure TForm1.marbleDrop(kind: string);
var
objPlastic: Bucket;
I: Integer;
begin
objPlastic := Bucket.Create;
if kind= 'plastic' then // the function is receiving this parameter
begin
for I := 0 to objPlastic.glass do
begin
showmessage(inttostr(objPlastic.glass)); //returns 0
end;
end;
end;
Sorry for this kind of question, but i couldn't find a better way.
BTW, this is a simplified version of the code I am using. I did my best to get out any typos since it's a translation of what I am actually using, but it's mainly about the idea. I don't have typos in my code in delphi.
In other to access the objects across methods, you have to either:
declare the objects as members of the Form class:
type
TForm1 = class(TForm);
...
private
objPlastic: Bucket;
objAlu: Bucket;
...
end;
procedure TForm1.getMarbles;
begin
// Initialize objects
if objPlastic = nil then objPlastic := Bucket.Create;
if objAlu = nil then objAlu := Bucket.Create;
// Get Values from edtBox
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objAlu.steel := StrToIntDef(Edit2.Text, 0);
objPlastic.glass := StrToIntDef(Edit3.Text, 0);
objAlu.glass := StrToIntDef(Edit4.Text, 0);
end;
procedure TForm1.marbleDrop(kind: string);
begin
if (kind = 'plastic') and (objPlastic <> nil) then
begin
ShowMessage(IntToStr(objPlastic.glass));
end;
end;
pass them as parameters of the methods themselves:
procedure TForm1.getMarbles(objPlastic, objAlu: Bucket);
begin
// Get Values from edtBox
if objPlastic <> nil then
begin
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objPlastic.glass := StrToIntDef(Edit3.Text, 0);
end;
if objAlu <> nil then
begin
objAlu.steel := StrToIntDef(Edit2.Text, 0);
objAlu.glass := StrToIntDef(Edit4.Text, 0);
end;
end;
procedure TForm1.marbleDrop(objWhichKind: Bucket);
begin
if objWhichKind <> nil then
begin
ShowMessage(IntToStr(objWhichKind.glass));
end;
end;
procedure TForm1.someMethod();
var
objPlastic: Bucket;
begin
objPlastic := Bucket.Create;
getMarbles(objPlastic, nil);
marbleDrop(objPlastic);
objPlastic.Free;
end;
Of course it returns zero. It is another object. You should pass it as you pass any other parameter variable. What you made is similar to
procedure TForm1.Drop1(kind: string);
begin
marbleDrop(); // here kind = "staal"
end;
procedure TForm1.marbleDrop();
var
kind: string;
begin
if kind = 'plastic' then // it is not !!! why ???
begin
....
end;
end;
You also has another problem - Memory leak
val(Edit4.Text, objAlu.glass, code);
end;
You just created two objects - and allocated Heap memory for them.
But you did not freed them. That is garbage left and it will grow and grow and grow - until the program would exhaust all Windows memory and be killed.
If you want to use memory without any accuracy and without "wasting" your time on thinking and learning - you'd better user some managed language running in virtual machine, like PHP, Python, Java and other JVM-based, C# and other .NEt-based.
To make good Delphi code you should have at least some understanding what you CPU does and why.
Specifically in your code you'd better
use records instead of classes
pass them as const- or var-parameters to avoid redundant copying.
Like that:
type TBucket = Record glass, steel: Integer; End;
type TForm1 = class (TForm)
.....
private
var objPlastic, objAlu: TBucket;
(* making variables more global: now they are form-local not function-local *)
......
procedure TForm1.getMarbles;
begin
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objAlu.steel := ...
Self.objPlastic.glass ... (* adding Self - just for clarity where those variable are taken from *)
Self.objAlu.glass ....
end;
procedure TForm1.marbleDrop(kind: string);
var
I: Integer;
begin
if kind = 'plastic' then // the function is receiving this parameter
begin
for I := 0 to Self.objPlastic.glass do
begin
showmessage(inttostr(objPlastic.glass));
//getting via common parent context - TForm1 object, referenced as Self pseudo-variable
marbleTell(objPlastic); // passing as parameter
end;
end;
end;
procedure TForm1.marbleTell(const arg: TBucket);
// do not forget to use const to pass variable by-reference not by-value
begin
showmessage(inttostr(arg.glass)); // getting via argument
end;

"descending" records in delphi?

I know you can't actually descend anything from a record, but I'm not sure how to summarize my problem in one sentence. Edit the title if you do.
What I want to do here is make an array of some generic type, which can be one of X number of types, the array would be filled with those custom types (they have different fields and that's what is important). The easy way is to make just an array of variant records, each variant has it's own type, but obviously can't redeclare identifiers like so:
GenericRec = Record
case SubTypeName: TSubTypeName of
type1name: (SubRec: Type1);
type2name: (SubRec: Type2);
...
typeNname: (SubRec: TypeN);
end;
Changing SubRec to SubRec1, SubRec2... SubRecN makes referencing painful, but not impossible.
And since I started looking for alternative solutions to the above problem, classes came to mind.
The obvious example to demonstrate what I am trying to achieve is TObject, an array of those can be assigned to many different things. That's what I want, but with records (and that's impossible to do), because I want to be able to save the records to file as well as read them back (also because it's something I'm already familiar with). Making my own simple class is not a problem, making a descendant class from that to represent my subtype - I can do that. But what about writing that to file and reading it back? This boils down to serialization, which I have no idea how to do. From what I gather it's not as easy and the class must be descended from TComponent.
TMyClass = Class
Does it make any difference if I make the class like above? It's nothing fancy and has at most 10 fields, including a few custom types.
Setting serialization aside (just because I have a lot of reading to do on that topic), use of classes here also might be out of the question.
At this point, what are my options? Should I abandon records and try this with classes? Or would it be a lot less complicated just to stick to records and deal with the variant "limitation"? I'm all about learning and if exploding the class approach might make me smarter, I'll do it. I've also just looked into TList too (never used it), but it seems that it doesn't mix too well with records, well maybe it can be done, but that might be out of my league at the moment. I'm open to any kind of suggestions. What do i do?
You're conflating serialization with "writing everything to disk with a single BlockWrite call." You can serialize anything you want, regardless of whether it descends from TComponent or TPersistent.
Although writing everything with a single BlockWrite call looks convenient at first, you'll quickly find it's not really what you want if your desired record types are going to store anything particularly interesting (like strings, dynamic arrays, interfaces, objects, or other reference- or pointer-based types).
You'll probably also find variant records unsatisfying since you'll be coding to the lowest common denominator. You won't be able to access anything in the record without checking the actual contained type, and the size of even the smallest amount of data will occupy the same amount of space as the largest data type.
The question seems to describe polymorphism, so you may as well embrace what the language already provides for that. Use an array (or list, or any other container) of objects. Then you can use virtual methods to treat them all uniformly. You can implement dynamic dispatch for records if you want (e.g., give each record a function pointer that refers to a function that knows how to deal with that record's contained data type), but in the end you'll probably just find yourself reinventing classes.
The "natural" way of handling such data is to use a class, and not a record. It will be much easier to work with, both at definition time and when dealing with implementation: in particular, virtual methods are very powerful to customize a process for a particular kind of class. Then use a TList/TObjectList or a TCollection, or a generic-based array in newer versions of Delphi to store the list.
About serialization, there are several ways to do it. See Delphi: Store data in somekind of structure
In your particular case, the difficulty comes from the "variant" kind of record you are using. IMHO the main drawback is that the compiler will refuse to set any reference-counted kind of variable (e.g. a string) within the "variant" part. So you'll be able to write only "plain" variables (like integer) within this "variant" part. A big limitation IMHO, which reduces the interest of this solution.
Another possibility could be to store the kind of record at the beginning of its definition, e.g. with a RecType: integer or even better with a RecType: TEnumerationType which will be more explicit than a number. But you'll have to write a lot of code by hand, and works with pointers, which is a bit error-prone if you are not very fluent with pointer coding.
So you can also store the type information of the record, accessible via TypeInfo(aRecordVariable). Then you can use FillChar to initialize the record content to zero, just after allocation, then use the following function to finalize the record content, just after disallocation (this is what Dispose() does internally, and you shall call it, otherwise you'll leak memory):
procedure RecordClear(var Dest; TypeInfo: pointer);
asm
jmp System.#FinalizeRecord
end;
But such an implementation pattern will just reinvent the wheel! It is in fact how class is implemented: the first element of any TObject instance is a pointer to its ClassType:
function TObject.ClassType: TClass;
begin
Pointer(Result) := PPointer(Self)^;
end;
There is also another structure in Delphi, which is called object. It is some kind of record, but it supports inheritance - see this article. It is the old style of OOP programming in Turbo Pascal 5.5 days, deprecated, but still available. Note that I discovered a weird compilation issue on newer versions of Delphi: sometimes, an object allocated on the stack is not always initialized.
Take a look at our TDynArray wrapper and its associated functions, who is able to serialize any record content, into binary or JSON. See Delphi (win32) serialization libraries question. It will work with variant records, even if they include a string in their unvariant part, whereas a plain "Write/BlockWrite" won't work with reference counted fields.
To do this with records, you would create different record types that have a common field(s) in front, and then put those same field(s) in the generic record. Then you can simply type-cast a pointer to a generic record to a pointer to a specific record when needed. For example:
type
PGenericRec = ^GenericRec;
GenericRec = Record
RecType: Integer;
end;
PType1Rec = ^Type1Rec;
Type1Rec = Record
RecType: Integer;
// Type1Rec specific fields...
end;
PType2Rec = ^Type2Rec;
Type2Rec = Record
RecType: Integer;
// Type2Rec specific fields...
end;
PTypeNRec = ^TypeNRec;
TypeNRec = Record
RecType: Integer;
// TypeNRec specific fields...
end;
var
Recs: array of PGenericRec;
Rec1: PType1Rec;
Rec2: PType2Rec;
RecN: PTypeNRec;
I: Integer;
begin
SetLength(Recs, 3);
New(Rec1);
Rec1^.RecType := RecTypeForType1Rec;
// fill Rec1 fields ...
Recs[0] := PGenericRec(Rec1);
New(Rec2);
Rec2^.RecType := RecTypeForType2Rec;
// fill Rec2 fields ...
Recs[1] := PGenericRec(Rec2);
New(RecN);
Rec3^.RecType := RecTypeForTypeNRec;
// fill RecN fields ...
Recs[2] := PGenericRec(RecN);
for I := 0 to 2 do
begin
case Recs[I]^.RecType of
RecTypeForType1Rec: begin
Rec1 := PType1Rec(Recs[I]);
// use Rec1 as needed...
end;
RecTypeForType1Re2: begin
Rec2 := PType2Rec(Recs[I]);
// use Rec2 as needed...
end;
RecTypeForTypeNRec: begin
RecN := PTypeNRec(Recs[I]);
// use RecN as needed...
end;
end;
end;
for I := 0 to 2 do
begin
case Recs[I]^.RecType of
RecTypeForType1Rec: Dispose(PType1Rec(Recs[I]));
RecTypeForType2Rec: Dispose(PType2Rec(Recs[I]));
RecTypeForTypeNRec: Dispose(PTypeNRec(Recs[I]));
end;
end;
end;
As for serialization, you do not need TComponent for that. You can serialize records, you just have to do it manually. For writing, write out the RecType value first, then write out the record-specific values next. For reading, read the RecType value first, then create the appropriate record type for that value, then read the record-specific values into it.:
interface
type
PGenericRec = ^GenericRec;
GenericRec = Record
RecType: Integer;
end;
NewRecProc = procedure(var Rec: PGenericRec);
DisposeRecProc = procedure(Rec: PGenericRec);
ReadRecProc = procedure(Rec: PGenericRec);
WriteRecProc = procedure(const Rec: PGenericRec);
function NewRec(ARecType: Integer): PGenericRec;
procedure DisposeRec(var Rec: PGenericRec);
procedure ReadRec(Rec: PGenericRec);
procedure WriteRec(const Rec: PGenericRec);
procedure RegisterRecType(ARecType: Integer; ANewProc: NewRecProc; ADisposeProc: DisposeRecProc; AReadproc: ReadRecFunc; AWriteProc: WriteRecProc);
implementation
type
TRecTypeReg = record
RecType: Integer;
NewProc: NewRecProc;
DisposeProc: DisposeRecProc;
ReadProc: ReadRecProc;
WriteProc: WriteRecProc;
end;
var
RecTypes: array of TRecTypeReg;
function NewRec(ARecType: Integer): PGenericRec;
var
I: Integer;
begin
Result := nil;
for I = Low(RecTypes) to High(RecTypes) do
begin
with RecTypes[I] do
begin
if RecType = ARecType then
begin
NewProc(Result);
Exit;
end;
end;
end;
raise Exception.Create('RecType not registered');
end;
procedure DisposeRec(var Rec: PGenericRec);
var
I: Integer;
begin
for I = Low(RecTypes) to High(RecTypes) do
begin
with RecTypes[I] do
begin
if RecType = Rec^.RecType then
begin
DisposeProc(Rec);
Rec := nil;
Exit;
end;
end;
end;
raise Exception.Create('RecType not registered');
end;
procedure ReadRec(var Rec: PGenericRec);
var
LRecType: Integer;
I: Integer;
begin
Rec := nil;
LRecType := ReadInteger;
for I = Low(RecTypes) to High(RecTypes) do
begin
with RecTypes[I] do
begin
if RecType = LRecType then
begin
NewProc(Rec);
try
ReadProc(Rec);
except
DisposeProc(Rec);
raise;
end;
Exit;
end;
end;
end;
raise Exception.Create('RecType not registered');
end;
procedure WriteRec(const Rec: PGenericRec);
var
I: Integer;
begin
for I = Low(RecTypes) to High(RecTypes) do
begin
with RecTypes[I] do
begin
if RecType = Rec^.RecType then
begin
WriteInteger(Rec^.RecType);
WriteProc(Rec);
Exit;
end;
end;
end;
raise Exception.Create('RecType not registered');
end;
procedure RegisterRecType(ARecType: Integer; ANewProc: NewRecProc; ADisposeProc: DisposeRecProc; AReadproc: ReadRecFunc; AWriteProc: WriteRecProc);
begin
SetLength(RecTypes, Length(RecTypes)+1);
with RecTypes[High(RecTypes)] do
begin
RecType := ARecType;
NewProc := ANewProc;
DisposeProc := ADisposeProc;
ReadProc := AReadProc;
WriteProc := AWriteProc;
end;
end;
end.
.
type
PType1Rec = ^Type1Rec;
Type1Rec = Record
RecType: Integer;
Value: Integer;
end;
procedure NewRec1(var Rec: PGenericRec);
var
Rec1: PType1Rec;
begin
New(Rec1);
Rec1^.RecType := RecTypeForType1Rec;
Rec := PGenericRec(Rec1);
end;
procedure DisposeRec1(Rec: PGenericRec);
begin
Dispose(PType1Rec(Rec));
end;
procedure ReadRec1(Rec: PGenericRec);
begin
PType1Rec(Rec)^.Value := ReadInteger;
end;
procedure WriteRec1(const Rec: PGenericRec);
begin
WriteInteger(PType1Rec(Rec)^.Value);
end;
initialization
RegisterRecType(RecTypeForType1Rec, #NewRec1, #DisposeRec1, #ReadRec1, #WriteRec1);
.
type
PType2Rec = ^Type2Rec;
Type2Rec = Record
RecType: Integer;
Value: Boolean;
end;
procedure NewRec2(var Rec: PGenericRec);
var
Rec2: PType2Rec;
begin
New(Rec2);
Rec2^.RecType := RecTypeForType2Rec;
Rec := PGenericRec(Rec2);
end;
procedure DisposeRec2(Rec: PGenericRec);
begin
Dispose(PType2Rec(Rec));
end;
procedure ReadRec2(Rec: PGenericRec);
begin
PType2Rec(Rec)^.Value := ReadBoolean;
end;
procedure WriteRec2(const Rec: PGenericRec);
begin
WriteBoolean(PType2Rec(Rec)^.Value);
end;
initialization
RegisterRecType(RecTypeForType2Rec, #NewRec2, #DisposeRec2, #ReadRec2, #WriteRec2);
.
type
PTypeNRec = ^Type2Rec;
TypeNRec = Record
RecType: Integer;
Value: String;
end;
procedure NewRecN(var Rec: PGenericRec);
var
RecN: PTypeNRec;
begin
New(RecN);
RecN^.RecType := RecTypeForTypeNRec;
Rec := PGenericRec(RecN);
end;
procedure DisposeRecN(Rec: PGenericRec);
begin
Dispose(PTypeNRec(Rec));
end;
procedure ReadRecN(Rec: PGenericRec);
begin
PTypeNRec(Rec)^.Value := ReadString;
end;
procedure WriteRecN(const Rec: PGenericRec);
begin
WriteString(PTypeNRec(Rec)^.Value);
end;
initialization
RegisterRecType(RecTypeForTypeNRec, #NewRecN, #DisposeRecN, #ReadRecN, #WriteRecN);
.
var
Recs: array of PGenericRec;
procedure CreateRecs;
begin
SetLength(Recs, 3);
NewRec1(Recs[0]);
PRecType1(Recs[0])^.Value : ...;
NewRec2(Recs[1]);
PRecType2(Recs[1])^.Value : ...;
NewRecN(Recs[2]);
PRecTypeN(Recs[2])^.Value : ...;
end;
procedure DisposeRecs;
begin
for I := 0 to High(Recs) do
DisposeRec(Recs[I]);
SetLength(Recs, 0);
end;
procedure SaveRecs;
var
I: Integer;
begin
WriteInteger(Length(Recs));
for I := 0 to High(Recs) do
WriteRec(Recs[I]);
end;
procedure LoadRecs;
var
I: Integer;
begin
DisposeRecs;
SetLength(Recs, ReadInteger);
for I := 0 to High(Recs) do
ReadRec(Recs[I]);
end;

Simple read/write record .dat file in Delphi

For some reason my OpenID account no longer exists even when I used it yesterday. But anyway.
I need to save record data into a .dat file. I tried a lot of searching, but it was all related to databases and BLOB things. I wasn't able to construct anything from it.
I have the following record
type
Scores = record
name: string[50];
score: integer;
end;
var rank: array[1..3] of scores;
I just need a simple way of saving and reading the record data from a .dat file. I had the book on how to do it, but that's at school.
You should also take a look at the file of-method.
This is kinda out-dated, but it's a nice way to learn how to work with files.
Since records with dynamic arrays (including ordinary strings) can't be stored to files with this method, unicode strings will not be supported. But string[50] is based on ShortStrings and your record is therefore already non-unicode...
Write to file
var
i: Integer;
myFile: File of TScores;
begin
AssignFile(myFile,'Rank.dat');
Rewrite(myFile);
try
for i := 1 to 3 do
Write(myFile, Rank[i]);
finally
CloseFile(myFile);
end;
end;
Read from file
var
i: Integer;
Scores: TScores;
myFile: File of TScores;
begin
AssignFile(myFile, 'Rank.dat');
Reset(myFile);
try
i := 1;
while not EOF(myFile) do
begin
Read(myFile, Scores);
Rank[i] := Scores; //You will get an error if i is out of the array bounds. I.e. more than 3
Inc(i);
end;
finally
CloseFile(myFile);
end;
end;
Use streams. Here is a simple demo (just demo - in practice there is no need to reopen file stream every time):
type
Scores = record
name: string[50];
score: integer;
end;
var rank: array[1..3] of scores;
procedure WriteScores(var Buf; Count: Integer);
var
Stream: TStream;
begin
Stream:= TFileStream.Create('test.dat', fmCreate);
try
Stream.WriteBuffer(Buf, SizeOf(Scores) * Count);
finally
Stream.Free;
end;
end;
procedure ReadScore(var Buf; Index: Integer);
var
Stream: TStream;
begin
Stream:= TFileStream.Create('test.dat', fmOpenRead or fmShareDenyWrite);
try
Stream.Position:= Index * SizeOf(Scores);
Stream.ReadBuffer(Buf, SizeOf(Scores));
finally
Stream.Free;
end;
end;
// write rank[1..3] to test.dat
procedure TForm1.Button1Click(Sender: TObject);
begin
rank[2].name:= '123';
WriteScores(rank, Length(Rank));
end;
// read rank[2] from test.dat
procedure TForm1.Button2Click(Sender: TObject);
begin
rank[2].name:= '';
ReadScore(rank[2], 2 - Low(rank));
ShowMessage(rank[2].name);
end;
Look in the help under "blockread" and or "blockwrite". There probably will be an example

Resources