Kumpulan Contoh Source Coding Pemrograman Pascal Untuk Pemula

            Bissmilah ,, hello , soudara saudari sekalian , kita bertemu lagi ,, oke pada kesempatan hari ini ane akan memberikan kumpulan contoh program pascal yang insya Allah bermaanfaat ,, disini ada berbagai macam contoh pemrograman yang banyak dijumpai diperkuliahan ,, terutama bagi anak informatika yang nanti mebutuhkan contoh ,, karena pascal memang lumanyan sulit hehehe , oke langsung saja lah download kumpulan coding pemrograman pascal dibawah ini :

Download Contoh Program Pascal 1 DISINI

Download Contoh Program Pascal 2 DISINI

ya mungkin itu dulu yang bisa ane berikan ,, semoga bisa bermaanfaat bagi saudara sekalian ,, dan selamat belajar pemrograman pascal Good Luck ,,.. sampai jumpa di postingan selanjutnya , Ganbatte !!!

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.

Array Matriks

disini saya akan memberikan sebuah program Array Matriks yang sudah saya pelajari dikampus ,, silahkan di cermati .


uses crt; type matrix=array[1..10,1..10] of integer; var A,B,hasil:matrix; i,j,ba,ka,bb,kb:byte; pil:1..8; procedure isi_matrix(var x:matrix;m,n:byte); begin for i:=1 to m do begin for j:=1 to n do begin write('isi elemen ke ke [',i,',',j,'] => '); readln(x[i,j]); end; end; end; procedure tampil(var x:matrix;m,n:byte); begin for i:=1 to m do begin for j:=1 to n do write(x[i,j]:5); writeln; end; end; procedure kurang (var x,y:matrix;m,n:byte); begin for i:=1 to m do begin for j:=1 to n do hasil[i,j]:=x[i,j]-y[i,j]; end; end; procedure tambah (var x,y:matrix;m,n:byte); begin for i:=1 to m do begin for j:=1 to n do hasil[i,j]:=x[i,j]+y[i,j]; end; end; {program utama} begin repeat; clrscr; begin writeln('operasi-operasi matrix'); writeln('1. isi matrix A'); writeln('2. isi matrix B'); writeln('3. A+B'); writeln('4. A-B'); writeln('5. B-A'); writeln('6. A transpose'); writeln('7. B transpose'); writeln('8. selesai'); write('masukan pilihan anda : ');readln(pil); case pil of 1: begin write('mengisi matrix A, masukan baris A => ');readln(ba); write('masukan kolom matrix A = ');readln(ka); isi_matrix(A,ba,ka); writeln('matrix A adalah '); tampil(A,ba,ka); end; 2: begin write('mengisi matrix B, masukan baris B => ');readln(bb); write('masukan kolom matrix B = ');readln(kb); isi_matrix(B,bb,kb); writeln('matrix B adalah '); tampil(B,bb,kb); end; 3: begin if (ka=kb) and (ba=bb) then begin writeln('matrix A : '); tampil(A,ba,ka); write('matriks B: '); tampil(B,bb,kb); writeln('hasil A+B adlah '); tambah(A,B,ba,ka); tampil(hasil,ba,ka); end else writeln(' operasi A-B tidak bisa dilakukan karena orde berbeda '); end; 4:begin if (ka=kb) and (ba=bb) then begin writeln('matrix A : '); tampil(A,ba,ka); write('matriks B: '); tampil(B,bb,kb); writeln('hasil A-B adlah '); kurang(A,B,ba,ka); tampil(hasil,ba,ka); end else writeln(' operasi A-B tidak bisa dilakukan karena orde berbeda '); end; 5: begin if (ba=bb) and (ka=kb) then begin writeln('matrix A : '); tampil(A,ba,ka); write('matriks B: '); tampil(B,bb,kb); writeln('hasil B-A adlah '); kurang(B,A,ba,ka); tampil(hasil,ba,ka); end else writeln(' operasi b-A tidak bisa dilakukan karena orde berbeda '); end; 6:writeln('anda memilih no 6'); 7:writeln('anda memilih no 7'); 8:writeln('selesai'); end; readln; end until(pil=8);
 = pengunjung yang baik selalu meninggalkan jejak :)

Contoh Program Pascal kalkulator sederhana

uses crt;
var a,b:integer;
    hasil1:longint;
    hasil2:real;

begin
writeln('kalkulator mini');

write('masukkan bilangan bulat a= ');readln(a);
write('masukkan bilangan bulat b= ');readln(b);
hasil1:=a+b;
writeln('hasil ',a,' + ',b,' = ',hasil1);
hasil1:=a-b;
writeln('hasil ',a,' - ',b,' = ',hasil1);
hasil1:=b-a;



writeln('hasil ',b,' - ',a,' = ',hasil1);
hasil1:=a*b;
writeln('hasil ',a,' * ',b,'= ',hasil1);
hasil2:=a/b;
writeln('hasil ',a,'/ ',b,' = ',hasil2:4:2);
hasil2:=b/a;
writeln('hasil ',b,'/ ',a,' = ',hasil2:4:2);
hasil2:=sqrt(a);
writeln('hasil akar a= ',hasil2:4:2);
hasil2:=sqrt(b);
writeln('hasil akar b= ',hasil2:4:2);
hasil2:=sqr(a);
writeln('hasil pangkat a= ',hasil2:4:2);
hasil2:=sqr(b);
writeln('hasil pangkat b= ',hasil2:4:2);

end.