Lista Jednokierunkowa Obiektowa
type

PElement = ^TElement;
TElement = record
   value:longint;
   next:PElement;
end;

THeader = record
   head,tail:PElement;
end;

TLista = object
private
   header:THeader;
public
   constructor Create;
   destructor Free;
   procedure Dodaj(value:longint);
   function Usun:boolean;
   procedure Wyswietl;
end;

var
   OLista:TLista;
   i:byte;

procedure TLista.Dodaj(value:longint);
var el:PElement;
begin
   new(el);
   el^.value:=value;
   el^.next:=nil;
   if header.head=nil then begin
      header.head:=el;
      header.tail:=el;
   end else begin
      header.tail^.next:=el;
      header.tail:=el;
   end;
end;

function TLista.Usun:boolean;
var el:PElement;
begin
   if header.head<>nil then begin
      if header.head<>header.tail then begin
         dispose(header.head);
         header.head:=nil;
         header.tail:=nil;
      end else begin
         el:=header.head;
         while el^.next<>header.tail do el:=el^.next;
         dispose(el^.next);
         header.tail:=el
      end;
      Usun:=true;
   end else Usun:=false;
end;

constructor TLista.Create;
begin
   header.head:=nil;
   header.tail:=nil;
end;

destructor TLista.Free;
begin
   while Usun do;
end;

procedure Tlista.Wyswietl;
var el:PElement;
begin
   el:=header.head;
   while el<>nil do begin
      writeln (el^.value);
      el:=el^.next;
   end;
end;

BEGIN
   for i:=1 to 5 do OLista.Dodaj(i);
   OLista.Wyswietl;
   OLista.Usun;
   OLista.Usun;
   OLista.Wyswietl;
   while OLista.Usun do;
   OLista.Wyswietl;
   Writeln('Nacisnij Enter by kontynuowac');
   readln;
END.
O ile nie zaznaczono inaczej, treść tej strony objęta jest licencją Creative Commons Attribution-ShareAlike 3.0 License