contoh program senarai berantai

by 01:08:00 0 komentar



berikut ini adalah contoh dari program senarai berantai anda dapat menyalin nya dan menjalankan nya di pascal:
uses crt;

const garis ='---------------------------------------';
pesan ='##**SenaraiBerantaiMasihKosong**##';
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,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. SELESAI');
     gotoxy(20,16); write('*****************11140345******************');
     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);
var baru : simpul;
begin
     if N <> 0 then
     begin
           writeln('##MENAMBAH DATA BARU DI AWAL##');
           writeln(copy(garis,1,45));
     end;
     writeln;
     baru := SIMPUL_BARU11110306;
     if awal=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);
var baru : simpul;
begin
     if N <> 0 then
     begin
           writeln('##MENAMBAH DATA BARU DI AKHIR##');
           writeln(copy(garis,1,46));
     end;
     writeln;
     baru := SIMPUL_BARU11110306;
     if  awal=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;
var baru,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)
     until posisi in [1..cacah+1];
     if posisi=1 then TAMBAH_AWAL11110306(0)
else
     if  posisi=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
if awal<> 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
     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('##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;
var posisi,i : integer;
     bantu,bantu1 : simpul;
begin
     if cacah=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);
                until posisi in [1..cacah];
                if  posisi=1 then HAPUS_PERTAMA11110306
           else
                if posisi=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**');
     if awal = nil then
writeln('****DATA MASIH KOSONG****')
else
writeln('**MENCARI DATA TERTENTU**');
     bantu:=awal;
     if bantu^.berikut=bantu^.berikut then
begin
writeln('Nama        : ', bantu^.nama:5);
writeln('Alamat : ', bantu^.alamat);
end
else
writeln('Data Dengan No ',bantu^.nama:5,'tidak ada');
end;
{========================================================}
{PROGRAM UTAMA}
begin
     cacah := 0;
     awal := nil;
     akhir := nil;
     repeat
           pilih := MENU;
           clrscr;
           case pilih of
                'A' : TAMBAH_AWAL11110306(1);
                'B' : TAMBAH_MANASAJA11110306;
                'C' : TAMBAH_AKHIR11110306(1);
                'D' : HAPUS_PERTAMA11110306;
                'E' : HAPUS_MANASAJA11110306;
                'F' : HAPUS_TERAKHIR11110306;
                'G' : BACA_SENARAI11110306;
           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.

{ 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 prog
ram tidak akan berjalan.}

Unknown

Developer

Cras justo odio, dapibus ac facilisis in, egestas eget quam. Curabitur blandit tempus porttitor. Vivamus sagittis lacus vel augue laoreet rutrum faucibus dolor auctor.

0 komentar:

Post a Comment

luvne.com ayeey.com cicicookies.com mbepp.com tipscantiknya.com kumpulanrumusnya.comnya.com