Senarai digunakan untuk menyimpan sekumpulan data yang bertipe sama (bilangan, string atau tipe terstruktur). Secara teoritis jumlah elemen senarai tidak terbatas,,tetapi secara fisik hanya di batasi oleh jumlah memori yang masih tersedia.
Setiap eleman di dalam senarai mempunyai keterurutan tertentu (ada elemen prodesesor atau elemen pendahulunya, dan dua suksesor atau elemen berkutnya)
Setiap eleman di dalam senarai mempunyai keterurutan tertentu (ada elemen prodesesor atau elemen pendahulunya, dan dua suksesor atau elemen berkutnya)
{Program tambah dan baca}
program senarai_berantai;
uses crt;
const garis = '------------------------------------------';
pesan = 'Senerai berantai masih kosong';
type simpul = ^data;
data = record
nama,
alamat : string;
berikut : simpul
end;
var awal,
akhir : simpul ;
pilih : char;
cacah : integer;
{fungsi untuk memilih menu}
function menu : char; <div class="fullpost">
var p : char;
begin
clrscr;
gotoxy(30,3); writeln('DAFTAR MENU PILIHAN');
gotoxy(20,8); writeln('A. MENAMBAH SIMPUL BARU DI AWAL SENARAI');
gotoxy(20,9); writeln('B. MENAMBAH SIMPUL BARU DI AKHIR SENARAI');
gotoxy(20,10); writeln('C. MENAMBAHKAN SENARAI DI TENGAH');
gotoxy(20,11); writeln('D. MENCETAK DATA');
gotoxy(20,12); writeln('E. SELESAI');
repeat
gotoxy(48,15); writeln(' ':10);
gotoxy(30,20); writeln('PILIH SALAH SATU');
p:= upcase (readkey);
until p in ['A' .. 'E'];
menu :=p
end;
{fungsi alokasi simpul }
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;
{fungsi tambah simpul baru di awal senarai}
procedure tambah_awal (n:integer);
var baru : simpul;
begin
if n <> 0 then
begin
writeln('menambah simpul baru di awal senarai');
writeln(copy(garis,1,45))
end;
writeln;
baru:=simpul_baru;
if awal = nil then
akhir :=baru
else baru^.berikut := awal;
awal :=baru;
end;
{fungsi tambah simpul baru di akhir senarai}
procedure tambah_akhir (n:integer);
var baru : simpul;
begin
clrscr;
if n <> 0 then
begin
writeln('Menambah simpul baru di akhir senarai');
writeln(copy(garis,1,46))
end;
writeln;
baru:=simpul_baru;
if awal = nil then
awal := baru
else
akhir^.berikut := baru;
akhir:=baru;
end;
{prosedu baca isi senarai}
procedure baca_senarai;
var bantu:simpul;
i:integer;
begin
i:=1;
writeln('Membaca isi senarai');
writeln('teken <enter> untuk kembali ke menu');
writeln(copy(garis,1,42));
writeln;
if bantu = nil then
writeln('Data masih kosong')
else
bantu := awal;
while bantu <> nil do
begin
writeln('simpul : ', i:3,' -? nama : ',bantu^.nama);
writeln(' ':17,' alamat : ',bantu^.alamat);
bantu:=bantu^.berikut;
inc(i)
end;
repeat until keypressed
end;
procedure tambah_tengah(n:integer);
var baru,bantu : simpul;
posisi,i:integer;
begin
writeln ('Menambah simpul baru di tenah pada posisi berapa');
writeln(garis);
writeln;
write('senarai berantai berisi:',cacah:2,'simpul');
repeat
gotoxy(52,5);
writeln(' ');
gotoxy(1,5);
write('simpul baru di tempatkan sebagai nomor berapa:');
readln(posisi);
until posisi in [1..cacah+1];
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;
{program utama}
begin
cacah:=0;
awal:=nil;
akhir:=nil;
repeat
pilih:=menu;
clrscr;
case pilih of
'A' :tambah_awal(1);
'B' : tambah_akhir(1);
'C' :tambah_tengah(1);
'D' :baca_senarai;
end;
if pilih in['A','B','C'] then inc(cacah)
until pilih = 'E'
end.</div>
