Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Динамический список 3

unit dlist3_;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

type
  TPStudent = ^TStudent; //указатель на тип TStudent

  TStudent = record
    f_name: string[20]; // фамилия
    l_name: string[20]; // имя
    next: TPStudent; // следующий элемент списка
  end;

var
  head: TPStudent; // начало (голова) списка

procedure TForm1.Button1Click(Sender: TObject);
var
  node: TPStudent; // новый узел списка
  curr: TPStudent; // текущий узел списка
  pre: TPStudent; // предыдущий, относительно curr, узел
begin
  new(node); // создание нового элемента списка
  node^.f_name := Edit1.Text;
  node^.l_name := Edit2.Text;
   // добавление узла в список
   // сначала найдем подходящее место в списке для узла
  curr := head;
  pre := nil;
   { Внимание!
     если приведенное ниже условие заменить
     на (node.f_name>curr^.f_name)and(curr<>NIL)
     то при добавлении первого узла возникает ошибка времени
     выполнения, так как curr = NIL и, следовательно,
     переменной curr.^name нет!
     В используемом варианте условия ошибка не возникает, так как
     сначала проверяется условие (curr <> NIL), значение которого
     FALSE и второе условие в этом случае не проверяется.
   }
  while (curr <> nil) and (node.f_name > curr^.f_name) do
  begin
     // введенное значение больше текущего
    pre := curr;
    curr := curr^.next; // к следующему узлу
  end;
  if pre = nil
    then
  begin
          // новый узел в начало списка
    node^.next := head;
    head := node;
  end
  else
  begin
          // новый узел после pre, перед curr
    node^.next := pre^.next;
    pre^.next := node;
  end;

  Edit1.text := '';
  Edit2.text := '';
  Edit1.SetFocus;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  curr: TPStudent; // текущий элемент списка
  n: integer; // длина (кол-во элементов) списка
  st: string; // строковое представление списка
begin
  n := 0;
  st := '';
  curr := head;
  while curr <> nil do
  begin
    n := n + 1;
    st := st + curr^.f_name + ' ' + curr^.l_name + #13;
    curr := curr^.next;
  end;
  if n <> 0
    then ShowMessage('Список:' + #13 + st)
  else ShowMessage('В списке нет элементов.');
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  head := nil;
end;

// щелчок на кнопке Удалить

procedure TForm1.Button3Click(Sender: TObject);
var
  curr: TPStudent; // текущий, проверяемый узел
  pre: TPStudent; // предыдущий узел
  found: boolean; // TRUE - узел, который надо удалить, есть в списке

begin
  if head = nil then
  begin
    MessageDlg('Список пустой!', mtError, [mbOk], 0);
    Exit;
  end;
  curr := head; // текущий узел - первый узел
  pre := nil; // предыдущего узла нет
  found := FALSE;

  // найти узел, который надо удалить
  while (curr <> nil) and (not found) do
  begin
    if (curr^.f_name = Edit1.Text) and (curr^.l_name = Edit2.Text)
      then found := TRUE // нужный узел найден
    else // к следующему узлу
    begin
      pre := curr;
      curr := curr^.next;
    end;
  end;
  if found then
  begin
            // нужный узел найден
    if MessageDlg('Узел будет удален из списка!',
      mtWarning, [mbOk, mbCancel], 0) <> mrYes
      then Exit;

            // удаляем узел
    if pre = nil
      then head := curr^.next // удаляем первый узел списка
    else pre^.next := curr.next;
    Dispose(curr);
    MessageDlg('Узел' + #13 +
      'Имя:' + Edit1.Text + #13 +
      'Фамилия:' + Edit2.Text + #13 +
      'удален из списка.',
      mtInformation, [mbOk], 0);
  end
  else // узла, который надо удалить, в списке нет
    MessageDlg('Узел' + #13 +
      'Имя:' + Edit1.Text + #13 +
      'Фамилия:' + Edit2.Text + #13 +
      'в списке не найден.',
      mtError, [mbOk], 0);
  Edit1.Text := '';
  Edit1.Text := '';
  Edit1.SetFocus;
end;


end.
Скачать весь проект
Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay