Tugas Strutur Data Persentasi (Pascal)

Hmmm..... Dunia Semakin Tua dan Ilmu Pengetahuan juga semakin Bertambah...Kali ini saya akan membahas tentang Linked List dan atrian....
Berikut ini adalah source Codenya.......
Program apotek =====>

program pelayanan_apotek; uses wincrt; type obat=^pointer; pointer=record namaobat:string; haobat:real; kodeobat:byte; next:obat; end; type antrian=^pointer2; pointer2=record nama:string; next2:antrian; end; type penjualan=^pointer3; pointer3=record namaobat3:string; kodeobat3:byte; haobat3:real; next3:penjualan; end; var awal,akhir,baru,bantu,hapus:obat; awal2,akhir2,baru2,bantu2,hapus2:antrian; awal3,akhir3,baru3,bantu3,hapus3:penjualan; nmobat,nmbeli,obatbeli,nmbaru,obatbeli2:string; hargabaru,hargabeli:real; pil,i,kdobat:byte; ketemu:boolean; procedure tambah_obat (var L:obat;x:string;y:real;z:byte); begin new(baru); baru^.namaobat:=x; baru^.haobat:=y; baru^.kodeobat:=z; baru^.next:=nil; if L=nil then begin L:=baru;akhir:=baru; end else begin baru^.next:=L; L:=baru; end; end; procedure cetak_obat(var L:obat); begin new(bantu); bantu:=L; writeln; writeln('+-----+-----+-----+-----+-----+'); writeln('| DAFTAR OBAT |'); writeln('+-----+-----+-----+-----+-----+'); writeln('| Nama obat | Kode| Harga |'); writeln('+-----+-----+-----+-----+-----+'); while bantu<>nil do begin writeln(bantu^.namaobat:8,' ',bantu^.kodeobat:8,' ',bantu^.haobat:8:2); bantu:=bantu^.next; end; writeln; end; procedure cetak_penjualan(var L:penjualan); begin new(bantu3); bantu3:=L; writeln(' Nama Kode Harga'); while bantu3<>nil do begin writeln(bantu3^.namaobat3:8,' ',bantu3^.kodeobat3:8,' ',bantu3^.haobat3:8 :2); bantu3:=bantu3^.next3; end; writeln; end; procedure cetak_rekap(var L:penjualan); begin new(bantu3); bantu3:=L; writeln(' Nama Kode Harga'); while bantu3<>nil do begin writeln(bantu3^.namaobat3:8,' ',bantu3^.kodeobat3:8,' ',bantu3^.haobat3:8:2); bantu3:=bantu3^.next3; end; writeln; end; procedure tambah_antri (var k:antrian;x:string); begin new(baru2); baru2^.nama:=x; baru2^.next2:=nil; if awal2=nil then begin awal2:=baru2;k:=baru2; end else begin k^.next2:=baru2; k:=baru2; end; end; procedure cetak_antri(var k:antrian); begin new(bantu2); bantu2:=k; writeln(' Pengantri saat ini adalah '); while bantu2<>nil do begin write(bantu2^.nama:8,' '); bantu2:=bantu2^.next2; end; end; procedure cari_obat(var L:obat;x:string); begin new(bantu);bantu:=L; ketemu:=false; while (bantu<>nil) and (ketemu=false) do begin if bantu^.namaobat=x then ketemu:=true; if ketemu=true then writeln(bantu^.namaobat:8,' ',bantu^.kodeobat:8,' ',bantu^.haobat:8:2) else writeln(' Obat tidak tersedia'); bantu:=bantu^.next; end; end; {program utama} begin i:=0; new(awal);awal:=nil; new(akhir);akhir:=nil; new(awal2);awal2:=nil; new(akhir2);akhir2:=nil; new(awal3);awal3:=nil; new(akhir3);akhir3:=nil; repeat begin clrscr; writeln(' +-----+-----+-----+-----+-----+-----+-----+'); writeln(' | PELAYANAN DI APOTIK K28B |'); writeln(' +-----+-----+-----+-----+-----+-----+-----+'); writeln(' | 1. Tambah obat |'); writeln(' + 2. Tambah antrian +'); writeln(' | 3. Pelayanan |'); writeln(' + 4. Tampilkan obat yang tersedia +'); writeln(' | 5. Tampilkan antrian |'); writeln(' | 5. Tampilkan antrian |'); writeln(' + 6. Tampilkan hasil penjualan +'); writeln(' | 7. Tampilkan rekap pendapatan hari ini |'); writeln(' + 8. Cari obat +'); writeln(' | 9. Selesai |'); writeln(' +-----+-----+-----+-----+-----+-----+-----+'); write('pil anda ? : ');readln(pil); case pil of 1: begin if i>15 then writeln('tumpukan sudah penuh') else begin writeln(' MENAMBAH STOCK OBAT'); write('Masukkan Nama obat : ');readln(nmobat); write('Masukkan kode obat : ');readln(kdobat); write('Masukkan Harga : ');readln(hargabaru); tambah_obat(awal,nmobat,hargabaru,kdobat); i:=i+1; cetak_obat(awal); end; end; 2: begin writeln(' TAMBAH PENGANTRI'); write('Masukkan nama pengantri : ');readln(nmbaru); tambah_antri(akhir2,nmbaru); cetak_antri(awal2); end; 3: begin if awal2=nil then writeln('Antrian kosong') else begin begin new(hapus2); hapus2:=awal2; nmbeli:=hapus2^.nama; awal2:=awal2^.next2; dispose(hapus2); end; writeln('saudara ',nmbeli,' ingin membeli obat ? '); cetak_obat(awal);readln(obatbeli); if awal<>nil then begin new(bantu); bantu:=awal; ketemu:=false; if awal^.namaobat=obatbeli then begin new(hapus); hapus:=awal; obatbeli2:=hapus^.namaobat; hargabeli:=hapus^.haobat; awal:=awal^.next; dispose(hapus); writeln('obat ',obatbeli2,' tersedia dan dibeli'); end else if akhir^.namaobat=obatbeli then begin new(bantu);new(hapus); bantu:=awal; while(bantu^.next)^.next<> nil do bantu:=bantu^.next; hapus:=bantu^.next; obatbeli2:=hapus^.namaobat; hargabeli:=hapus^.haobat; akhir:=bantu; akhir^.next:=nil; dispose(hapus); writeln('obat ',obatbeli2,' tersedia dan dibeli'); end else begin while bantu^.next<>nil do begin if(bantu^.next)^.namaobat=obatbeli then begin new(hapus);ketemu:=true; hapus:=bantu^.next; bantu^.next:=hapus^.next; obatbeli2:=hapus^.namaobat; hargabeli:=hapus^.haobat; dispose(hapus); writeln('obat ',obatbeli2,' tersedia dan dibeli'); end; bantu:=bantu^.next; end; end; end; end; new(baru3); baru3^.namaobat3:=obatbeli2; baru3^.haobat3:=hargabeli; baru3^.namaobat3:=nmbeli; if awal3=nil then begin awal3:=baru3; akhir3:=baru3; end else begin baru3^.next3:=awal3; awal3:=baru3;end; i:=i-1; end; 4: cetak_obat(awal); 5: cetak_antri(awal2); 6: cetak_penjualan(awal3); 7: cetak_rekap(awal3); 8: begin writeln(' Mencari obat didalam tumpukan'); write('Masukkan nama obat yang akan dicari : ');readln(nmobat); if awal<>nil then begin cari_obat(awal,nmobat); end else writeln('Obat tidak ada dalam tumpukan'); end; 9: writeln('Terimakasih'); end; readln; end; until pil=9; end.
semogah bermanfaat......jangan lupa iya kalo abis baca tinggalkan komentar anda dibahwa ini.........

ARTIKEL TERKAIT PERLU DIBACA...!/LE'E MOS ARTIKEL NE'E: