Delphi World - Реализация Linked List Memory Table
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Реализация 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.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования