Membuat Program Senarai Berantai dengan Turbo Pascal

Tampilan Programnya

 

Untuk Sintax Programnya:

Program tugas_11110306;

usescrt;

constgaris ='---------------------------------------';

pesan ='##**SenaraiBerantaiMasihKosong**##';

typesimpul = ^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,7)); write('********************************************');

     gotoxy(20,8); write('A. MENAMBAH SIMPUL BARU DI AWAL SENARAI');

     gotoxy(20,9); write('B. MENAMBAH SIMPUL BARU DI MANA SAJA');

     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 MANA SAJA');

     gotoxy(20,13); write('F. MENGHAPUS SIMPUL TERAKHIR');

     gotoxy(20,14); write('G. MENCETAK ISI SENARAI');

     gotoxy(20,15); write('H. CARI DATA');

     gotoxy(20,16); write('I. SELESAI');

     gotoxy(20,17); write('*****************11110306******************');

     repeat

           gotoxy(48,20); write('':10);

           gotoxy(30,20); write('Pilihsalahsatu: ');

           P :=upcase(readkey);

     until P in ['A'..'I'];

     MENU := P;

end;

{ didalam program ini terdapat pendeklarasian pertama, yaitu tentang simpulnya dibuat, tentang recordnya, serta menu pilihan apa saja yang dapat kita gunakan ketika kita menjalan program pada pascal}

 {procedure simpul baru}

function SIMPUL_BARU11110306 : simpul;

var B : simpul;

begin

     new(B);

     with B^ do

     begin

           write('Nama  : '); readln(nama);

           write('Alamat: '); readln(alamat);

           berikut := nil;

     end;

     SIMPUL_BARU11110306 := B;

end;

procedure TAMBAH_AWAL11110306 (N : integer);

varbaru : simpul;

begin

     if N <> 0 then

     begin

           writeln('##MENAMBAH DATA BARU DI AWAL##');

           writeln(copy(garis,1,45));

     end;

     writeln;

     baru := SIMPUL_BARU11110306;

     ifawal=nil then

     akhir:= baru

else

     baru^.berikut := awal;

     awal := baru;

end;

{ didalam program tambah senarai ini kita dapat menambahkan berbagai data di awal senarai, dan kemudian data tersebut disimpan agar nantinya dapat diolah.}

 {procedure tambah akhir}

procedure TAMBAH_AKHIR11110306 (N : integer);

varbaru : simpul;

begin

     if N <> 0 then

     begin

           writeln('##MENAMBAH DATA BARU DI AKHIR##');

           writeln(copy(garis,1,46));

     end;

     writeln;

     baru := SIMPUL_BARU11110306;

     ifawal=nil then

     awal := baru

else

     akhir^.berikut := baru;

     akhir := baru;

end;

{didalam prosedur ini kita dapat menambahkan data pada akhir simpul kemudian data tersebut disimpan agar dapat diolah}

 {procedure tambah mana saja}

procedure TAMBAH_MANASAJA11110306;

varbaru,bantu : simpul;

     posisi,i   : integer;

begin

     writeln('##MENAMBAH DATA BARU DI MANA SAJA##');

     writeln(garis); writeln;

     writeln('**DATA TELAH BERISI:',cacah:2,' SIMPUL**');

     repeat

           gotoxy(52,5); write(' ');

           gotoxy(1,5);  write('DATA BARU AKAN DITEMPATKAN SEBAGAI SIMPUL NOMOR: ');

           readln(posisi)

     untilposisi in [1..cacah+1];

     ifposisi=1 then TAMBAH_AWAL11110306(0)

else

     ifposisi=cacah+1 then TAMBAH_AKHIR11110306(0)

     else

           begin

                writeln;

                baru := SIMPUL_BARU11110306;

                bantu:= awal;

                for i:=1 to posisi-2 do

                bantu := bantu^.berikut;

                baru^.berikut := bantu^.berikut;

                bantu^.berikut := baru;

           end;

end;

{didalam procedure ini kita dapat menambahkan data baik itu di awal, akhir maupun di tengah.}

 {procedure hapus awal}

procedure HAPUS_PERTAMA11110306;

begin

ifawal<> nil then

     begin

           awal := awal^.berikut;

           writeln('##DATA PERTAMA TELAH TERHAPUS##');

     end

else

     writeln(pesan);

     writeln; writeln('**TEKAN <> UNTUK KEMBALI KE MENU UTAMA**');

     repeat until keypressed

end;

{didalam procedure ini kita dapat menghapus data yang telah kita buat yaitu pada awal data yang telah kita simpan}

 {procedure hapus akhir}

procedure HAPUS_TERAKHIR11110306;

var bantu : simpul;

     H     : integer;

begin

     ifawal=nil then

     begin

           writeln(pesan);

           H := 0;

     end

else

     ifawal=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('##DATA TERAKHIR TELAH TERHAPUS##'); writeln;

     writeln('**TEKAN <> UNTUK KEMBALI KE MENU UTAMA**');

     repeat until keypressed

end;

{didalam procedure ini kita dapat menghapus data yang telah di simpan, yaitu data yang paling akhir di simpan}

{procedure hapus mana saja}

procedure HAPUS_MANASAJA11110306;

varposisi,i : integer;

     bantu,bantu1 : simpul;

begin

     ifcacah=0 then

     begin

           writeln(pesan); writeln;

           writeln('**TEKAN <> UNTUK KEMBALI KE MENU UTAMA**');

           repeat until keypressed

     end

else

     begin

           writeln('##MENGHAPUS DATA YANG ADA DI MANA SAJA##');

           writeln(copy(garis,1,35)); writeln;

           writeln('**DATA SEKARANG BERISI :',cacah:2,' SIMPUL**');

           repeat

                gotoxy(37,5); write('':5);

                gotoxy(1,5); write('Akan menghapus Data nomorberapa: ');

                readln(posisi);

                untilposisi in [1..cacah];

                ifposisi=1 then HAPUS_PERTAMA11110306

           else

                ifposisi=cacah then HAPUS_TERAKHIR11110306

           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;

{ dalam procedure ini kita dapat mengolah data yaitu menghapus data di bagian awal atau depan maupun awal dari data yang telah kita simpan.}

 {prosedure baca}

procedure BACA_SENARAI11110306;

var bantu : simpul;

     i     : integer;

begin

     i := 1;

     writeln('**MEMBACA ISI DATA YANG TERSIMPAN**');

     writeln('**TEKAN <> 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;

{ dalam procedure ini kita dapat mengolah data untuk mencetak atau menampilkan seluruh data yang telah kita buat, sehingga kita tahu apa saja data yang kita miliki.}

{prosedur mencari simpul tertentu}

procedure CARI_SIMPUL11110306;

var bantu : simpul;

     i     : integer;

begin

     i := 1;

     writeln('**MENCARI SIMPUL TERTENTU**');

     ifawal = nil then

writeln('****DATA MASIH KOSONG****')

else

writeln('**MENCARI DATA TERTENTU**');

     bantu:=awal;

     if bantu^.nmbuku=bantu^.nmbuku then

begin

writeln('Nama        : ', bantu^.nama:5);

writeln('Alamat : ', bantu^.alamat);

end

else

writeln('Data Dengan No ',bantu^.:5,'tidak ada');

end;

{========================================================}

{PROGRAM UTAMA}

begin

     cacah := 0;

     awal := nil;

     akhir := nil;

     repeat

           pilih := MENU;

           clrscr;

           casepilih of

                'A' : TAMBAH_AWAL11110306(1);

                'B' : TAMBAH_MANASAJA11110306;

                'C' : TAMBAH_AKHIR11110306(1);

                'D' : HAPUS_PERTAMA11110306;

                'E' : HAPUS_MANASAJA11110306;

                'F' : HAPUS_TERAKHIR11110306;

                'G' : BACA_SENARAI11110306;

                'H' : CARI_SIMPUL11110306;

           end;

           ifpilih in ['A','B','C'] then inc(cacah)

     else

           if (pilih in ['D','E','F']) and (cacah<> 0) then

           dec(cacah)

           untilpilih='I'

end.

{ di program terakhir atau program utama ini dideklarasikan berbagai procedure yang telah kita buat tadi, sehingga pada procedure ini juga dapat di sebut program pokok, karena tanpa procedure ini program tidak akan berjalan.}