Contoh Program Pascal Tiket Sepak bola

oke postingan selanjutnya yaitu membuat program tentang penjualan tiket sepak bola  ,, ok langsung saja cekidot ?!

uses crt; const max=10000; type pointer1=^antrian; antrian=record orang:string; next1:pointer1; end; type pointer2=^tiket; tiket=record tharga:longint; jumtiket:byte; nama,kategori:string; next2:pointer2; end; var awal1,akhir1,bantu1,hapus,baru1:pointer1; awal2,akhir2,bantu2,baru2:pointer2; pil,pil2:byte; ketemu:boolean; noambil,namahapus:string; ka,na:string; ht,hasil,jtiket,jumpem,byar,kem,kem2:longint; jt:byte; label ulang,meneh,lagi; function jumnode(L:pointer1):longint; var jn:byte; begin new(bantu1); bantu1:=L; jn:=0; while bantu1<>nil do begin inc(jn); bantu1:=bantu1^.next1; end; jumnode:=jn; end; function full(L:pointer1):boolean; begin if jumnode(L)=max then full:=true else full:=false; end; procedure pushq(var L:pointer1;x:string); begin new(baru1); baru1^.orang:=x; baru1^.next1:=nil; if L=nil then begin L:=baru1; akhir1:=baru1; end else begin akhir1^.next1:=baru1; akhir1:=baru1; end; end; procedure popq(var L:pointer1); begin new(hapus); if L=nil then begin hapus:=L; noambil:=L^.orang; L:=nil; dispose(hapus); end else begin hapus:=L; noambil:=hapus^.orang; L:=L^.next1; dispose(hapus); end; end; procedure cetak_antrian(var L:pointer1); var jn:byte; begin new(bantu1); bantu1:=l; jn:=0; writeln;writeln; writeln(' +++ DAFTAR PENGANTRI TIKET +++ '); writeln(' ====================================='); writeln(' | No | Nama |'); writeln(' --------------------------------------'); while bantu1<>nil do begin inc(jn); writeln(' ',jn:4,' ',bantu1^.orang:10); bantu1:=bantu1^.next1; end; writeln(' --------------------------------------'); end; procedure simpan_pembelian(var k:pointer2; x,y:string; j:byte ; t:longint); begin new(baru2); baru2^.nama:=x; baru2^.kategori:=y; baru2^.jumtiket:=j; baru2^.tharga:=t; baru2^.next2:=nil; if K=nil then begin K:=baru2; akhir2:=baru2; end else begin akhir2^.next2:=baru2; akhir2:=baru2; end; end; procedure cetak_pembelian(var K:pointer2); var jn:byte; begin new(bantu2); bantu2:=K; jn:=0; writeln;writeln; writeln(' ++++++ DAFTAR PEMBELIAN TIKET ++++++ '); writeln(' ------------------------------------------------------------------------------------'); writeln(' |No | Nama | Kategori | Jumlah Tiket | Total bayar '); writeln(' ------------------------------------------------------------------------------------'); while bantu2<>nil do begin inc(jn); writeln(jn:3,' ',bantu2^.nama:13,' ',bantu2^.kategori:20,' ',bantu2^.jumtiket:13,' ','Rp ',bantu2^.tharga:3); bantu2:=bantu2^.next2; end; writeln('-------------------------------------------------------------------------------------'); end; procedure cetak_pembelian2(var K:pointer2;x:string); var jn:byte; begin new(bantu2); bantu2:=K; jn:=0; writeln;writeln; writeln(' ++++++ DAFTAR PEMBELIAN TIKET ++++++ '); writeln(' -----------------------------------------------------------------------------------'); writeln(' |No | Nama | Kategori | Jumlah Tiket | Total bayar '); writeln(' -----------------------------------------------------------------------------------'); while bantu2<>nil do begin if bantu2^.kategori=x then begin inc(jn); writeln(jn:3,' ',bantu2^.nama:13,' ',bantu2^.kategori:20,' ',bantu2^.jumtiket:13,' ','Rp ',bantu2^.tharga:3); end; bantu2:=bantu2^.next2; end; writeln('-------------------------------------------------------------------------------------'); end; procedure hapus_awal(var L:pointer1); begin new(hapus); hapus:=L; awal1:=awal1^.next1; dispose(hapus); end; procedure hapus_akhir(var L:pointer1); begin new(bantu1);new(hapus); bantu1:=L; {mengecek next dari node yg ditunjuk oleh bantu^.next } while (bantu1^.next1)^.next1 <> nil do bantu1:=bantu1^.next1; hapus:=bantu1^.next1; akhir1:=bantu1; akhir1^.next1:=nil; dispose(hapus); end; procedure hapus_nama(var L:pointer1;x:string); begin new(bantu1); bantu1:=L; ketemu:=false; if (l^.orang=x) then begin ketemu:=true; hapus_awal(L) end else if (akhir1^.orang=x) then begin ketemu:=true; hapus_akhir(L);end else begin while (bantu1^.next1<>nil) do begin if ((bantu1^.next1)^.orang=x) then begin new(hapus); ketemu:= true; hapus:=bantu1^.next1; bantu1^.next1:=hapus^.next1; dispose(hapus); end; bantu1:=bantu1^.next1; end; end; end; procedure rekap(k:pointer2); begin new(bantu2); bantu2:=K; writeln;writeln; writeln(' ++++++ REKAP PENJUALAN ++++++ '); writeln(' --------------------------------------------------------------------------------------'); writeln(' | Total pembeli | Total Penjualan Tiket | Total Pendapatan'); writeln(' --------------------------------------------------------------------------------------'); begin writeln(' ',jumpem:18,' ',jtiket:21,' ','Rp ',hasil:13); bantu2:=bantu2^.next2; end; writeln(' --------------------------------------------------------------------------------------'); end; begin new(awal1);new(akhir1);awal1:=nil;akhir1:=nil; new(awal2);new(akhir2);awal2:=nil;akhir2:=nil; repeat begin ulang: clrscr; writeln;writeln; writeln(' INDONESIA VS BELANDA '); writeln(' ------------------------------------------- '); writeln(' ++++ LOKET 1 ++++ '); writeln(' ======================================== '); writeln(' | PEMBELIAN TIKET SEPAK BOLA Std. GBK |'); writeln(' ---------------------------------------- '); writeln(' 1. Antrian '); writeln(' 2. Layanan Pembelian Tiket'); writeln(' 3. Cetak '); writeln(' 4. Tutup Pembelian '); writeln; writeln(' ______________________________________________'); write(' | Masukkan Pilihan Anda (1-4) => ');readln(pil); writeln(' ============================================= '); case pil of 1: begin clrscr; writeln(' ++++++ ANTRIAN +++++ '); writeln(' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '); writeln(' 1. Masuk Antrian '); writeln(' 2. Keluar, Jika Bosen '); writeln(' 3. Menu Utama '); writeln(' ________________________'); write(' pilihan anda (1-3) >>> ');readln(pil2); writeln;writeln; case pil2 of 1: begin if not full(awal1) then begin writeln(' -- Masuk Antrian Tiket -- '); writeln(' ====================================='); write(' masukan nama yang akan mengantri : ');readln(na); pushq(awal1,na); end else writeln('Maaf Nomor Antrian Habis'); end; 2: begin writeln(' ==== Keluar , Jika Bosen ....... ==='); if awal1 <> nil then begin cetak_antrian(awal1); write(' siapa pengantri yang ingin di keluar : ');readln(namahapus); hapus_nama(awal1,namahapus); writeln;writeln('setelah ',namahapus,' keluar dari antrian menjadi '); writeln; cetak_antrian(awal1) end else writeln(' antrian sudah kosong '); if (awal1 <> nil ) and (not ketemu) then writeln(' nama ',namahapus,' tidak ditemukan '); end; 3: goto ulang; end; end; 2: begin if awal1<>nil then begin clrscr; writeln;writeln(' -------- PILIHAN TIKET ------- '); writeln(' ================================ '); writeln(' | VVIP Rp. 1.750.000 |'); writeln(' | VIP Rp. 1.500.000 |'); writeln(' | Kelas I Rp. 300.000 |'); writeln(' | Kelas II Rp. 150.000 |'); writeln(' | Tribun Atas Rp. 50.000 |'); writeln(' ================================ '); popq(awal1); writeln; writeln(' Melayani Antrian dengan saudara ',noambil); inc(jumpem); lagi: write(' pilih kategori/tiket : ');readln(ka); write(' akan membeli berapa tiket : ');readln(jt); if ka='vvip' then begin ht:=1750000*jt; writeln(' anda harus membayar Rp ',ht); end else if ka='vip' then begin ht:=1500000*jt; writeln(' anda harus membayar Rp ',ht); end else if ka='kelas 1' then begin ht:=300000*jt; writeln(' anda harus membayar Rp ',ht); end else if ka='kelas 2' then begin ht:=150000*jt; writeln(' anda harus membayar Rp ',ht); end else if ka='tribun atas' then begin ht:=50000*jt; writeln(' anda harus membayar Rp ',ht); end else begin writeln(' an5da salah memasukan data/kategori, ulangi ?!'); goto lagi; end; meneh: write(' Bayar : ');readln(byar); if byar>=ht then begin kem:=byar-ht; writeln(' Kembalian : ',kem); end else begin kem2:=ht-byar; writeln(' uang anda kurang ',kem2,' arep ngutang po, ulangi !?'); goto meneh; end; jtiket:=jtiket+jt; hasil:=hasil+ht; simpan_pembelian(awal2,noambil,ka,jt,ht); end else writeln('Tidak ada Pengantre yang bisa dilayani'); end; 3: begin clrscr; writeln(' ===== Pencetakan Tiket ==== '); writeln(' 1. Cetak antrian'); writeln(' 2. Cetak pembelian tiket'); writeln(' 3. Cetak Daftar pembeli VVIP'); writeln(' 4. Cetak Daftar pembeli VIP'); writeln(' 5. Cetak Daftar pembeli kelas I'); writeln(' 6. Cetak Daftar pembeli kelas II'); writeln(' 7. Cetak Daftar pembeli Tribun Atas'); writeln(' 8. Rekap Penjualan Tiket '); writeln(' 9. Kembali menu'); write(' pilih 1-9 ===> ');readln(pil2); case pil2 of 1:begin if awal1<>nil then cetak_antrian(awal1) else writeln('Tidak ada yang sedang mengantre'); end; 2: if awal2<>nil then cetak_pembelian(awal2) else writeln('Belum Ada pembeli'); 3: begin if awal2<>nil then begin ka:='vvip'; cetak_pembelian2(awal2,ka) end else writeln('Tidak ada yang bisa dicetak'); end; 4: begin if awal2<>nil then begin ka:='vip'; cetak_pembelian2(awal2,ka) end else writeln('Tidak ada yang bisa dicetak'); end; 5: begin if awal2<>nil then begin ka:='kelas 1'; cetak_pembelian2(awal2,ka) end else writeln('Tidak ada yang bisa dicetak'); end; 6: begin if awal2<>nil then begin ka:='kelas 2'; cetak_pembelian2(awal2,ka) end else writeln('Tidak ada yang bisa dicetak'); end; 7: begin if awal2<>nil then begin ka:='tribun atas'; cetak_pembelian2(awal2,ka) end else writeln('Tidak ada yang bisa dicetak'); end; 8: if jumpem <> 0 then rekap(awal2) else writeln(' belum ada penjualan'); 9: goto ulang; end; end; 4: begin if awal1=nil then begin writeln;writeln;writeln(' ~~~~~~~~ Terimakasih Selamat menonton ~~~~~~~ '); writeln(' ++++++ biarpun indonesia kalah masih ada hari esok ++++++++++'); writeln(' Coming Soon Indonesia VS Arsenal 14 Juli 2013 ') end else begin writeln(' tidak boleh ditutup, masih ada pengantri '); readln; goto ulang; end; end; end; readln; end; until (pil=4); end.