вот пара процедур. требуются остальные особенно с перемещением по списку не представляю как делать
| Код | procedure AddNewNode(var p:Dlist; info:integer);
var
q, pp:Dlist;
i, k:integer;
begin
if p = nil then begin
New(q);
writeln ('vvedite info:');
readln(info);
q^.info :=info;
q^.next := q;
q^.prev := q;
p := q;
end
else begin
writeln('vvedite k:');
readln(k);
q := p^.next; i := 1;
if p = q then dec(i);
while (q <> p) and (i < k - 1) do begin
q := q^.next;
i := i + 1;
end;
if i <> k - 1 then writeln ('nepravilniy nomer')
else begin
new(pp);
writeln('vvedite info:');
readln(info);
pp^.next := q^.next;
pp^.prev := q;
pp^.next^.prev := pp;
q^.next := pp;
pp^.info := info;
end;
end;
end;
procedure DeleteNode(var p:Dlist);
var
q: dlist;
i, k: integer;
begin
if p = nil then writeln ('spisok pust')
else begin
i := 1;
writeln ('vvedite k:');
readln (k);
if k > 1 then begin
q := p^.next;
while (q <> p) and (i<>k-1) do begin
q := q^.next;
inc(i);
end;
end
else begin { k = 1 }
i := 0; q := p;
end;
if i <> k-1 then writeln ('uzel ne naiden')
else
if q^.next = q then begin
p := nil;
dispose(q);
end
else begin
if q = p then p := p^.next;
q^.prev^.next := q^.next;
q^.next^.prev := q^.prev;
dispose (q);
end;
end;
end;
|
|