Кольцевые Двусвязные Списки Опции

[ikorstenxl]

ПОМОГИТЕ ПОЖАЛУЙСТА ДОДЕЛАТЬ ПРОГРАММУ.
Вот собственно код :

Program Kursach;
uses
  crt;
type
  Tinf=integer;
  List=^TList;
  TList=record
    data:TInf;
    next : list;
    prev : list;
  end;

{=====================================Creation of Spisok====================================}
procedure AddElem(var first:List;znach1:TInf);
var
  tmp,tmp1:List;
begin
  if first=nil then
  begin
    Getmem(first,SizeOf(TList));
    first^.next:=first;
    tmp:=first;
  end
  else
  begin
    tmp:=first;
    while tmp^.next<>first do
      tmp:=tmp^.next;
    GetMem(tmp1,SizeOf(Tlist));
    tmp1^.next:=first;
    tmp^.next:=tmp1;
    tmp:=tmp1;
  end;
  tmp^.data:=znach1;
end;

{====================================Printing of Spisok=====================================}
procedure Print(spis1:List);
var
  first:List;
begin
  if spis1=nil then
  begin
    writeln('Please add a new element');
    exit;
  end;
  first:=spis1;
  Write(spis1^.data, ' ');
  spis1:=spis1^.next;
  while spis1<>first do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next;
  end;
end;
{==================================Clearing all Spisok======================================}
Procedure FreeStek(spis1:List);
var
  tmp,first:List;
begin
  if spis1=nil then
    exit;
  first:=spis1;
  tmp:=spis1;
  spis1:=spis1^.next;
  dispose(tmp);
  while spis1<>first do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;
  {===============================================================================
===========}
Procedure DelElem(var spis1:List;tmp:List);
var
  tmpi:List;
begin
  if tmp=spis1 then
  begin
    tmpi:=tmp;
    while tmpi^.next<>spis1 do
      tmpi:=tmpi^.next;
    if tmpi=spis1 then
    begin
      spis1^.next:=nil;
      dispose(spis1);
      spis1:=nil
    end
    else
    begin
      tmpi^.next:=tmp^.next;
      spis1:=spis1^.next;
      dispose(tmp)
    end;
  end
  else
  begin
    tmpi:=spis1;
    while tmpi^.next<>tmp do
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next;
    dispose(tmp);
  end;
end;
 {=============================Deleting the element of Spisok===============================}
procedure DelElemZnach(var Spis1:List;znach1:TInf);
var
  tmp:List;
begin
  tmp:=spis1;

  
    if tmp^.data < 0 then                                                                    {!!!}
        if tmp^.next^.data = tmp^.prev^.data then 
  begin
    DelElem(spis1,tmp);
    exit;
  end;
  tmp:=tmp^.next;
  while tmp<>spis1 do
  begin


       if tmp^.data < 0 then                                                                  {!!!}
      if tmp^.prev^.data = tmp^.next^.data then 
    begin
      DelElem(spis1,tmp);
      exit
    end;
    tmp:=tmp^.next;
  end;
end;
{=================================Menu of Program========================================================}
var
  SpisNach,
  tmpl:List;
  znach,a,b:integer;
  ch:char;
begin
  SpisNach:=nil;
  repeat
    clrscr;
    textcolor(1);
    writeln('                     ======================================');
    writeln('                     ===                                ===');
    writeln('                     ===                                ===');
      write('                     ===');
    TextColor(4);
      Write('             WELCOME!!!');
    textcolor(1);
    writeln('         ===');
    writeln('                     ===                                ===');
    writeln('                     ===                                ===');
      write('                     ===');
    TextColor(5);
      Write('            "Circle List"');
    textcolor(1);
    writeln('       ===');
    writeln('                     ===                                ===');
    writeln('                     ===                                ===');
    writeln('                     ======================================');
    TextColor(6);
    writeln;
    writeln;
    writeln;
    writeln;
    Writeln('                           Choose the right action :');
    TextColor(7);
    writeln;
    writeln;
    Writeln('                            1) Add a new Element .');
    writeln;
    Writeln('                            2) Show the List .');
    writeln;
    Writeln('                            3) Delete the Element .');
    writeln;
    Writeln('                            4) Exit .');
    writeln;
    ch:=readkey;
    case ch of
      '1':begin
            write('Enter value of new Element  : ');
            readln(znach);
            AddElem(SpisNach,znach);
          end;
      '2':begin
            clrscr;
            Print(SpisNach);
            readkey;
          end;
      '3':begin
       DelElemZnach(SpisNach);
          end;

    end;
    until ch='4';
    freestek(spisnach);
end.

Как вы могли понять программа добавляет новый элемент в кольцевой двусвязный список, выводит на экран список,и чистит его при выходе из программы. еще есть процедура которая удаляет элементы по условию :
1) if tmp^.data < 0 then - то бишь отрицательный элемент списка,
а должно быть два условия :
1)...
2) if tmp^.prev^.data = tmp^.next^.data then - отрицательный элемент который находить между двумя одинаковыми (1 -2 1 - удалить -2).

только вот дело в том что программа ,если только с первым условием , удаляет все отрицательные элементы, а если с двумя условиями то просто не удаляет ни чего.

подскажите пожалуйста что мне исправить что бы оно делало все правильно.

[ikorstenxl]

уважаемый volvo, спасибо большое за совет, я разобрался и в итоге написал новую процедуру для создания списка и теперь функция для удаления элемента ,которую написали вы, и она работает - УРА!
но я все же что то напутал в создании списка, почему то постоянно первый элемент списка всегда присваевает ноль и я чет не могу сообразить почему, вот так выглядит процедура :

procedure AddElem(var first:List; znach1 : tinf);
var
    tmp,tmp1:List;
begin
if first=nil then
    begin
        Getmem(first,SizeOf(TList));
        first^.next:=first;
        tmp:=first;
    end
else
    begin
        tmp:=first;
        while tmp^.next<>first do
            tmp:=tmp^.next;
            GetMem(tmp1,SizeOf(Tlist));
            tmp1^.next:=tmp^.next;
            tmp1^.prev:=tmp;
            tmp1^.next^.prev := tmp1;
            tmp^.next:= tmp1;
            tmp1^.data:=znach1;
    end;
end;

не могли бы вы глянуть что я не так написал?
спасибо

Добавлено через 4 мин.
я на всякий пожарный еще прикрепил всю программу

Сообщение отредактировано: ikorstenxl - 26.05.2010 12:07