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.}

0 komentar:
Post a Comment