Kamis, 26 April 2012

Program penyewaan_vcd; ( Struktur Data )


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