img
00:00
imgDRKB online - Linked List Memory Table
imgimgimg
  Общие вопросы
  Delphi IDE, компиллятор, отладчик, редактор
  Язык программирования Дельфи
  Общие вопросы
  Объектное ориентирование
  Работа со строками
  Работа с датами и временем
  Работа с числами
  Работа с битами
  Работа с массивами
  Работа с указателями, память
  Арифметика указателей
  Использование указателей на целое
  Как избежать использования неактуальных указателей
  Пример работы с указателями
  Получение ссылки на экземпляр класса
  Method pointers --> function pointers
  Быстрое сравнение памяти
  Динамическое распределение памяти
  StrAlloc и GetMem
  Освобождение памяти
  Очистить переменную в оперативной памяти
  Получение размера памяти выделенный под Pointer
  Потеря памяти
  Принципы работы с памятью в системе Windows32
  Linked List Memory Table
  Увеличение значения указателя
  Указатель на вариантный тип
  Указатель на функцию
  Функции для выделения, перераспределения и освобождения памяти
  Множества, записи и перечисляемые типы
  RTTI и другие трюки с информацией о классах, модулях и т.п.
  Взаимодействие с другими языками
  Threads
  Работа с коллекциями
  RTL Delphi (краткий справочник)
  Базовые классы
  Скрипты, компилляторы и связанные с ними вопросы
  Вокруг и около Паскаля или другие компилляторы Дельфи/Паскаль
  VCL
  Системные функции и WinAPI
  Базы данных
  Работа с файловой системой
  Репортинг, работа с принтером
  Работа с сетью, интернетом, протоколами
  Работа с графикой и мультимедиа
  Математика, алгоритмы
  Форматы файлов, данных. Конвертация форматов
  ActiveX, COM, DCOM, MIDAS, CORBA, интерфейсы, OLE, DDE
  Разработка приложений
  Kylix
  Delphi.Net
  Развлечения
  
  [drkb=334] Комментариев: 0 
Linked List Memory Table

delphi
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];
     : 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^.;
   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^.;
     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^. := 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^. <> nil do
     begin
       if not AreInAlphaOrder(aBest^.Last_Name, aSearch^.Last_Name) then
         aBest := aSearch;
       aSearch := aSearch^.;
     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^., 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^.
   else
   begin
     while (pTemp^. <> aRemoveMe) and (pTemp^. <> nil) do
       pTemp := pTemp^.;
     if pTemp = nil then Exit; //Shouldn't ever happen
    if pTemp^. = nil then Exit; //Shouldn't ever happen
    pTemp^. := aRemoveMe^.;
   end;
   aRemoveMe^. := 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
Количество статей: 4366
 
Вход
Имя:
Пароль:
Запомнить
Регистрация Забыли пароль?
Мини-чат :)
Необходима регистрация
Архив мини-чата
11-10-2019 10:05
Programmer
А может быть он просто тоже сидит в десксофте
10-10-2019 10:44
antonn
Есть французская певица "Kareen Antonn", может ее трек скачал smiley
09-10-2019 03:46
Bact
У моего брата в загрузках есть файл с именем antonn, может ли быть это совпадением?
09-10-2019 03:37
Bact
есть кто? :0
03-10-2019 14:20
antonn
Примерно как гостевую книгу, только рисуется на всех страницах.
02-10-2019 19:09
Programmer
антонн, как ты сделал чат?
02-10-2019 19:09
Programmer
есть
15-09-2019 18:55
Expendobrooo
Есть кто живой?
15-09-2019 17:36
Programmer
сайт сдох smiley
29-08-2019 22:11
Zoom
ПРивет Привет
Статистика
 СегодняВсего
Посетителей1932106815
Запросов19558323712304
Online
Пользователей0
Гостей39
imgimgimgimg
 
img
     00:00