Kamis, 10 Mei 2012

Program Gabungan Push dan Pop


uses crt;
const garis ='---------------------------------------';
pesan ='Senarai Berantai Masih Kosong';
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,5); write('1. MASUKKAN ANTRIAN');
gotoxy(20,7); write('2. ANTRIAN MASUK');
gotoxy(20,9); write('3. MENGHAPUS ANTRIAN DI TENGAH');
gotoxy(20,11); write('4. MENCETAK ISI ANTRIAN');
gotoxy(20,13); write('5. SELESAI');
repeat
gotoxy(48,20); write('':10);
gotoxy(30,20); write('Pilih salah satu: ');
P := upcase(readkey);
until P in ['1'..'5'];
MENU := P;
end;
function SIMPUL_BARU : simpul;
var
B : simpul;
begin
new(B);
with B^ do
begin
write('Nama  : '); readln(nama);
write('No. Antrian: '); readln(alamat);
berikut := nil;
end;
SIMPUL_BARU := B;
end;
 procedure TAMBAH_AWAL (N : integer);
var
baru : simpul;
begin
if N <> 0 then
begin
writeln('MENAMBAH SIMPUL BARU DI AWAL SENARAI BERANTAI');
writeln(copy(garis,1,45));
end;
writeln;
baru := SIMPUL_BARU;
if awal=nil then
awal:= baru
else
akhir^.berikut := baru;
akhir := baru;
end;
procedure HAPUS_PERTAMA;
begin
if awal <> nil then
begin
awal := awal^.berikut;
writeln('SIMPUL PERTAMA TELAH TERHAPUS');
end
else
writeln(pesan);
writeln; writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');
repeat until keypressed
end;
procedure HAPUS_TENGAH;
var posisi,i : integer;
bantu,bantu1 : simpul;
begin
if cacah=0 then
begin
writeln(pesan); writeln;
writeln('TEKAN <RETURN> UNTUK KEMBALI KE MENU UTAMA');
repeat until keypressed
end

else
begin
writeln('MENGHAPUS SIMPUL YANG ADA DI TENGAH');
writeln(copy(garis,1,35)); writeln;
writeln('SENARAI BERANTAI SEKARANG BERISI :',cacah:2,' SIMPUL');
repeat

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

gotoxy(1,5); write('Akan menghapus simpul nomor berapa: ');

readln(posisi);

until posisi in [1..cacah];
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;
procedure BACA_SENARAI;
var bantu : simpul;
i     : integer;
begin
writeln('MEMBACA ISI SENARAI BERANTAI');
writeln('TEKAN <RETURN> 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('Nama  : ',bantu^.nama);
writeln('No. Antrian: ',bantu^.alamat);
bantu := bantu^.berikut;
end;
repeat until keypressed
end;
{PROGRAM UTAMA}
begin
cacah := 0;
awal := nil;
repeat
pilih := MENU;
clrscr;
case pilih of
'1' : TAMBAH_AWAL(1);
'2' : HAPUS_PERTAMA;
'3' : HAPUS_TENGAH;
'4' : BACA_SENARAI;
end;
if pilih in ['1'] then inc(cacah)
else if (pilih in ['2','3']) and (cacah <> 0) then
dec(cacah)
until pilih='5'
end.

Tidak ada komentar:

Posting Komentar