Program penyewaan_vcd;
uses crt;
type
datapenyewa = record
nama,alamat,judul : string;
kode,tanggal : integer;
end;
pointer = ^data;
data = record
info : datapenyewa;
prev,next : pointer;
end;
var
penyewa: datapenyewa;
awal, akhir: pointer;
pilih : integer;
nama,alamat,judul : string;
pilihsisip, pilihhapus,tanggal : integer;
{menu utama}
procedure menu_utama(var pilih : integer);
begin
repeat
clrscr;
gotoxy(31,4);writeln(' DATA PENYEWAAN VCD ');
gotoxy(24,5);writeln('-------------------------------');
gotoxy(25,7); writeln('1. Isi Data penyewa');
gotoxy(25,9); writeln('2. Tambah Data penyewa');
gotoxy(25,11);writeln('3. Hapus Data penyewa');
gotoxy(25,13);writeln('4. Mencari Data penyewa');
gotoxy(25,15);writeln('5. Tampil Data penyewa');
gotoxy(25,17);writeln('6. Keluar');
writeln;
gotoxy(25,20);write('pilihan= '); readln(pilih);
if (pilih < 1) or (pilih > 6) then
begin
writeln('Salah memilih menu, silahkan ulangi.. Tekan Enter !');
readln;
end;
until (pilih >= 1) and (pilih <= 5)
end;
{pengisian data}
procedure isi_data(penyewa: datapenyewa);
begin
gotoxy(25,4); write('Pengisian Data Penyewa');
gotoxy(14,5);writeln('===========================================');
gotoxy(14,7);write('Nama : '); readln(nama);
gotoxy(14,8);write('Alamat : '); readln(alamat);
gotoxy(14,9);write('Judul VCD/gendre VCD : '); readln(judul);
gotoxy(14,10);write('Tanggal penyewaan : '); readln(tanggal);
end;
{penyisipan depan}
procedure sisip_depan(penyewa: datapenyewa;
var awal,akhir : pointer);
var
baru : pointer;
begin
new(baru);
baru^.info.nama:= nama;
baru^.info.alamat:= alamat;
baru^.info.judul:= judul;
baru^.info.tanggal:= tanggal;
if (awal = nil) then
begin
baru^.next := nil;
baru^.prev := nil;
akhir := baru;
writeln('list kosong');
end
else
begin
baru^.next := awal;
awal^.prev:=baru;
end;
awal := baru;
end;
{penyisipan belakang}
procedure sisip_belakang(penyewa: datapenyewa;
var awal,akhir : pointer);
var
baru : pointer;
begin
new(baru);
baru^.info.nama:= nama;
baru^.info.alamat:= alamat;
baru^.info.judul:= judul;
baru^.info.tanggal:= tanggal;
if (awal = nil) then
begin
baru^.next:=nil;
baru^.prev:=nil;
akhir:=baru;
writeln('list kosong');
end
else
begin
akhir^.next := baru;
baru^.prev:=akhir;
end;
akhir := baru;
end;
{pencarian data}
procedure cari_data_nama( var awal: pointer);
var
bantu:pointer;
data_cari:string;
ketemu:boolean;
begin
write('Masukkan nama penyewa yang ingin dicari= ');readln(data_cari);
ketemu:=false;
bantu:=awal;
while (not ketemu) and (bantu<>nil) do
begin
if (bantu^.info.nama= data_cari )then
ketemu:=true
else
bantu:=bantu^.next
end;
if ketemu then
begin
writeln('Data Cari');
writeln('===========================================');
writeln('Nama = ',bantu^.info.nama);
writeln('Alamat = ',bantu^.info.alamat);
writeln('Judul VCD = ',bantu^.info.judul);
writeln('Tanggal = ',bantu^.info.tanggal);
end
else
write(data_cari,'data tidak ditemukan');readln;
end;
procedure cari_data_alamat( var awal: pointer);
var
bantu:pointer;
data_cari:string;
ketemu:boolean;
begin
write('Masukkan alamat yang ingin dicari= ');readln(data_cari);
ketemu:=false;
bantu:=awal;
while (not ketemu) and (bantu<>nil) do
begin
if (bantu^.info.alamat= data_cari )then
ketemu:=true
else
bantu:=bantu^.next
end;
if ketemu then
begin
writeln(' Data Cari ');
writeln('==============================');
writeln('Nama = ',bantu^.info.nama);
writeln('Alamat = ',bantu^.info.alamat);
writeln('Judul VCD = ',bantu^.info.judul);
writeln('Tanggal = ',bantu^.info.tanggal);
end
else
write(data_cari,'data tidak ditemukan');readln;
end;
procedure cari_data_judul( var awal: pointer);
var
bantu:pointer;
data_cari:string;
ketemu:boolean;
begin
write('Masukkan judul VCD yang ingin dicari= ');readln(data_cari);
ketemu:=false;
bantu:=awal;
while (not ketemu) and (bantu<>nil) do
begin
if (bantu^.info.judul= data_cari )then
ketemu:=true
else
bantu:=bantu^.next
end;
if ketemu then
begin
writeln('Data Cari');
writeln('===========================================');
writeln('Nama = ',bantu^.info.nama);
writeln('Alamat = ',bantu^.info.alamat);
writeln('Judul VCD = ',bantu^.info.judul);
writeln('Tanggal = ',bantu^.info.tanggal);
end
else
write(data_cari,'data tidak ditemukan');readln;
end;
procedure cari_data_tanggal( var awal: pointer);
var
bantu:pointer;
data_cari:integer;
ketemu:boolean;
begin
write('Masukkan tanggal penyewaan yang ingin dicari= ');readln(data_cari);
ketemu:=false;
bantu:=awal;
while (not ketemu) and (bantu<>nil) do
begin
if (bantu^.info.tanggal= data_cari )then
ketemu:=true
else
bantu:=bantu^.next
end;
if ketemu then
begin
writeln('Data Cari');
writeln('===========================================');
writeln('Nama = ',bantu^.info.nama);
writeln('Alamat = ',bantu^.info.alamat);
writeln('Judul VCD = ',bantu^.info.judul);
writeln('Tanggal = ',bantu^.info.tanggal);
end
else
write(data_cari,'data tidak ditemukan');readln;
end;
{pengurutan}
Procedure Minimum_Sort_Asc_Single(Awal, Akhir :Pointer);
var
Min,I, J : Pointer;
Temp : datapenyewa;
begin
I := Awal;
While (I <> Akhir) do
begin
Min := I ;
J := I^.Next ;
While (J <> Nil) do
begin
If (J^.info.nama < Min^.info.nama) Then
begin
Min := J;
end;
J := J^.Next;
End;
Temp := I^.info;
I^.info := Min^.info;
Min^.info := Temp;
I := I^.Next;
end;
End;
{penghancuran}
procedure hancur_data(awal,akhir:pointer);
var
phapus:pointer;
begin
phapus:=awal;
while phapus<>nil do
begin
awal:=awal^.next;
dispose(phapus);
phapus:=awal;
end;
akhir:=nil;
end;
{tampil data}
procedure tampil_data(var awal : pointer);
var
bantu : pointer;
begin
clrscr;
bantu := awal;
gotoxy(7,3);writeln(' DATA PENYEWA VCD ');
writeln ('===============================================================================');
writeln ('| NAMA | ALAMAT | JUDUL VCD | TANGGAL PENYEWAAN |');
writeln ('===============================================================================');
while (bantu <> nil) do
begin
write('|');
writeln(bantu^.info.nama,' |',bantu^.info.alamat,' |'
,bantu^.info.judul,' |',bantu^.info.tanggal,' |');
writeln ('-------------------------------------------------------------------------------');
bantu := bantu^.next;
end;
end;
begin
awal:=nil;
akhir:=nil;
repeat
clrscr;
menu_utama(pilih);
case (pilih) of
1 : begin
clrscr;
isi_data(penyewa);
sisip_depan(penyewa,awal,akhir);
end;
2 : begin
repeat
clrscr;
writeln('Tambah Data Penyewa');
writeln('-----------');
writeln('1. Sisip Depan');
writeln('2. Sisip Tengah');
writeln('3. Sisip Belakang');
writeln('4. kembali');
writeln;
writeln('Masukan pilihan: '); readln(pilihsisip);
until (pilihsisip > 0) and (pilihsisip < 5);
case (pilihsisip) of
1 : begin
clrscr;
isi_data(penyewa);
sisip_depan(penyewa,awal,akhir);
end;
2 : begin
clrscr;
isi_data(penyewa);
end;
3 : begin
clrscr;
isi_data(penyewa);
sisip_belakang(penyewa,awal,akhir);
end;
4 : begin
clrscr;
menu_utama(pilih);
end;
end;
end;
3 : begin
repeat
clrscr;
writeln('Hapus Data');
writeln('----------');
writeln('1. Hapus Depan');
writeln('2. Hapus Tengah');
writeln('3. Hapus Belakang');
writeln('4. kembali');
writeln;
write('Masukan pilihan : '); readln(pilihhapus);
until(pilihhapus > 0)and(pilihhapus < 5);
case (pilihhapus) of
1: begin
end;
2: begin
end;
3: begin
end;
4 : begin
clrscr;
menu_utama(pilih);
end;
end;
end;
4: begin
repeat
clrscr;
writeln('Cari Data Berdasarkan :');
writeln('-----------');
writeln('1. Nama');
writeln('2. Alamat');
writeln('3. Judul vcd');
writeln('4. Tanggal');
writeln('5. kembali');
writeln;
writeln('Masukan pilihan: '); readln(pilih);
until (pilih > 0) and (pilih < 6);
case (pilih) of
1 : begin
clrscr;
cari_data_nama(awal);
end;
2 : begin
clrscr;
cari_data_alamat(awal);
end;
3 : begin
clrscr;
cari_data_judul(awal);
end;
4 : begin
clrscr;
cari_data_tanggal(awal);
end;
5 : begin
clrscr;
menu_utama(pilih);
end;
end;
end;
5: begin
clrscr;
tampil_data(awal);
readln;
end;
end;
until (pilih =6);
hancur_data(awal,akhir);
end.
Tidak ada komentar:
Posting Komentar