Недавно добавленные исходники

•  TDictionary Custom Sort  3 227

•  Fast Watermark Sources  2 992

•  3D Designer  4 751

•  Sik Screen Capture  3 259

•  Patch Maker  3 467

•  Айболит (remote control)  3 528

•  ListBox Drag & Drop  2 904

•  Доска для игры Реверси  80 793

•  Графические эффекты  3 843

•  Рисование по маске  3 172

•  Перетаскивание изображений  2 544

•  Canvas Drawing  2 674

•  Рисование Луны  2 501

•  Поворот изображения  2 094

•  Рисование стержней  2 121

•  Paint on Shape  1 525

•  Генератор кроссвордов  2 183

•  Головоломка Paletto  1 731

•  Теорема Монжа об окружностях  2 158

•  Пазл Numbrix  1 649

•  Заборы и коммивояжеры  2 017

•  Игра HIP  1 262

•  Игра Go (Го)  1 201

•  Симулятор лифта  1 425

•  Программа укладки плитки  1 178

•  Генератор лабиринта  1 512

•  Проверка числового ввода  1 297

•  HEX View  1 466

•  Физический маятник  1 322

•  Задача коммивояжера  1 357

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Реализация Linked List Memory Table



Оформил: DeeCo

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.




Похожие по теме исходники

BDE Errors List

Userlist

FTP Lister

MODlist

 

Word List 1.5

Integers List

Sort in ListView

CheckListBox Draw

 

ProgressBar in ListView

Memory Manager

Shared Memory

Numbers Memory

 

Memory Monitor

Memory Using in System

Simple Memory Seeker

Process Memory Map

 

MemoryStream Write-Read

BTMemoryModule

Create Table in Runtime

Transfer Tables Excel-Access

 

Multiplication Table




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте