Курсач, тема: линейные списки - Delphi - Ответ 3461889

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, Dialogs;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    Memo3: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
type
  //Тип основных данных списка.
  TData = record
    Name, Desc : String;
  end;
  //Тип указателя на элемент списка.
  TPElem = ^TElem;
  //Тип элемента списка.
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
  //Тип, описывающий однонаправленный список.
  TDynList = record
    PFirst : TPElem; //Указатель на первый элемент списка.
    PLast : TPElem; //Указатель на последний элемент списка.
  end;
 
var
  gList : TDynList;
 
//Процедуры для работы со списком.
 
//Инициализация списка. Внимание! Эту процедуру можно выполнять только
//в отношении пустого списка. Иначе - будут утечки памяти.
procedure Init(var aList : TDynList);
begin
  aList.PFirst := nil;
  aList.PLast := nil;
end;
 
//Добавление элемента в конец однонаправленного списка.
procedure AddL(var aList : TDynList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := PElem
  else
    aList.PLast^.PNext := PElem;
  aList.PLast := PElem;
end;
 
//Удаление однонаправленного списка из памяти и инициализация.
procedure ListFree(var aList : TDynList);
var
  PNext, PDel : TPElem;
begin
  if aList.PFirst = nil then Exit;
 
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;
 
//Распечатка однонаправленного списка.
function ListToStr(const aList : TDynList) : String;
var
  PElem : TPElem;
  i : Integer;
begin
  Result := '';
  if aList.PFirst = nil then begin
    Result := 'Список пуст.';
    Exit;
  end;
 
  PElem := aList.PFirst;
  i := 0;
  while PElem <> nil do begin
    Inc(i);
    if i > 1 then Result := Result + #13#10'-----'#13#10;
    Result := Result + PElem^.Data.Name + #13#10 + PElem^.Data.Desc;
    PElem := PElem^.PNext;
  end;
end;
 
//Поиск элемента в списке. Поиск производится по значению aName.
function FindElem(const aList : TDynList; const aName : String; var aData : TData) : Boolean;
var
  PElem : TPElem;
  S : String;
begin
  Result := False;
  S := AnsiUpperCase(aName);
  PElem := aList.PFirst;
  while PElem <> nil do begin
    if AnsiUpperCase(PElem^.Data.Name) = S then begin
      aData := PElem^.Data;
      Result := True;
      Break;
    end;
    PElem := PElem^.PNext; //Переход к следующему элементу списка.
  end;
end;
 
//Обработчики нажатий кнопок на форме.
 
//Добавление элемента в список.
procedure TForm1.Button1Click(Sender: TObject);
var
  Data : TData;
begin
  Data.Name := Edit1.Text;
  Data.Desc := Memo1.Text;
  AddL(gList, Data);
end;
 
//Поиск элемента в списке.
procedure TForm1.Button2Click(Sender: TObject);
var
  Data : TData;
begin
  Memo2.Clear;
  if FindElem(gList, Edit2.Text, Data) then
    Memo2.Text := Data.Desc
  else
    ShowMessage('Элемент не найден.');
end;
 
//Распечатка всего списка в Мемо3.
procedure TForm1.Button3Click(Sender: TObject);
begin
  Memo3.Text := ListToStr(gList);
end;
 
//Удаление списка из памяти (очистка списка).
procedure TForm1.Button4Click(Sender: TObject);
begin
  ListFree(gList);
  ShowMessage('Список удалён из памяти.');
end;
 
initialization
  //Инициализация списка в начале работы.
  Init(gList);
 
finalization
  //Удаление списка из памяти в конце работы.
  ListFree(gList);
 
end.