Mega Code Archive
Implement a linked list memory table
<![CDATA[
unit Unit1;
interface
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;
{List manipulation routines}
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
{Initialize the list with some static data}
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
{Display the list items}
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
{Free the memory used by the list items}
TempMyObject := aMyObject;
while aMyObject <> nil do
begin
aMyObject := aMyObject^.Next;
Dispose(TempMyObject);
TempMyObject := aMyObject;
end;
end;
function CreateMyObject(aFirstName, aLastName: String): TMyObjectPtr;
begin
{Instantiate a new list item}
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
{Sort the list by the Last_Name "field"}
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
{Recursive function that appends the new item to the end of the list}
if aCurrentItem = nil then
aCurrentItem := aNewItem
else
AppendMyObject(aCurrentItem^.Next, aNewItem);
end;
procedure RemoveMyObject(var aStartOfList, aRemoveMe: TMyObjectPtr);
var
pTemp: TMyObjectPtr;
begin
{Removes a specific item from the list and collapses the empty spot.}
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
{Returns True if aString1 should come before aString2 in an alphabetic ascending sort}
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.
]]>