Mega Code Archive
How to use a in-memory table using linked lists of records
<![CDATA[
(*
What's in it?
The zip file contains an example of a simple in-memory table of names.
Creation, sorting and destruction are demonstrated.
What version of Delphi?
It's written in D6, but should compile on any version of Delphi.
You may have to redo the form due to DFM incompatability.
Who cares?Anyone who wants to use an old-school method of making very fast datasets in memory.
*)
unit Unit1;
interface
//-------------------------UNIT1.PAS--------------------------------------
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TMyObjectPtr = ^TMyObject;
TMyObject = record
First_Name: string[20];
Last_Name: string[20];
Next: TMyObjectPtr;
end;
type
TForm1 = class(TForm)
bSortByLastName: TButton;
bDisplay: TButton;
bPopulate: TButton;
ListBox1: TListBox;
bClear: TButton;
procedure bSortByLastNameClick(Sender: TObject);
procedure bPopulateClick(Sender: TObject);
procedure bDisplayClick(Sender: TObject);
procedure bClearClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
pStartOfList: TMyObjectPtr = nil;
procedure SortMyObjectListByLastName(var aStartOfList: TMyObjectPtr);
function CreateMyObject(aFirstName, aLastName: string): TMyObjectPtr;
procedure AppendMyObject(var aCurrentItem, aNewItem: TMyObjectPtr);
procedure ClearMyObjectList(var aMyObject: TMyObjectPtr);
procedure RemoveMyObject(var aStartOfList, aRemoveMe: TMyObjectPtr);
function AreInAlphaOrder(aString1, aString2: string): Boolean;
implementation
{$R *.DFM}
procedure TForm1.bClearClick(Sender: TObject);
begin
ClearMyObjectList(pStartOfList);
end;
procedure TForm1.bPopulateClick(Sender: TObject);
var
pNew: TMyObjectPtr;
begin
pNew := CreateMyObject('Suzy','Martinez');
AppendMyObject(pStartOfList, pNew);
pNew := CreateMyObject('John','Sanchez');
AppendMyObject(pStartOfList, pNew);
pNew := CreateMyObject('Mike','Rodriguez');
AppendMyObject(pStartOfList, pNew);
pNew := CreateMyObject('Mary','Sosa');
AppendMyObject(pStartOfList, pNew);
pNew := CreateMyObject('Betty','Hayek');
AppendMyObject(pStartOfList, pNew);
pNew := CreateMyObject('Luke','Smith');
AppendMyObject(pStartOfList, pNew);
pNew := CreateMyObject('John','Sosa');
AppendMyObject(pStartOfList, pNew);
end;
procedure TForm1.bSortByLastNameClick(Sender: TObject);
begin
SortMyObjectListByLastName(pStartOfList);
end;
procedure TForm1.bDisplayClick(Sender: TObject);
var
pTemp: TMyObjectPtr;
begin
ListBox1.Items.Clear;
pTemp := pStartOfList;
while pTemp <> nil do
begin
ListBox1.Items.Add(pTemp^.Last_Name + ', ' + pTemp.First_Name);
pTemp := pTemp^.Next;
end;
end;
procedure ClearMyObjectList(var aMyObject: TMyObjectPtr);
var
TempMyObject: TMyObjectPtr;
begin
TempMyObject := aMyObject;
while aMyObject <> nil do
begin
aMyObject := aMyObject^.Next;
Dispose(TempMyObject);
TempMyObject := aMyObject;
end;
end;
function CreateMyObject(aFirstName, aLastName: string): TMyObjectPtr;
begin
new(result);
result^.First_Name := aFirstName;
result^.Last_Name := aLastName;
result^.Next := nil;
end;
procedure SortMyObjectListByLastName(var aStartOfList: TMyObjectPtr);
var
aSortedListStart, aSearch, aBest: TMyObjectPtr;
begin
aSortedListStart := nil;
while (aStartOfList <> nil) do
begin
aSearch := aStartOfList;
aBest := aSearch;
while aSearch^.Next <> nil do
begin
if not AreInAlphaOrder(aBest^.Last_Name, aSearch^.Last_Name) then
aBest := aSearch;
aSearch := aSearch^.Next;
end;
RemoveMyObject(aStartOfList, aBest);
AppendMyObject(aSortedListStart, aBest);
end;
aStartOfList := aSortedListStart;
end;
procedure AppendMyObject(var aCurrentItem, aNewItem: TMyObjectPtr);
begin
if aCurrentItem = nil then
aCurrentItem := aNewItem
else
AppendMyObject(aCurrentItem^.Next, aNewItem);
end;
procedure RemoveMyObject(var aStartOfList, aRemoveMe: TMyObjectPtr);
var
pTemp: TMyObjectPtr;
begin
pTemp := aStartOfList;
if pTemp = aRemoveMe then
aStartOfList := aStartOfList^.Next
else
begin
while (pTemp^.Next <> aRemoveMe) and (pTemp^.Next <> nil) do
pTemp := pTemp^.Next;
if pTemp = nil then Exit; //Shouldn't ever happen
if pTemp^.Next = nil then Exit; //Shouldn't ever happen
pTemp^.Next := aRemoveMe^.Next;
end;
aRemoveMe^.Next := nil;
end;
function AreInAlphaOrder(aString1, aString2: string): Boolean;
var
i: Integer;
begin
Result := True;
while Length(aString2) < Length(aString1) do aString2 := aString2 + '!';
while Length(aString1) < Length(aString2) do aString1 := aString1 + '!';
for i := 1 to Length(aString1) do
begin
if aString1[i] > aString2[i] then Result := False;
if aString1[i] <> aString2[i] then break;
end;
end;
end.
//-------------------------UNIT1.DFM--------------------------------------
object Form1: TForm1
Left = 334
Top = 198
Width = 374
Height = 329
Caption = 'Linked List Example'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object bSortByLastName: TButton
Left = 4
Top = 63
Width = 125
Height = 25
Caption = 'Sort List by Last Name'
TabOrder = 0
OnClick = bSortByLastNameClick
end
object bDisplay: TButton
Left = 28
Top = 89
Width = 75
Height = 25
Caption = 'Display List'
TabOrder = 1
OnClick = bDisplayClick
end
object bPopulate: TButton
Left = 4
Top = 37
Width = 125
Height = 25
Caption = 'Populate List'
TabOrder = 2
OnClick = bPopulateClick
end
object ListBox1: TListBox
Left = 146
Top = 12
Width = 179
Height = 235
ItemHeight = 13
TabOrder = 3
end
object bClear: TButton
Left = 4
Top = 11
Width = 125
Height = 25
Caption = 'Clear List'
TabOrder = 4
OnClick = bClearClick
end
end
]]>