Disebut senarai berantai karena satu elemen dengan elemen yang lain bisa dihibungkan satu sama lain dengan pointer.

Program dan keterangannya sebagai berikut :


Program Senarai_Berantai;

uses crt;

const garis ='---------------------------------------';
pesan ='Senarai Berantai Masih Kosong';
type simpul = ^data;
data   = record
nama : string;
alamat : string;
berikut : simpul;
end;
var
awal,akhir : simpul;
pilih : char;
cacah : integer;
 
function MENU : char;
var P : char;
begin
clrscr;
gotoxy(30,3); write('DAFTAR MENU PILIHAN');
gotoxy(20,8); write('A. MENAMBAH SIMPUL BARU DI AWAL SENARAI');
gotoxy(20,9); write('B. MENAMBAH SIMPUL BARU DI TENGAH SENARAI');
gotoxy(20,10); write('C. MENAMBAH SIMPUL BARU DI AKHIR SENARAI');
gotoxy(20,11); write('D. MENGHAPUS SIMPUL PERTAMA');
gotoxy(20,12); write('E. MENGHAPUS SIMPUL DI TENGAH');
gotoxy(20,13); write('F. MENGHAPUS SIMPUL TERAKHIR');
gotoxy(20,14); write('G. MENCETAK ISI SENARAI');
gotoxy(20,15); write('H. SELESAI');
repeat
gotoxy(48,20); write('':10);
gotoxy(30,20); write('Pilih salah satu: ');
P := upcase(readkey);
until P in ['A'..'H'];
MENU := P;
end;
 
function SIMPUL_BARU : simpul;
var B : simpul;
begin
new(B);
with B^ do
begin
write('Nama  : '); readln(nama);
write('Alamat: '); readln(alamat);
berikut := nil;
end;
SIMPUL_BARU := B;
end;
 
procedure TAMBAH_AWAL (N : integer);
var
baru : simpul;
begin
if N <> 0 then
begin
writeln('MENAMBAH SIMPUL BARU DI AWAL SENARAI BERANTAI');
writeln(copy(garis,1,45));
end;
writeln;
baru := SIMPUL_BARU;
if awal=nil then
akhir:= baru
else
baru^.berikut := awal;
awal := baru;
end;
 
procedure TAMBAH_AKHIR (N : integer);
var
baru : simpul;
begin
if N <> 0 then
begin
writeln('MENAMBAH SIMPUL BARU DI AKHIR SENARAI BERANTAI');
writeln(copy(garis,1,46));
end;
writeln;
baru := SIMPUL_BARU;
if awal=nil then
awal := baru
else
akhir^.berikut := baru;
akhir := baru;
end;
 
procedure TAMBAH_TENGAH;
var baru,bantu : simpul;
posisi,i   : integer;
begin
writeln('MENAMBAH SIMPUL BARU DI TENGAH SENARAI BERANTAI');
writeln(garis); writeln;
writeln('SENARAI BERANTAI BERISI:',cacah:2,' SIMPUL');
repeat
gotoxy(52,5); write(' ');
gotoxy(1,5);  write('SIMPUL BARU AKAN DITEMPATKAN SEBAGAI SIMPUL NOMOR: ');
readln(posisi)
until posisi in [1..cacah+1];
if posisi=1 then TAMBAH_AWAL(0)
else if posisi=cacah+1 then TAMBAH_AKHIR(0)
else
begin
writeln;
baru := SIMPUL_BARU;
bantu:= awal;
for i:=1 to posisi-2 do
bantu := bantu^.berikut;
baru^.berikut := bantu^.berikut;
bantu^.berikut := baru;
end;
end;
 
procedure HAPUS_PERTAMA;
begin
if awal <> nil then
begin
awal := awal^.berikut;
writeln('SIMPUL PERTAMA TELAH TERHAPUS');
end
else
writeln(pesan);
writeln; writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');
repeat until keypressed
end;
 
procedure HAPUS_TERAKHIR;
var bantu : simpul;
H     : integer;
begin
if awal=nil then
begin
writeln(pesan);
H := 0;
end
else if awal=akhir then
begin
awal := nil;
akhir:= nil;
H := 1;
end
else
begin
bantu := awal;
while bantu^.berikut <> akhir do
bantu := bantu^.berikut;
akhir := bantu;
akhir^.berikut := nil;
H := 1;
end;
if H=1 then
writeln('SIMPUL TERAKHIR TELAH TERHAPUS'); writeln;
writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');
repeat until keypressed
end;
 
procedure HAPUS_TENGAH;
var posisi,i : integer;
bantu,bantu1 : simpul;
begin
if cacah=0 then
begin
writeln(pesan); writeln;
writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');
repeat until keypressed
end
else
begin
writeln('MENGHAPUS SIMPUL YANG ADA DI TENGAH');
writeln(copy(garis,1,35)); writeln;
writeln('SENARAI BERANTAI SEKARANG BERISI :',cacah:2,' SIMPUL');
repeat
gotoxy(37,5); write('':5);
gotoxy(1,5); write('Akan menghapus simpul nomor berapa: ');
readln(posisi);
until posisi in [1..cacah];
if posisi=1 then HAPUS_PERTAMA
else if posisi=cacah then HAPUS_TERAKHIR
else
begin
bantu := awal;
for i:=1 to posisi-2 do
bantu:= bantu^.berikut;
bantu1 := bantu^.berikut;
bantu^.berikut := bantu1^.berikut;
bantu1^.berikut := nil;
dispose(bantu1);
end;
end;
end;
 
procedure BACA_SENARAI;
var bantu : simpul;
i     : integer;
begin
i := 1;
writeln('MEMBACA ISI SENARAI BERANTAI');
writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');
writeln(copy(garis,1,42)); writeln;
bantu := awal;
if bantu=nil then
writeln(pesan)
else
while bantu <> nil do
begin
writeln('Simpul: ',i:2,'---> Nama  : ',bantu^.nama);
writeln('':15,'Alamat: ',bantu^.alamat);
bantu := bantu^.berikut;
inc(i);
end;
repeat until keypressed
end;
 
{PROGRAM UTAMA}
begin
cacah := 0;
awal := nil;
akhir := nil;
repeat
pilih := MENU;
clrscr;
case pilih of
'A' : TAMBAH_AWAL(1);
'B' : TAMBAH_TENGAH;
'C' : TAMBAH_AKHIR(1);
'D' : HAPUS_PERTAMA;
'E' : HAPUS_TENGAH;
'F' : HAPUS_TERAKHIR;
'G' : BACA_SENARAI;
end;
if pilih in ['A','B','C'] then inc(cacah)
else if (pilih in ['D','E','F']) and (cacah <> 0) then
dec(cacah)
until pilih='H'
end.