Kamis, 26 April 2012

Program circular dbl2 ( Struktur Data )



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