Главная страницаОбратная связьКарта сайта

Реализация 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", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!
   


Copyright © 2008 - 2024 Дискета.info