Preface
Goal: An object oriented approach to collect unique record fields using Free Pascal.
This idea of article section is simply to utilize TList,
or to be exact, we are going to use the lighter TFPList.
Classes
In order to do this, We are going to use three more classes, And one additional helper unit:
-
TSongListBase class, in MySongListBase unit.
-
TSongList2 class, in MySongList2 unit (using array)
-
TSongList3 class, in MySongList3 unit (using TStringList).
-
ImportMySongs procedure, in MySongHelper unit.
9: Base Class
The base class is rather text book. And actually, I copy paste most part, from official documentation.
Using TFPList
The TFPList hold list of object.
We require to define the object first,
such as song record.
And we also setup the pointer type.
type
PSong=^TSong;
TSong = record
...
end;This way we use list instead of array.
MySongListBase Interface
The code can be shown as below:
{$mode objfpc}{$H+}
unit MySongListBase;
interface
uses Classes, SysUtils;
type
TTags = array of string;
PSong=^TSong;
TSong = record
Title : string;
Tags : TTags;
end;
TSongListBase Class
The object pascal part is always a fun to write. I mean I can get the overview clearly in Pascal. Get the structured well in interface. And bother with implementation later.
Using the T prefix is not mandatory.
It might comes from the Turbo Pascal era.
But I rather call it the.
So now we have the song list base class, as below.
type
TSongListBase = class(TFPList)
protected
function Get(Index: integer): PSong;
public
destructor Destroy; override;
function Add(ASong : PSong): integer;
property Items[Index: integer]: PSong read Get; default;
end;
MySongListBase Implementation
The implementation is, of course longer than the interface.
implementation
function TSongListBase.Get(Index: integer): PSong;
begin
Result := PSong(inherited Get(Index));
end;
function TSongListBase.Add(ASong: PSong): integer;
begin
Result := inherited Add(ASong);
end;And do not forget the Destructor.
destructor TSongListBase.Destroy;
var I : integer;
begin
for I := 0 to Count-1 do begin
Dispose(Items[I]);
end;
inherited Destroy;
end;
end.
Using MySongListBase
What good is it of making a class, without ever use it? Here we are with the example.
Declare everything as usual,
we need the source MySongs array as well,
just to fill the object.
uses MySongListBase, MySongs;
var
TS: TSongListBase;
ASong : PSong;
Song : MySongs.TSong;Create the TSongListBase object,
and fill the list.
begin
TS := TSongListBase.create;
for Song in Songs do begin
ASong := new(PSong);
ASong^ := MySongListBase.TSong(Song);
TS.Add(ASong);
end;
WriteLn(TS[2]^.Title);
TS.Free;
end.With the result similar as below:
❯ ./21-tfplist-a
Knockin' on Heaven's Door
10: Helper Unit
Since we are going to fill the object, multiple times in different code, it is a good idea to separate it, into its own unit.
MySongsHelper Interface
The code can be shown as below:
unit MySongsHelper;
interface
uses MySongListBase, MySongs;
procedure ImportMySongs(
Songs: array of MySongs.TSong;
TS: TSongListBase);
MySongsHelper Implementation
While the ImportMySongs lies in the implementation part.
implementation
procedure ImportMySongs(...);
var ...
begin ... end;
end.With the complete procedure as below:
procedure ImportMySongs(
Songs: array of MySongs.TSong;
TS: TSongListBase);
var
ASong : PSong;
Song : MySongs.TSong;
begin
for Song in Songs do
begin
ASong := new(PSong);
ASong^ := MySongListBase.TSong(Song);
TS.Add(ASong);
end;
end;
Using MySongsHelper
Now our code can be shorter.
Do not forget to include our helper unit.
uses MySongListBase, MySongs, MySongsHelper;Then just use it in main program entry point.
var TS: TSongListBase;
begin
TS := TSongListBase.create;
ImportMySongs(MySongs.Songs, TS);
WriteLn(TS[2]^.Title);
TS.Free;
end.With the result exactly the same as previous example:
❯ ./21-tfplist-b
Knockin' on Heaven's Door
11: Descendant Class: Using Array
We have two approach, using either array and TStringList. Consider start with array.
MySongList2 Interface
The idea is just make a child class.
Note that this is just an example. You can gather base class and child class at once, put all the method and property in just one class, instead of separated class.
{$mode objfpc}
unit MySongList2;
interface
uses Classes, SysUtils, MySongListBase;
type
TSongList2 = class(TSongListBase)
private ...
public ...
end;TSongList2 Class
The overview of song list child class is, as below:
type
TSongList2 = class(TSongListBase)
private
function GetTags(Index: integer): TTags;
public
function GetAllTags(): TTags;
function GetUniqueTags(): TTags;
property ItemsTags[Index: integer]: TTags read GetTags;
end;
MySongList2 Implementation
The implementation contains three methods.
function TSongList2.GetTags(Index: integer): TTags;
begin
Result := Get(Index)^.Tags;
end;
function TSongList2.GetAllTags(): TTags;
var ASong : PSong;
begin
Result := [];
for ASong in Self do
System.Insert(
ASong^.Tags, Result, High(Result)+1);
end;
The last method, get the unique tags,
using previous GetAllTags method.
function TSongList2.GetUniqueTags(): TTags;
var
Unique: TTags = ();
Tag, Uni : string;
Exist : boolean;
begin
for Tag in GetAllTags() do
begin
Exist := false;
for Uni in Unique do
if (Tag = Uni) then Exist := true;
if (not Exist) then
System.Insert(Tag, Unique, High(Unique)+1);
end;
Result := Unique;
end;
Using MySongList2
Consider to see the object in action.
Declare everything as usual, pay attention to the uses clause. This take longer, required a few dependencies.
{$mode objFPC}
uses
SysUtils, MySongs, MySongsHelper,
MySongListBase, MySongList2;
var
TS: TSongList2;
SA : TStringArray;
Create the TSongList2 object,
fill the list, and test every method.
begin
TS := TSongList2.create;
ImportMySongs(Songs, TS);
WriteLn(TS[2]^.Title);
writeLn(TS.ItemsTags[1][0]);
SA := TS.GetAllTags();
WriteLn(ANSIString.Join(', ', SA));
WriteLn(ANSIString.Join(
', ', TS.GetUniqueTags));
TS.Free;
end.The result would be similar as below:
❯ ./22-tfplist
Knockin' on Heaven's Door
60s
60s, jazz, 60s, rock, 70s, rock, 70s, pop
60s, jazz, rock, 70s, pop
12: Descendant Class: TStringList
Consider the second approach,
using TStringList instead of array.
MySongList3 Interface
TSongList3 Class
This should be simpler, only consist of one method.
The overview of song list class child is, as below:
{$mode objfpc}
unit MySongList3;
interface
uses Classes, SysUtils, MySongListBase;
type
TSongList3 = class(TSongListBase)
public
function GetUniqueTags(): TTags;
end;
MySongList3 Implementation
The implementation only consist one method.
function TSongList3.GetUniqueTags(): TTags;
var
SL : TStringList;
ASong : PSong;
Tag : ANSIString;
begin
SL := TStringList.Create;
SL.Duplicates := dupIgnore;
SL.Sorted := true;
for ASong in Self do
for Tag in ASong^.Tags do
SL.Add(Tag);
Result := SL.ToStringArray(0, Count-1);
SL.Free;
end;
This should be self explanatory.
Using MySongList3
Have a look at the object in action.
Declare everything as usual, pay attention to the uses clause. This take longer, required a few dependencies.
{$mode objFPC}
uses
SysUtils, MySongs, MySongsHelper,
MySongListBase, MySongList3;
var
TS: TSongList3;Create the TSongList3 object,
fill the list, and the only one method.
begin
TS := TSongList3.create;
ImportMySongs(Songs, TS);
WriteLn(ANSIString.Join(
', ', TS.GetUniqueTags));
TS.Free;
end.The result would be similar as below:
❯ ./23-tfplist
60s, 70s, jazz, pop, rock
Now your code is clean. Much shorter.
What is Next 🤔?
We are going to continue to concurrency in Free Pascal.
Consider continue reading [ Pascal - Playing with Records - Part Five ].