Исключение указанного и следующего за ним элементов в списке - Pascal

Формулировка задачи:

Не получается дописать две процедуры, одна удаляет указанный элемент, а другая удаляет элемент, следующий за ним Вот собственно сами процедуры, а файл с кодом полной программы будет ниже

procedure Exception(var l: tList);//исключение указанного эл.
var
   p, q: tPtr;
   k, i: integer;
begin
   writeln( 'Номер удаляемого элемента: ' ); readln(k);
    if NotEmpty(l)  then begin
       if k <= Counter(l) then begin
          new (q);
          p := l;
          for i := 1 to k do
             p := p^.next;
             Drop(p);
          WriteList(l);
        end
        else
           writeln('Элемента с таким номером не существует');
        end
     else
        Error( 'Список пуст' );
end;
 
procedure ExcFoll(var l: tList);// исключение эл., следующего за данным
var
   p, q: tPtr;
   k, i: integer;
begin
   writeln( 'Номер удаляемого элемента: ' ); readln(k);
      if NotEmpty(l)  then begin
       if k <= Counter(l) then begin
          new (q);
          p := l;
          for i := 1 to k - 1 do
             p := p^.next;
         q^.next := p^.next;
         p^.next := q;
          Drop(p);
          WriteList(p);
        end
        else
           writeln('Элемента с таким номером не существует');
        end
     else
        Error( 'Список пуст' );
end;

program list;
 
type
   tData = integer;
   
   tPtr = ^tNode;
   
   tNode = record
      data: tData;
      next: tPtr;
      prev: tPtr;
   end;
   
   tList = tPtr;
 
var
   key: integer;//пункт меню
   l: tList;
 
procedure Error(message: string);//выдача сообщения об ошибке
begin
   writeln('*** Ошибка: ' + message );
   writeln;
end;
 
procedure Init(var l: tList);//инициализация  списка
begin
   l := nil;
end;
 
function NotEmpty(l: tList): Boolean;//список не пуст
begin
   NotEmpty := l <> nil;
end;
 
procedure Put(var l: tList; D: tData);
var
   p{, p1}: tPtr;
begin
   new(p);
   p^.data := D;
   p^.next := l;
   l := p;
   //p^.prev := p1;
end;
 
procedure Drop(var l: tList);//удалить элемент
var
   p{, p1}: tPtr;
begin
   p := l;
   l := l^.next;
  { p1 := l;
   l := l^.prev;}
   Dispose(p);
end;
 
procedure Clear(var l: tList);//очистка
begin
   while NotEmpty(l) do
      Drop(l);
end;
 
procedure WriteList(var l: tList);
var
   p: tPtr;
begin
   p := l;
   while p <> nil do 
   begin
      write(p^.data, ' ');
      p := p^.next;
   end;
end;
 
procedure Fill(var l: tList);//заполнить список
var
   x: tData;
begin
   Clear(l);
   writeln( 'Вводите элементы(целые числа) по одному' );
   writeln( 'Конец ввода - 0' );
   repeat
      write( '? ' ); readln(x);
      if x <> 0 then
         Put(l, x);
   until x = 0;
end;
 
function Counter(l: tList): integer;//счетчик числа элементов
var
   p: tPtr;
   n: integer;
begin
   n := 0;
   p := l;
   while p <> nil do 
   begin
      n := n + 1;
      p := p^.next;
   end;
   Counter := n;
end;
 
procedure CountList(l: tList);//подсчитать число элементов
begin
   writeln( 'Число элементов в списке равно ', Counter(l) );
end;
 
procedure Add1(var l: tList);//включение эл. после указанного
var
   i, k: integer;
   q, p: tPtr;
   D: tData;
begin
   writeln( 'Номер элемента: ' ); readln(k);
   if k <= Counter(l) then begin
      new(q);
      writeln( 'Задайте значение элемента: ' ); readln(q^.data);
      p := l;
      for i := 1 to k - 1 do 
         p := p^.next;
      q^.next := p^.next;
      p^.next := q;
      WriteList(l);
   end
   else 
      writeln('Элемента с таким номером не существует');
end;
 
procedure Add2(var l: tList);//включение эл. перед указанным
var
   q, p: tPtr;
   i, k: integer;
begin
   writeln( 'Номер элемента: ' ); readln(k);
   if k <= Counter(l) then begin
      new(q);
      writeln( 'Задайте значение элемента: ' ); readln(q^.data);
      if k = 1 then begin
         q^.next := l;
         l := q;
         WriteList(l)
      end
      else begin
         p := l;
         for i := 1 to k - 2 do
            p := p^.next;
         q^.next := p^.next;
         p^.next := q;
         WriteList(l);
      end
   end
   else 
      writeln('Элемента с таким номером не существует');
end;
 
procedure Exception(var l: tList);//исключение указанного эл., доделать
var
   p, q: tPtr;
   k, i: integer;
begin
   writeln( 'Номер удаляемого элемента: ' ); readln(k);
    if NotEmpty(l)  then begin
       if k <= Counter(l) then begin
          new (q);
          p := l;
          for i := 1 to k do
             p := p^.next;
             Drop(p);
          WriteList(l);
        end
        else
           writeln('Элемента с таким номером не существует');
        end
     else
        Error( 'Список пуст' );
end;
 
procedure ExcFoll(var l: tList);// исключение эл., следующего за данным
var
   p, q: tPtr;
   k, i: integer;
begin
   writeln( 'Номер удаляемого элемента: ' ); readln(k);
      if NotEmpty(l)  then begin
       if k <= Counter(l) then begin
          new (q);
          p := l;
          for i := 1 to k - 1 do
             p := p^.next;
         q^.next := p^.next;
         p^.next := q;
          Drop(p);
          WriteList(p);
        end
        else
           writeln('Элемента с таким номером не существует');
        end
     else
        Error( 'Список пуст' );
end;
 
procedure ShowMenu;//показать меню
begin
   writeln( 'Операции с двунаправленным списком ' );
   writeln( '-------------------------------' );
   writeln( '1 - Заполнение         2 - Очистка ' );
   writeln( '3 - Вывод на экран   4 - Число элементов ' );
   writeln( '5 - Включение элемента после указанного' );
   writeln( '6 - Включение элемента перед указанным ' );
   writeln( '7 - Исключение указанного элемента ' );
   writeln( '8 - Исключение элемента, следующего за указанным ' );
   writeln( '0 - Выход ' );
   writeln( 'Выберите нужный пункт ' );
end;

begin
   Init(l);
   ShowMenu;
   repeat
      writeln;
      write( '>' );
      readln(key);
      case key of
         1: Fill(l); //заполнить список
         2: Clear(l); //очистить
         3: WriteList(l); //напечатать
         4: CountList(l); //подсчитать число элементов
         5: Add1(l); //включение эл. после указанного
         6: Add2(l); //включение эл. перед указанным
         7: Exception(l); //исключение указанного эл.
         8: ExcFoll(l); //исключение эл., следующего за указанным
         0:             {Пусто};
      else
         ShowMenu;
      end;
   until key = 0;
end.

Решение задачи: «Исключение указанного и следующего за ним элементов в списке»

textual
                            Листинг программы 
                        

                            type
   tData = integer;
   
   tPtr = ^tNode;
   tNode = record
      data: tData;
      next: tPtr;
      prev: tPtr;
   end;
   
   tList = tPtr;
 
procedure WhiteEnter;
begin 
  Write('Нажмите Enter для возврата в основное меню...'); ReadLn;
end;
 
procedure Error(message: string);//выдача сообщения об ошибке
begin
   writeln('*** Ошибка: ' + message );
   writeln;
end;
 
procedure Init(var l: tList);//инициализация  списка
begin
   l := nil;
end;
 
function NotEmpty(l: tList): Boolean;//список не пуст
begin
   NotEmpty := l <> nil;
end;
 
function GetTail(l : tList) : tList; // Получить хвост списка
begin
  if l <> nil then
    while l^.next <> nil do
      l := l^.next;
  GetTail := l;
end;
 
function NewElem(D : tData; prev, next : tList) : tList; // Вставить новый элемент
var
  p : tList;
begin
  New(p);
  p^.data := D;
  p^.prev := prev;
  p^.next := next;
  NewElem := p;
end;
 
procedure Put(var l: tList; D: tData);
var
  p: tPtr;
begin
  p := GetTail(l); // Получить хвост
  if p = nil then
    l := NewElem(D, nil, nil) // Это начало
  else
    p^.next := NewElem(D, p, nil); // Это новый хвост
end;
 
procedure ClearAll(var l: tList);
var
  p : tList;
begin
  while l <> nil do
    begin
      p := l;
      l := l^.next;
      Dispose(p);
    end;
end;
 
procedure Clear(var l: tList);//очистка
begin
  ClearAll(l);
  WriteLn('Список очищен.');
  WhiteEnter;
end;
 
procedure WriteList(l: tList);
var n : Integer;
begin
  n := 0;
  Write('Список:');
  if l = nil then
    Write(' пусто')
  else
    while l <> nil do 
      begin
        inc(n);
        write(' (', n, ') ', l^.data);
        l := l^.next;
      end;
  WriteLn('.');
  WhiteEnter;
end;
 
procedure Fill(var l: tList);//заполнить список
var
   x: tData;
begin
  ClearAll(l);
  writeln( 'Вводите элементы(целые числа) по одному' );
  writeln( 'Конец ввода - 0' );
  repeat
     write( '? ' ); readln(x);
     if x <> 0 then
       Put(l, x);
  until x = 0;
  WriteLn('Ввод элементов завершен.'); WhiteEnter;
end;
 
function Counter(l: tList): integer;//счетчик числа элементов
var
   n: integer;
begin
  n := 0;
  while l <> nil do 
    begin
      n := n + 1;
      l := l^.next;
    end;
  Counter := n;
end;
 
procedure CountList(l: tList);//подсчитать число элементов
begin
  writeln( 'Число элементов в списке равно ', Counter(l) );
  WhiteEnter;
end;
 
function GetElemByNumber(l : tList; n : Integer) : tList; // Вернуть n элемент от l
// Подразумевается, что элемент с номером n точно есть в списке!
begin
  while n > 1 do
    begin
      Dec(n);
      l := l^.next;
    end;
  GetElemByNumber := l;
end;
 
procedure Add1(var l: tList);//включение эл. после указанного
var
  i, k: integer;
  p: tPtr;
  D: tData;
begin
  if l = nil then
    WriteLn('Список пуст. Операция не возможна!')
  else
    begin
      i := Counter(l);
      write( 'Номер элемента (от 1 до ', i, '): ' ); readln(k);
      if (k<1)or(k>i) then
        WriteLn('Неверный номер элемента')
      else
        begin
          Write( 'Задайте значение элемента: ' ); readln(D);
          p := GetElemByNumber(l, k); // Получим по номеру
          p^.next := NewElem(D, p, p^.next); // За ним вставим новый
          if p^.next^.next <> nil then p^.next^.next^.prev := p^.next; // Исправим ссылочку
          WriteLn('После элемента (', k, ') ', p^.data, ' вставлен элемент ', D);
        end;
    end;  
  WhiteEnter;
end;
 
procedure Add2(var l: tList);//включение эл. перед указанным
var
  i, k: integer;
  p: tPtr;
  D: tData;
begin
  if l = nil then
    WriteLn('Список пуст. Операция не возможна!')
  else
    begin
      i := Counter(l);
      write( 'Номер элемента (от 1 до ', i, '): ' ); readln(k);
      if (k<1)or(k>i) then
        WriteLn('Неверный номер элемента')
      else
        begin
          Write( 'Задайте значение элемента: ' ); readln(D);
          p := GetElemByNumber(l, k); // Получим по номеру
          p^.prev := NewElem(D, p^.prev, p); // После него вставим новый
          if p^.prev^.prev <> nil then p^.prev^.prev^.next := p^.prev; // Исправим ссылочку
          if k = 1 then l := p^.prev; // А может это теперь голова списка
          WriteLn('Перед элементом (', k, ') ', p^.data, ' вставлен элемент ', D);
        end;
    end;  
  WhiteEnter;
end;
 
procedure DeleteElem(var l, p : tList);
var t : tList;
begin
  if p = l then // это голова
    begin
      l := l^.next; l^.prev := nil;
    end
  else if p^.next = nil then // это хвост
    begin
      t := p^.prev; t^.next := nil;
    end
  else // это где-то по середине
    begin
      t := p^.prev;
      t^.next := p^.next;
      t^.next^.prev := t;
    end;
  Dispose(p);
end;
 
procedure Exception(var l: tList);//исключение указанного эл.
var
  i : Integer;
  p : tPtr;
begin
  if l = nil then
    WriteLn('Список пуст. Операция не возможна!')
  else
    begin
      i := Counter(l);
      write( 'Номер элемента (от 1 до ', i, '): ' ); readln(k);
      if (k<1)or(k>i) then
        WriteLn('Неверный номер элемента')
      else
        begin
          p := GetElemByNumber(l, k); // Получим по номеру
          DeleteElem(l, p); // Удалим его
          WriteLn('Элемент ', k, ' удален.');
        end;
    end;  
  WhiteEnter;
end;
 
 
procedure ExcFoll(var l: tList);// исключение эл., следующего за данным
var
  i : Integer;
  p : tPtr;
begin
  if l = nil then
    WriteLn('Список пуст. Операция не возможна!')
  else
    begin
      i := Counter(l);
      write( 'Номер элемента (от 1 до ', i-1, '): ' ); readln(k);
      if (k<1)or(k>i-1) then
        WriteLn('Неверный номер элемента')
      else
        begin
          p := GetElemByNumber(l, k); // Получим по номеру
          DeleteElem(l, p^.next); // Удалим следующий
          WriteLn('Элемент ', k, ' удален.');
        end;
    end;  
  WhiteEnter;
end;
 
procedure ShowMenu;//показать меню
begin
   writeln( 'Операции с двунаправленным списком ' );
   writeln( '-------------------------------' );
   writeln( '1 - Заполнение         2 - Очистка ' );
   writeln( '3 - Вывод на экран   4 - Число элементов ' );
   writeln( '5 - Включение элемента после указанного' );
   writeln( '6 - Включение элемента перед указанным ' );
   writeln( '7 - Исключение указанного элемента ' );
   writeln( '8 - Исключение элемента, следующего за указанным ' );
   writeln( '0 - Выход ' );
   writeln( 'Выберите нужный пункт ' );
end;
 
var
   key: integer;//пункт меню
   l: tList;
begin
  Init(l);
  repeat
    writeln;
    ShowMenu;
    write( '>' );
    readln(key);
    case key of
      1: Fill(l); //заполнить список
      2: Clear(l); //очистить
      3: WriteList(l); //напечатать
      4: CountList(l); //подсчитать число элементов
      5: Add1(l); //включение эл. после указанного
      6: Add2(l); //включение эл. перед указанным
      7: Exception(l); //исключение указанного эл.
      8: ExcFoll(l); //исключение эл., следующего за указанным
      0:             {Пусто};
    end;
  until key = 0;
end.
                        