Динамическая структура данных: списки в Делфи

[rublyabachka]

Задание: Удалить из неупорядоченного списка все элементы с четными значениями ключей.
Написала программу на Делфи, но она почему-то падает, когда ввожу несколько четных ключей или когда ключ является последним. Не учла еще несколько вариантов ввода четных ключей, потому что думаю, что надо сначала в этом разобраться... Подскажите пожалуйста в чем ошибка... когда прохожу пошагово, то пропускается выполнение некоторых строк и сразу идет на конец=((
Прилагаю архив с проектом. Заранее спасибо!
На всякий случай код:

program list;
{программа удаляет из неупорядоченного списка все элементы с четными значениями ключей}
{$APPTYPE CONSOLE}
uses
  SysUtils,  CRT32, Windows;
type
  u=^zap;
  zap=record {структура элемента списка}
    inf: integer;
    ukz: u;
  end;
var
  PSP: u; {указатель списка}
  ch: char;
  n, s: integer;
  fl: boolean;
function RC(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  AnsiToOemBuff(@S[1], @Result[1], Length(S));
end;
procedure create_list(var PSP: u);
{создание неупорядоченного списка}
var q, {указатель предыдущего элемента списка}
    p: u; {указатель текущего элемента списка}
  ch: char;
begin
  n:=0; s:=0;
  new(q);
  writeln(RC('Введите информационное поле элемента'));
  readln(q^.inf);
  psp:=q; {указатель списка(адрес первого элемента)}
  writeln(RC('Продолжить ввод? y/n'));
  ch:=readkey;
  while ch in ['y','Y','Н','н'] do
  begin
    new(p);
    writeln(RC('Введите информационное поле элемента'));
    readln(p^.inf);
    n:=n+1;
    if p^.inf mod 2=0 then
      s:=s+1;
    q^.ukz:=p;
    q:=p;
    writeln(RC('Продолжить ввод? y/n'));
    ch:=readkey;
  end;
  q^.ukz:=nil;
end;
procedure print_list(PSP: u);
{печать элементов списка}
var t: u;
begin
  if psp=nil then
  begin
    writeln(RC('Список пуст!'));
    readkey;
    exit;
  end;
  writeln(RC('Содержимое списка:'));
  t:=psp;
  while t<>nil do
  begin
    write(t^.inf,' --> ');
    t:=t^.ukz;
  end;
  writeln(RC('NIL'));
  writeln(RC('Нажмите любую клавишу'));
  readkey;
end;
procedure destroy_list(var psp: u);
{освобождение памяти, занятой элементами списка}
var t: u;
begin
  while psp<>nil do
  begin
    t:=psp;
    psp:=psp^.ukz;
    dispose(t); {освобождение памяти}
  end;
end;
procedure del_elem(var psp: u; var fl: boolean);
{удаление элементов с четными значениями ключей}
var q, p: u;
begin
  if psp=nil then
  begin
    writeln(RC('Список пуст!'));
    readkey;
    exit;
  end;
  if fl then
  begin
    destroy_list(psp);
    exit;
  end;
  if (psp^.inf mod 2)=0 then {проверка ключа на четность}
  begin
    q:=psp;
    psp:=psp^.ukz;
    dispose(q); {освобождение памяти}
  end;
  p:=psp;
  while p^.ukz<>nil do
  begin   
    q:=p;
    p:=p^.ukz;
    if (p^.inf mod 2)=0 then {проверка ключа на четность}
    begin
      q^.ukz:=p^.ukz;
      dispose(p); {освобождение памяти}
    end;
    if (p^.ukz^.ukz=nil) and (p^.ukz^.inf mod 2 =0) then
    begin
      q:=p;
      p^.ukz:=nil;
      dispose(q);
    end;
  end;
end;
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
  psp:=nil;
  repeat
    clrscr;
    writeln(RC('1 - Создать список'));
    writeln(RC('2 - Просмотреть список'));
    writeln(RC('3 - Удалить все четные ключи'));
    writeln(RC('4 - Удалить список'));
    writeln(RC('----------------------------'));
    writeln(RC('0 - Выход'));
    writeln;
    writeln(RC('Ваш выбор: '));
    ch:=readkey;
    writeln(RC(ch));
    writeln;
    case ch of
      '1': begin
            psp:=nil;
            create_list(psp);
           end;
      '2': print_list(psp);
      '3':begin
            if n=s then
              fl:=true
            else fl:=false;
            del_elem(psp,fl);
            writeln(RC('Нажмите любую клавишу'));
            readkey;
           end;
      '4': begin
            destroy_list(psp);
            writeln(RC('Список удалён!'));
            readkey;
           end;
    end;
    until ch='0';
end.

[Stilet]

А почему список не двунаправленный?
Если нет то рекомендую сделать в списке поле - атрибут удаленности скажем типа Boolean. Удаленные элементы не освобождаются физически, а просто помечаются. Потом элементы с пометкой просто игнорировать при выводе или обработки.

[rublyabachka]

да боюсь, что преподша зафэйлит тогда. если не удалять элемент...
а как это двунаправленный список??? чтоб голова была в начале и в конце что-ли???

[eoln]

Слишком усложнённо. Можно обойтись без счётчиков чётных чисел. Достаточно изменить процедуру удаления чётных элементов на следующую

procedure del_elem(var psp: u);
{удаление элементов с четными значениями ключей}
var q, p, prev: u;
begin
  if psp=nil then
  begin
    writeln(RC('Список пуст!'));
    readkey;
    exit;
  end;

  p:=psp;
  prev := p;//предыдущий нечётный элемент в начале итерации может быть и чётным, 
  //но это не важно, т.к. он либо измениться либо не понадобится, т.е. это всего лишь инициализация - привычка такая :) 
  while p<>nil do
  begin
    if (p^.inf mod 2)=0 then {проверка ключа на четность}
    begin
      q := p;
      if psp = p then psp := psp^.ukz else //если первый элемент, то начало списка подкорректируем
        if p^.ukz = nil then prev^.ukz := nil else //если последний элемент - то меняем конец
          prev^.ukz := p^.ukz;//если в середине - то связи "перепрыгивают" через удаляемый элемент
      p:=p^.ukz;
      dispose(q); {освобождение памяти}
      continue
    end;
    prev := p;//запомним предыдущий нечётный элемент
    p:=p^.ukz;
  end;
end;

А в самой программе вызывать её как

      '3':begin
            del_elem(psp);
            writeln(RC('Нажмите любую клавишу'));
            readkey;
           end;

На счёт двунаправленного списка согласен, в этом случае освободимся от запоминания предыдущего

[rublyabachka]

отлично работает!! спасибо огромное =))

[Stilet]

Вам сюда, сударыня:
http://www.programmersforum.ru/showthread.php?t=87357
http://www.programmersforum.ru/showp...8&postcount=25

[rublyabachka]

Спасибо большое)) Первая ссылка действительно полезна, ну а вторая - с реализацией на Си проблем не возникало=))

[Stilet]

Это я просто переборщил )