Program penyewaan_vcd;
uses crt;
type
datapenyewa = record
nama,alamat,judul : string;
tanggal : integer;
end;
pointer = ^data;
data = record
info : datapenyewa;
next , prev : pointer;
end;
var
penyewa: datapenyewa;
awal, akhir, baru: pointer;
pilih : integer;
nama,alamat,judul : string;
pilihsisip, pilihhapus,tanggal : integer;
isikosong,sisipkosong:boolean;
{menu utama}
procedure menu_utama(var pilih : integer);
begin
repeat
clrscr;
textcolor(yellow);
gotoxy(28,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);
until (pilih >= 1) and (pilih <= 6)
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
awal := baru;
akhir := baru;
akhir^.next:=awal;
awal^.prev:=akhir;
end
else
begin
baru^.next:=awal;
awal^.prev:=baru;
awal:=baru;
akhir^.next:=awal;
awal^.prev:=akhir;
end;
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
awal := baru;
akhir := baru;
akhir^.next:=awal;
awal^.prev:=akhir;
end
else
baru^.prev:=akhir;
akhir^.next:=baru;
akhir:=baru;
akhir^.next:=awal;
awal^.prev:=akhir;
end;
{penyisipan tengah}
procedure sisip_tengah(penyewa: datapenyewa;
var awal,akhir : pointer);
var
baru, bantu : pointer;
ketemu : boolean;
sisipdata : string;
begin
if (awal = akhir) then
begin
new(baru);
baru^.info.nama:= nama;
baru^.info.alamat:= alamat;
baru^.info.judul:= judul;
baru^.info.tanggal:= tanggal;
baru^.next := awal;
baru^.prev := akhir;
awal := baru;
akhir := baru;
end
else
write('Di sisipkan setelah: '); readln(sisipdata);
bantu := awal;
ketemu := false;
while(not ketemu) and (bantu <> akhir) do
begin
if (sisipdata = bantu^.info.nama) then
ketemu := true
else
bantu := bantu^.next
end;
begin
if (ketemu) then
begin
new(baru);
baru^.info.nama:= nama;
baru^.info.alamat:= alamat;
baru^.info.judul:= judul;
baru^.info.tanggal:= tanggal;
if (bantu = akhir) then
sisip_belakang(penyewa,awal,akhir)
else
baru^.prev:=bantu;
baru^.next := bantu^.next;
bantu^.next^.prev:=baru;
bantu^.next:= baru;
end
else
writeln('Data tidak ditemukan');
end;
isikosong:=true;
sisipkosong:=false;
end;
{penghapusan awal}
procedure hapus_depan(penyewa: datapenyewa;
var awal, akhir: pointer);
var
phapus : pointer;
begin
phapus := awal;
awal^.info:= phapus^.info;
if (awal=akhir) then
begin
awal:=nil;
akhir:=nil;
end
else
awal := awal^.next;
awal^.prev:=akhir;
akhir^.next:=awal;
dispose(phapus);
write('penghapusan berhasil');
end;
{penghapusan tengah}
procedure hapus_tengah(penyewa: datapenyewa; var awal,akhir : pointer);
var
phapus,bantu : pointer;
posisihapus,hapus : integer;
begin
if (awal = akhir) then
hapus_depan(penyewa,awal,akhir)
else
begin
write('Masukan posisi data yang akan dihapus : ');readln(hapus);
phapus := awal;
posisihapus := 1;
while (posisihapus <> hapus) do
begin
phapus := phapus^.next;
posisihapus := posisihapus + 1;
end;
begin
bantu := awal;
bantu := awal^.next;
while (bantu^.next <> phapus) do
begin
bantu := bantu^.next;
end;
begin
bantu^.next := phapus^.next;
dispose(phapus);
end
end
end
end;
{penghapusan belakang}
procedure hapus_belakang(penyewa: datapenyewa;
var awal,akhir: pointer);
var
phapus: pointer;
begin
phapus := akhir;
akhir^.info:= phapus^.info;
if (awal=akhir) then
begin
awal:=nil;
akhir:=nil;
end
else
akhir:=akhir^.prev;
akhir^.next:=awal;
awal^.prev:=akhir;
dispose(phapus);
write('penghapusan berhasil');
end;
{pencarian data berdasarkan nama}
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<>akhir) 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;
{pencarian data berdasarkan judul}
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<>akhir) 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;
{pencarian data berdasarkan judul}
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<>akhir) 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;
{pencarian data berdaasarkan tanggal}
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<>akhir) 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 secara ascending}
Procedure Minimum_Sort_Asc_double(Awal, Akhir :Pointer);
var
Min,I, J : Pointer;
Temp : datapenyewa;
begin
I := Awal;
While (I <> Akhir) do
begin
Min := I ;
J := I^.Next ;
begin
While (J <> akhir) do
begin
If (J^.info.nama < Min^.info.nama) Then
begin
Min := J;
end;
J := J^.Next;
end;
end;
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 <> akhir) do
begin
write('|');
writeln(bantu^.info.nama,' |',bantu^.info.alamat,' |'
,bantu^.info.judul,' |',bantu^.info.tanggal,' |');
writeln ('-------------------------------------------------------------------------------');
bantu := bantu^.next;
end;
write('|');
writeln(akhir^.info.nama,' |',akhir^.info.alamat,' |'
,akhir^.info.judul,' |',akhir^.info.tanggal,' |');
end;
{program utama}
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
if (awal=nil ) then
write(' Data kosong Silahkan Masukan Data Terlebih Dahulu')
Else
If (awal <> nil) then
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);
clrscr;
sisip_depan(penyewa,awal,akhir);
end;
2 : begin
clrscr;
isi_data(penyewa);
sisip_tengah(penyewa,awal,akhir);
end;
3 : begin
clrscr;
isi_data(penyewa);
sisip_belakang(penyewa,awal,akhir);
end;
4 : begin
clrscr;
menu_utama(pilih);
end;
end;
end;
3 : begin
if (awal=nil ) then
write(' Data kosong Silahkan Masukan Data Terlebih Dahulu')
Else
If (awal <> nil) then
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
hapus_depan(penyewa,awal,akhir);
end;
2: begin
hapus_tengah(penyewa,awal,akhir);
end;
3: begin
hapus_belakang(penyewa,awal,akhir);
end;
4 : begin
clrscr;
menu_utama(pilih);
end;
end;
end;
4: begin
if (awal=nil ) then
write(' Data kosong Silahkan Masukan Data Terlebih Dahulu')
Else
If (awal <> nil) then
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
if (awal=nil ) then
write(' Data kosong Silahkan Masukan Data Terlebih Dahulu')
Else
If (awal <> nil) then
clrscr;
Minimum_Sort_Asc_double(Awal, Akhir);
tampil_data(awal);
readln;
end;
end;
until (pilih =6);
hancur_data(awal,akhir);
clrscr;
textcolor(10);
gotoxy(15,5);write(' ;:._Terima Kasih Telah Menggunakan Program Kami_.:; ');
gotoxy(15,8);write(' ;:._ Ihsan, Siti, Tigan, Annuur, and Jourdan_.:; ');
delay(2000);
end.
Tidak ada komentar:
Posting Komentar