Linked List Memory Table

=== Linked List Memory Table ===
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.
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00829