Вот собственно код :
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).
только вот дело в том что программа ,если только с первым условием , удаляет все отрицательные элементы, а если с двумя условиями то просто не удаляет ни чего.
подскажите пожалуйста что мне исправить что бы оно делало все правильно.