Program Spisok;
Uses Crt;
type
List = ^sp;
Ltem = integer;
sp = record
element : Ltem;
next,previus : List;{next - адрес указывающий на следующий элемент списка, previus - на предыдущий} end;
var L : List;
procedure LtCreat (var L: List);
begin
New(L);
L^.previus := nil;
L^.next := nil;
end;
procedure LtInsert (var L:list; NewElem:Ltem);
var P : List;
begin
if (L= nil) then LtCreat(L); {если L не существует, то создать его}
P:= L; {буферной переменной присваивается список}
New(L);{создается L}
L^.element := NewElem;{информационной части L присваевается входящий параметр NewElem}
L^.previus := p;{адресу элемента L присваивается буферная переменная}
L^.next := p^.next;{next адресу переменной L присваивается next адрес буферной переменной P}
p^.next := L;{за элементой p будет следовать ново созданный элемент L}
end;
procedure Delete (var L : list);{процедура удаления элемента L}
begin
if l^.previus <> nil then
l^.previus^.next := l^.next;{следующему адресу предыдущего элемента L присваивается адрес следующего переменного за L... Таким образом не один элемент не ссылается на элемент L, и он выпадает из списка}
if l^.next <> nil then
l^.next^.previus := l^.previus;{все то же самое}
end;
procedure LtDelete(var L: list);{в этой процедуре попробуйте разобраться самостоятельно в ней нет ничего сложного}
var bufp,bufn : list;
begin
if l <> nil then
begin
bufp := L^.previus;
bufn := L^.next;
dispose(L);
bufp^.next := bufn;
bufn^.previus := bufp;
L := bufp;
end;
end;
function LtCurent (var L : list):Ltem;
begin
LtCurent := L^.element;
end;
procedure LtReplace (var L : List; NewElem:Ltem);
begin
L^.element := NewElem;
end;
procedure LtGoNext(var L:list);
begin
if L^.next <> nil then
L := L^.next;
end;
procedure LtGoPreor(var L:list);
begin
if L^.previus <> nil then
L := L^.previus;
end;
procedure LtGoBegin(var L:List);
begin
while L^.previus <> nil do
begin
L := L^.previus;
end;
end;
procedure LtGoEnd(var L:list);
begin
while L^.next <> nil do
begin
L := L^.next;
end;
end;
function LtAtBegin (var L : list): boolean;
begin
if L^.previus = nil then LtAtBegin := true
else LtAtBegin := false;
end;
function LtAtEnd (var L : list): boolean;
begin
if L^.next = nil then LtAtEnd := true
else LtAtEnd := false;
end;
procedure LtClear(var L: list);
var buf : List;
begin
LtGoBegin(L);
while L^.next<> nil do
begin
buf := L^.next;
dispose(L);
L:= buf;
end;
end;
procedure LtShow(var L : list; var I: longint);
begin
LtGoBegin(L);
I:= 0;
while L^.next <> nil do
begin
Inc(I);
L:=L^.next;
write(L^.element,' ');
end;
end;
end.
___________________________________________________________________
Авторские права © 2000, Hunter'у Переработано 08.01.05 Ваши отклики и пожелания пишите мне
