Monday, October 31, 2016

Program Membuat Senarai

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}


 {proceduresimpulbaru}
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 inikitadapatmenambahkanberbagai data di awalsenarai, dankemudian data tersebutdisimpan agar nantinyadapatdiolah.}


 {proceduretambahakhir}
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;

{didalamprosedurinikitadapatmenambahkan data padaakhirsimpulkemudian data tersebutdisimpan agar dapatdiolah}

 {proceduretambahmanasaja}
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 nikitadapatmenambahkan data baikitu di awal, akhirmaupun di tengah.}

 {procedurehapusawal}
procedure HAPUS_PERTAMA11110306;
begin
ifawal<> nil then
     begin
           awal := awal^.berikut;
           writeln('##DATA PERTAMA TELAH TERHAPUS##');
     end
else
     writeln(pesan);
     writeln; writeln('**TEKAN <<ENTER>> UNTUK KEMBALI KE MENU UTAMA**');
     repeat until keypressed
end;

{didalam procedure inikitadapatmenghapus data yang telahkitabuatyaitupadaawal data yang telahkitasimpan}

 {procedurehapusakhir}
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 <<ENTER>> UNTUK KEMBALI KE MENU UTAMA**');
     repeat until keypressed
end;

{didalam procedure inikitadapatmenghapus data yang telah di simpan, yaitu data yang paling akhir di simpan}

{procedurehapusmanasaja}
procedure HAPUS_MANASAJA11110306;
varposisi,i : integer;
     bantu,bantu1 : simpul;
begin
     ifcacah=0 then
     begin
           writeln(pesan); writeln;
           writeln('**TEKAN <<ENTER>> 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 inikitadapatmengolah data yaitumenghapus data di bagianawalataudepanmaupunawaldari data yang telahkitasimpan.}

 {prosedurebaca}
procedure BACA_SENARAI11110306;
var bantu : simpul;
     i     : integer;
begin
     i := 1;
     writeln('**MEMBACA ISI DATA YANG TERSIMPAN**');
     writeln('**TEKAN <<ENTER>> 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 inikitadapatmengolah data untukmencetakataumenampilkanseluruh data yang telahkitabuat, sehinggakitatahuapasaja data yang kitamiliki.}

{prosedurmencarisimpultertentu}
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 terakhiratau program utamainidideklarasikanberbagai procedure yang telahkitabuattadi, sehinggapada procedure inijugadapat di sebut program pokok, karenatanpa procedure ini program tidakakanberjalan.}

0 comments:

Post a Comment