1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
ПОМОГИТЕ ПОЖАЛУЙСТА ДОДЕЛАТЬ ПРОГРАММУ. Вот собственно код :
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).
только вот дело в том что программа ,если только с первым условием , удаляет все отрицательные элементы, а если с двумя условиями то просто не удаляет ни чего.
подскажите пожалуйста что мне исправить что бы оно делало все правильно.