Contoh Program Link List Toko Bunga pada Pascal

Langsung saja ke source codenya,, berikut ini source codenya...

program databunga;
uses crt;
type poinjuk = ^lokasi;
      lokasi = record
      bunga : string;
      nama: string;
      banyak: integer;
      berikut : poinjuk;
     end;

var awal,data,akhir : poinjuk;
    f,s,d     : integer;
    pil,pilih : char;
    larik : lokasi;
    cari : string;

Procedure menu;
begin
 clrscr;
 writeln(' ------------------------ Data Toko Bunga -------------------------- ');
 writeln(' ------------------------------------------------------------------- ');
 writeln;
 writeln('   1. Tambah data pembeli       4. Cari data pembeli ');
 writeln('   2. Tampilkan data pembeli    5. pembelian terbesar dan terkecil');
 writeln('   3. Hapus data                6. Rata-Rata pembelian');writeln;
 writeln('                            0. Keluar');
 writeln;
 writeln(' -------------------------------------------------------------------');
 write('   Pilihan : '); readln(pil);
end;

procedure databaru(var baru : poinjuk; namanya : string;bunganya : string; banyaknya : integer);
Begin
 new(baru);
 baru^.nama:=namanya;
 baru^.bunga:=bunganya;
 baru^.banyak:=banyaknya;
 baru^.berikut:=nil;
end;

procedure tambah;
begin
 clrscr;
 writeln('------ Masukkan Data Baru ------');
 writeln;

 repeat
  new(data);
  write('Nama Pembeli        : '); readln(larik.nama);
  write('Nama Bunga          : '); readln(larik.bunga);
  write('Jumlah Beli         : '); readln(larik.banyak);
  databaru(data,larik.nama,larik.bunga,larik.banyak);
  if awal=nil then
   begin
    awal:=data;
    akhir:=data;
   end
  else
   begin
    akhir^.berikut:=data;
    akhir:=data;
    akhir^.berikut:=nil;
   end;
   writeln;
  write('Tambah Data Lagi[Y/T] : ');
  readln(pilih);
  writeln;
  pilih:=upcase(pilih);
 until pilih='T';
end;

procedure lihat;
var banyak : integer;
begin
clrscr;
s:=0;
banyak:=0;
data:=awal;
writeln('------------------ Daftar Data Toko Bunga ------------------');
writeln('|----------------------------------------------------------|');
writeln('| No |      Nama     |       Bunga        |     Jumlah     |');
writeln('|----------------------------------------------------------|');
       //123456789012345678901234567890123456789012345678901234567890
while data<> nil do
 begin
  s:=s+1;
  gotoxy(1,4+s);
writeln('|    |               |                    |                |');
  gotoxy(3,4+s);
  writeln(s);
  gotoxy(8,4+s);
  writeln(data^.nama);
  gotoxy(24,4+s);
  writeln(data^.bunga);
  gotoxy(51,4+s);
  writeln(data^.banyak);
  banyak:=banyak+data^.banyak;
  data:=data^.berikut;
 end;
writeln('|----------------------------------------------------------|');
writeln('| Total bunga dibeli = ',banyak);
readkey;

end;

procedure caridata;
var
   terus : boolean;
begin
clrscr;
writeln('--------- Cari Data Pembeli Bunga ---------');
writeln;
write('Nama Pembeli yang ingin dicari : ');
readln(cari);
writeln;
data:=awal;
terus:=false;
while (data<>nil) and (terus=false) do
 begin
  if data^.nama=cari then
   begin
    terus:=true;
    writeln('Nama ',cari,' Ditemukan : ');
    writeln('Nama Bunga  : ',data^.bunga);
    writeln('Jumlah      : ',data^.banyak);
   end
  else
    data:=data^.berikut;
 end;
if data= nil then writeln('Nama ',cari,' Tidak ditemukan ! ');
readkey;
end;

procedure hapus;
var
   terus : boolean;
   bantu : poinjuk;
begin
clrscr;
writeln('--------- Hapus Data Pembeli Bunga ---------');
writeln;
write('Nama Pembeli yang ingin dhapus  : ');
readln(cari);
writeln;
data:=awal;
terus:=false;

if data^.nama=cari then
 begin
 awal:=data^.berikut;
 dispose(data);
 writeln('Nama  ',cari,' Berhasil dihapus !  ');
 end
else
begin
 while (data<>nil) and (terus=false) do
  begin
  if data^.berikut^.nama = cari then
   begin
    terus:=true;
    bantu:=data^.berikut;
    data^.berikut:=data^.berikut^.berikut;
    dispose(bantu);
    writeln('Nama ',cari,' Berhasil dihapus ! ');
   end;
    data:=data^.berikut;
 end;
end;

if data= nil then writeln('Nama ',cari,' Tidak ditemukan ! ');
readkey;
end;


procedure terbanyakdantersedikit;
var min,max : poinjuk;
begin
 clrscr;
 data:=awal;
 max:=awal;
 min:=awal;
 while data<>nil do
  begin
   if max^.banyak < data^.banyak then max:=data;
   if min^.banyak > data^.banyak then min:=data;
  data:=data^.berikut;
 end;
 if awal=nil then
  writeln('data masih kosong !! ')
 else
  begin
    writeln('Pembeli dengan pembelian terbesar adalah : ',max^.nama);
    writeln('                         Nama Bunga      : ',max^.bunga);
    writeln('                         Jumlah          : ',max^.banyak);
    writeln('------------------------------------------------------------');
    writeln('Pembeli dengan pembelian terkecil adalah : ',min^.nama);
    writeln('                         Nama Bunga      : ',min^.bunga);
    writeln('                         Jumlah          : ',min^.banyak);
   end;
 readkey;
end;

procedure rata;
var rata2,rata3 : real;
   n : integer;
begin
 clrscr;
 data:=awal;
 rata2:=0;
 n:=0;
 while data<>nil do
  begin
  rata2:=rata2+data^.banyak;
  n:=n+1;
  data:=data^.berikut;
 end;
 if awal=nil then
  writeln('Data Masih Kosong !! ')
 else
  begin
    rata3:=rata2/n;
    writeln('Rata-rata pembelian keseluruhan adalah : ',rata3:0:2);
   end;
 readkey;
end;


BEGIN

repeat

menu;
case pil of
'1' : tambah ;
'2' : lihat ;
'3' : hapus;
'4' : caridata;
'5' : terbanyakdantersedikit;
'6' : rata ;
'0' : exit;

end;
until pil ='0';
END.


Download programnya (DISINI)