Работа со списками

[vladis222]

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

program spiski;
{Óäàëèòü èç ñïèñêà 2 ýëåìåíòà,ñòîÿùèå ïåðåä ïîñëåäíèì ýëåìåíòîì ñïèñêà}
{$APPTYPE CONSOLE}

uses
  SysUtils,CRT32;
type u=^zap;
     zap=record
            inf:Integer;
            ukz:u;
          end;
var PSP:u; {Óêàçàòåëü ñïèñêà}
     ch:Char;

procedure Create_list(Var PSP:U);
Var Q,
    P:U;
    Ch:Char;
Begin
      New(Q);
      Write('Vvedite inform.pole elementa :  ');
      Readln(Q^.Inf);
      PSP:=Q;
      Write('Prodoljit'' vvod ? y/n ');
      Readln(ch);
      while Ch in ['y','Y','í','Í'] do
      begin
        New(P);
        Write('Vvedite inform.pole elementa :  ');
        Readln(P^.INF);
        Q^.ukz:=P;
        Q:=P;
        Write('Prodoljit'' vvod? y/n ');
        Readln(ch);
      end;
      Q^.ukz:=nil;
end;


procedure print_list(PSP:u);
var t:u;
 begin
  if PSP=nil then
   begin
      Writeln('Spisok pust');
      Readkey;
      Exit;
   end;
  Writeln('Soderjimoe spiska: ');
  t:=PSP;
  while t<>nil do
   begin
    write(t^.inf,'--> ');
    t:=t^.ukz;
   end;
  Writeln('NIL');
  Writeln('Najmite ljubuju klavishu');
  ReadKey;
 end;

procedure del_chnode (var PSP:U);{удаление четных элементов}
var Q,P:U;
Begin
P:=PSP;
Q:=P;
 while(P^.Ukz<>nil) do
   Begin
     //Q:=P;
       if (Q^.inf mod 2 =0) then
         begin
           if (Q=PSP) then
             begin
               //Q:=PSP;
               PSP:=Q^.ukz;
               Dispose(Q);
             end;
            Q^.ukz:=P^.ukz;
            Dispose(Q);
            P:=P^.ukz;
            Writeln('Chetnye elementy udaleni!!!');
         end
   End
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;



begin
  PSP:=nil;
 repeat
    ClrScr;
    Writeln('1.Sozdat'' spisok ');
    Writeln('2.Prosmotret'' spisok');
    Writeln('3.Udalit'' 2 elementa spiska,stojashih pered poslednim');
    Writeln('4.Udalit'' spisok');
    Writeln('-------------------------------------------------------');
    Writeln('0.Vihod');
    Writeln;
    write('Vash vibor: ');
    ch:=ReadKey;
    Writeln(ch);
    Writeln;
    case ch of
     '1': begin
            psp:=nil;
            Create_list(PSP);
          end;
     '2':print_list(PSP);
     '3': del_chnode(PSP);
     '4': begin
             destroy_list(PSP);
             Writeln('Spisok udalyon');
             ReadKey;
          end;
    end;
 until ch='0';
end.

[VIK_aka_TOR]

procedure del_chnode (var PSP:U);{удаление четных элементов}
var Q,P,n:U;
Begin
P:=PSP;
Q:=nil;
 while(P <> nil) do
   Begin
       if p^.inf mod 2 = 0 then
        begin
          if p = psp then
            begin
              psp := p^.ukz;
              q := p;
              p := psp;
              Dispose(q);
              q := nil;
            end
          else
            begin
              n := p;
              p := p^.ukz;
              q^.ukz := p;
              dispose(n);
              n := nil;
            end;
        end
       else
        begin
          if (q = nil) and (p = psp) then
            begin
              q := psp;
              p := p^.ukz;
            end
          else
            if (q^.ukz = p) then
              begin
                q := p;
                p := p^.ukz;
              end;
        end;
   End ;
  Writeln('Chetnye elementy udaleni!!!');
end;

p.s. подправте свою "менюшку" пункт 3.
p.p.s. порекомендовал бы еще перед созданием нового списка удалять старый, если был создан. Иначе память "засоряется".