![smile.gif](style_emoticons/default/smile.gif)
P.S. думаю что тема-вопрос про такого рода задания уже была, но меня интересует именно почему удаление из памяти не делается. Буду благодарен если мне кто нибудь поможет найти причину)
![yes2.gif](style_emoticons/default/yes2.gif)
Вот код программы
uses crt;
type
PItem=^TItem;
TItem=record
Data:integer;
Prev:PItem;
end;
var
P:PItem;
Head:PItem;
fl:text;
procedure CreateSame;
var Pnew:PItem;
Curr:PItem;
begin
Curr:=Head;
while Curr<>nil do begin
if Curr^.Data<0 then begin
new(Pnew);
Pnew^.Prev:=Curr^.Prev;
Pnew^.Data:=Abs(Curr^.Data);
Curr^.Prev:=Pnew;
end;
Curr:=Curr^.Prev;
end;
end;
procedure DeleteNeg;
var
Del:PItem;
Save:PItem;
Curr:PItem;
begin
Curr:=Head;
While (Head^.Data<0) and (Head<>nil) do
begin
Curr:=Head;
Head:=Head^.Prev;
Dispose(Curr);
end;
Save:=Head;
Curr:=Head^.Prev;
while Curr<>nil do begin
if Curr^.Data>0 then
Save:=Curr
else
begin
Save^.Prev:=Curr^.Prev;
Del:=Curr;
{Dispose(Del);}
end;
Curr:=Curr^.Prev;
end;
end;
procedure ShowList;
var Curr:PItem;
begin
TextColor(15);
Curr:=Head;
while Curr<>nil do begin
write(Curr^.Data,' ');
Curr:=Curr^.Prev;
end;
end;
procedure CheckList;
begin
CreateSame;
writeln;
Textcolor(5);
writeln('‘®§¤ л а ўлҐ Ї® ¬®¤г«о ®ваЁж ⥫мл¬');
ShowList;
DeleteNeg;
end;
procedure MakeList;
begin
Head:=nil;
While not (EOF(fl)) do begin
new(P);
readln(fl,P^.Data);
if Head<>nil then P^.Prev:=Head
else P^.Prev:=nil;
Head:=P;
end;{while}
end;
Begin
ClrScr;
Assign(fl,'HW_1.txt');
{$I-}
reset(fl);
{$I+}
if IOResult=0 then begin
MakeList;
TextColor(5);
writeln('?бе®¤л© бЇЁб®Є');
ShowList;
CheckList;
end
else writeln('ЋиЁЎЄ ®вЄалвЁп д ©« ');
writeln;
TextColor(5);
writeln('ЏаҐ®Ўа §®ў л© бЇЁб®Є');
ShowList;
readln;
readln;
end.
вот еще прикрепил файл с этой программой.
Сообщение отредактировано: mr. -