Реализация Linked List Memory Table
Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch
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 .
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Реализация Linked List Memory Table", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:
Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи , в сообщение обязательно указывайте название или ссылку на статью!