
P.S. думаю что тема-вопрос про такого рода задания уже была, но меня интересует именно почему удаление из памяти не делается. Буду благодарен если мне кто нибудь поможет найти причину)

Вот код программы
Код
program hw_1;
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.
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.
вот еще прикрепил файл с этой программой.