Linked List Memory Table |
Previous Top Next |
Code: |
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. |
©Drkb::00829
Взято с сайта: http://www.swissdelphicenter.ch