Линейные списки - Pascal (247572)

program Spisok;
 
type
  oc = record
    mat, ist, fiz: byte;
  end;
  tabl = record
    fam, im, ot: string[128];
    o: oc;
  end;
  Tinf = tabl;{тип данных, который будет храниться в элементе списка}
  List = ^TList;{Указатель на элемент типа TList}
  TList = record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data: TInf;  {данные, хранимые в элементе}
    next: List;   {указатель на следующий элемент списка}
  end;
 
{Процедура добавления нового элемента в односвязный список}
procedure AddElem(var spis1: List; znach1: TInf);
var
  tmp: List;
begin
  if spis1 = nil then {Проверяем не пуст ли список, если пуст, то }
  begin
    New(spis1);
    tmp := spis1;
  end
  else {в случае если список не пуст}
  begin
    tmp := spis1;
    while tmp^.next <> nil do
      tmp := tmp^.next; {ставим tmp на последний элемент списка}
    New(tmp^.next);
    tmp := tmp^.next;   {переносим tmp на новый элемент}
  end;
  tmp^.next := nil; {зануляем указатель}
  tmp^.data := znach1; {заносим значение}
end;
 
{процедура печати списка
полностью расписана при работе со стеком}
procedure Print(spis1: List);
begin
  if spis1 = nil then
  begin
    writeln('Список пуст.');
    exit;
  end;
  while spis1 <> nil do
  begin
    Write(spis1^.data, ' ');
    spis1 := spis1^.next
  end;
end;
 
{процедура удаления списка
 полностью расписана при работе со стеком}
procedure FreeStek(spis1: List);
var
  tmp: List;
begin
  while spis1 <> nil do
  begin
    tmp := spis1;
    spis1 := spis1^.next;
    Dispose(tmp);
  end;
end;
 
{процедура поиска в списке
 полностью расписана при работе со стеком}
function SearchElemZnach(spis1: List; znach1: TInf): List;
begin
  if spis1 <> nil then
    while (Spis1 <> nil) and (znach1 <> spis1^.data) do
      spis1 := spis1^.next;
  SearchElemZnach := spis1;
end;
 
{процедура удаления элемента
 полностью расписана при работе со стеком}
procedure DelElem(var spis1: List; tmp: List);
var
  tmpi: List;
begin
  if (spis1 = nil) or (tmp = nil) then
    exit;
  if tmp = spis1 then
  begin
    spis1 := tmp^.next;
    Dispose(tmp);
  end
  else
  begin
    tmpi := spis1;
    while tmpi^.next <> tmp do
      tmpi := tmpi^.next;
    tmpi^.next := tmp^.next;
    Dispose(tmp);
  end;
end;
 
{процедура удаления элемента по значению
 полностью расписана при работе со стеком}
procedure DelElemZnach(var Spis1: List; znach1: TInf);
var
  tmp: List;
begin
  if Spis1 = nil then
  begin
    Writeln('Список пуст');
    exit;
  end;
  tmp := SearchElemZnach(spis1, znach1);
  if tmp = nil then
  begin
    writeln('Элемент с искомым значением ', znach1, ' отсутствует в списке.');
    exit;
  end;
  DelElem(spis1, tmp);
  Writeln('Элемент удалён.');
end;
 
{процедура удаления элемента по позиции
 полностью расписана при работе со стеком}
procedure DelElemPos(var spis1: List; posi: integer);
var
  i: integer;
  tmp: List;
begin
  if posi < 1 then
    exit;
  if spis1 = nil then
  begin
    Write('Список пуст');
    exit
  end;
  i := 1;
  tmp := spis1;
  while (tmp <> nil) and (i <> posi) do
  begin
    tmp := tmp^.next;
    inc(i)
  end;
  if tmp = nil then
  begin
    Writeln('Элемента с порядковым номером ', posi, ' нет в списке.');
    writeln('В списке всего ', i - 1, ' элемента(ов).');
    exit
  end;
  DelElem(spis1, tmp);
  Writeln('Элемент удалён.');
end;
 
 
 
var
  Spis, tmpl: List;
  znach: tabl;
  n, i: integer;
  f: file of tabl;
 
begin
  Spis := nil;
  assign(f, 'data.dat');
  rewrite(f);
  write('Введите количество добавляемых элементов: ');
  readln(n);
  writeln('Введите значения добавляемых элементов: ');
  for i := 1 to n do
  begin
    write('Введите фамилию: ');
    readln(znach.fam);
    write('Введите имя: ');
    readln(znach.im);
    write('Введите отчество: ');
    readln(znach.ot);
    write('Введите оценку по математике: ');
    readln(znach.o.mat);
    write('Введите оценку по истории: ');
    readln(znach.o.ist);
    write('Введите оценку по физике: ');
    readln(znach.o.fiz);
    AddElem(Spis, znach);
    write(f, znach);
  end;
  close(f);
  writeln('Данные в файл записаны успешно.');
  
  Spis := nil;
  reset(f);
  while not eof(f) do
  begin
    read(f, znach);
    AddElem(Spis, znach);
  end;
  close(f);
  writeln('Данные из файла:');
  Print(Spis);
  writeln;
  Write('Введите порядковый номер удаляемого элемента: ');
  readln(n);
  DelElemPos(Spis, n);
  Print(Spis);
  FreeStek(Spis);
end.