15 Maret 2021

Contoh Sederhana Program Pascal

{ Contoh 1. Program menggunakan write/writeln }

uses crt;
begin
clrscr; { untuk membersihkan layar monitor }
writeln('AMIK DEPATI PARBO KERINCI');
writeln('Jl. Pancasila No. 29 ');
write('Sungai Penuh');
write(' Telp. 0748-21719');
end.


{ Contoh 2. Program menggunakan write/writeln }

uses crt;
begin
clrscr;
writeln('Nama : Hanafa');
writeln('Alamat : Kerinci');
writeln('Jenis Kelamin : Perempuan');
readkey; { menunggu ditekan sembarang tombol }
end.


{ Contoh 3. program menampilkan warna teks & latar}

uses crt;
begin
textbackground(blue); { untuk menampilkan warna latar belakang }
textcolor(white); { untuk menampilkan warna teks }
clrscr;
writeln('AMIK DEPATI PARBO KERINCI');
writeln('Jl. Pancasila No. 29 ');
write('Sungai Penuh');
write(' Telp. 0748-21719');
end.


{ Contoh 4. Program menggunakan read }

uses crt;
var
nm : string[10]; { mendefenisikan variabel }
alt : string[25];
jekel : char;
begin
clrscr;
write('Nama : ');read(nm);
write('Alamat : ');read(alt);
write('Jenis Kelamin : ');read(jekel);
readkey; { menunggu ditekan sembarang tombol }
end.


{ Contoh 5. Program menggunakan readln }

uses crt;
var
nm : string[10]; { mendefenisikan variabel }
alt : string[25];
jekel : char;
begin
clrscr;
write('Nama : ');readln(nm);
write('Alamat : ');readln(alt);
write('Jenis Kelamin : ');readln(jekel);
readkey;
end.


{ Contoh 6. program menggunakan readln }

uses crt;
var
nilai1,nilai2,hasil : integer;
begin
clrscr;
write('Input Nilai 1 : ');readln(nilai1);
write('Input Nilai 2 : ');readln(nilai2);
hasil := nilai1 + nilai2;
writeln('Hasil Nilai 1 + Nilai 2 = ',hasil);
readkey;
end.


{ Contoh 7. Program menggunakan gotoxy }

uses crt;
var
nm : string[10];
alt : string[25];
jekel : char;
begin
clrscr;
gotoxy(10,10);write('Nama : ');read(nm);
gotoxy(10,11);write('Alamat : ');read(alt);
gotoxy(10,12);write('Jenis Kelamin : ');read(jekel);
readkey;
end.


{ Contoh 8. Program menggunakan readln dan gotoxy }

uses crt;
var
nm : string[10];
alt : string[25];
jekel : char;
begin
clrscr;
gotoxy(5,2);write('Nama : ');readln(nm);
gotoxy(5,3);write('Alamat : ');readln(alt);
gotoxy(5,4);write('Jenis Kelamin : ');readln(jekel);
readkey;
end.


{ Contoh 9. Program menggunakan proses matematika }

uses crt;
var
nilai1,nilai2,hasil : integer;
begin
textbackground(2);
textcolor(0);
clrscr;
gotoxy(5,4);write('Input Nilai 1 : ');readln(nilai1);
gotoxy(5,5);write('Input Nilai 2 : ');readln(nilai2);
hasil := nilai1 * nilai2;
gotoxy(5,6);writeln('Hasil Nilai 1 x Nilai 2 = ',hasil);
readkey;
end.


{ Contoh 10. Program menggunakan if..else dan case .. of }

uses crt;
var
nik : string[9]; alt,nama : string[25];
jekel,sk,gol : char;
ja,mk : integer; gapok : longint;
gaber,tj : real;
begin
clrscr;
writeln(' PT. ANDIKA PUTRA KERINCI');
writeln(' -----------------------------------');
write('Nomor Induk Karyawan : ');readln(nik);
write('Nama Karyawan : ');readln(nama);
write('Alamat : ');readln(alt);
write('Golongan : ');gol := readkey;
writeln;
write('Masa Kerja : ');readln(mk);
if (gol='1') and (mk < 5) then
gapok := 650000
else if (gol='2') and (mk < 5) then
gapok := 750000
else if (gol='3') and (mk < 5) then
gapok := 900000
else if (gol='4') and (mk < 5) then
gapok := 1500000
else if (gol='1') and (mk >= 5) then
gapok := 850000
else if (gol='2') and (mk >= 5) then
gapok := 950000
else if (gol='3') and (mk >= 5) then
gapok := 1250000
else if (gol='4') and (mk >= 5) then
gapok := 1800000;
write('Gaji Pokok : ',gapok:9);
writeln;
write('Jenis Kelamin [L/P] : ');jekel:=readkey;
writeln;
write('Status Keluarga [S/K] : ');sk:=readkey;
writeln;
case sk of
'S','s' : tj := 0;
'K','k' : tj := 0.15 * gapok;
end;
writeln('Tunjangan : ',tj:9:0);
gaber := gapok + tj;
write('Gaji Bersih : ',gaber:9:0);
readkey;
end.


{ Contoh 11. Program menggunakan case..of }

uses crt;
var
nik : string[9]; alt,nama : string[25];
jekel,sk,gol : char;
ja,mk : integer; gapok : longint;
gaber,tj : real;
begin
clrscr;
writeln(' PT. ANDIKA PUTRA KERINCI');
writeln(' -----------------------------------');
write('Nomor Induk Karyawan : ');readln(nik);
write('Nama Karyawan : ');readln(nama);
write('Alamat : ');readln(alt);
write('Golongan : ');gol := readkey;
writeln;
write('Masa Kerja : ');readln(mk);
if (mk < 5) then
begin
case gol of
'1' : gapok := 650000; '2' : gapok := 750000;
'3' : gapok := 900000; '4' : gapok := 1500000;
end;
end;
if mk >= 5 then
begin
case gol of
'1' : gapok := 850000; '2' : gapok := 950000;
'3' : gapok := 1250000; '4' : gapok := 1800000;
end;
end;
write('Gaji Pokok : ',gapok:9);
writeln;
write('Jenis Kelamin [L/P] : ');jekel:=readkey;
writeln;
write('Status Keluarga [S/K] : ');sk:=readkey;
writeln;
case sk of
'S','s' : tj := 0;
'K','k' : tj := 0.15 * gapok;
end;
writeln('Tunjangan : ',tj:9:0);
gaber := gapok + tj;
write('Gaji Bersih : ',gaber:9:0);
readkey;
end.


{ Contoh 12. Program Menggunakan While..Do }
{ Menampilkan angka 1 s/d 20 }

uses crt;
var
i : integer;
begin
clrscr;
i:=1;
while i <= 20 do
begin
writeln(i);
inc(i); {penambahan satu satu}
end;
readkey;
end.


{ Contoh 13. Program Menggunakan Repeat..Until }
{ Menampilkan bilangan genap 1 s/d 20 }

uses crt;
var
i : integer;
begin
clrscr;
i:=2;
repeat
writeln(i);
i:=i+2;
until i > 20;
readkey;
end.


{ Contoh 14. Program Menggunakan For..Do }
{ Menampilkan bilangan ganjil }

uses crt;
var
i : integer;
begin
clrscr;
for i:=1 to 20 do
begin
writeln(i);
i:=i+1;
end;
readkey;
end.


{ Contoh 15. Program Menggunakan For..Do }

uses crt;
var
i : integer;
begin
clrscr;
for i:=1 to 20 do
begin
write(i);
if i mod 2 = 0 then { mod = sisa pembagian }
writeln(‘ Genap’)
else
writeln(‘Ganjil’);
end;
readkey;
end.


{ Contoh 16. Program Menggunakan while … do }

uses crt;
var
i, j : integer;
begin
clrscr; j := 1; i := 1;
while i <= 20 do
begin
write(i:2);
if i mod 2 = 0 then { mod = sisa pembagian }
write(‘ Genap ’)
else
write(‘ Ganjil ’);
if j mod 2 = 0 then
writeln;
i:=i+1; inc(j);
end; readkey;
end.


{ Contoh 17. Program menggunakan While .. do }

uses crt;
var
dc,trf,ttl : real; jml : integer;
nama : string[20]; alamat : string[25];
adl,vtj : char; tj : string[15];
begin
adl:='Y';
while upcase(adl)='Y' do
begin
clrscr;
gotoxy(10,4);write('>> DATA PENUMPANG PESAWAT GARUDA <<');
gotoxy(10,5);write('---------------------------------------------------------');
gotoxy(12,7);write('Nama Penumpang : ');readln(nama);
gotoxy(12,8);write('Alamat : ');readln(alamat);
gotoxy(36,9);write('Orang');
gotoxy(12,9);write('Jumlah Berangkat : ');readln(jml);
gotoxy(12,10);write('Kode Tujuan : ');readln(vtj);
if vtj in ['j','p','b','r','k','J','P','B','R','K'] then
begin
case vtj of
'j','J' : begin
tj := 'Jakarta';
trf:= 450000;
end;
'b','B' : begin
tj := 'Bandung';
trf:= 350000;
end;
'p','P' : begin
tj := 'Padang';
trf:= 200000;
end;
'r','R' : begin
tj := 'Pekan Baru';
trf:= 250000;
end;
'k','K' : begin
tj := 'Kerinci';
trf:= 150000;
end;
end;
gotoxy(12,11);write('Tujuan : ',tj);
gotoxy(12,12);write('Tarif Pesawat : Rp. ',trf:6:0);
if jml >= 3 then
dc := 0.05 * trf * jml
else
dc := 0;
ttl := trf * jml - dc;
gotoxy(12,13);write('Discount : Rp. ',dc:6:0);
gotoxy(12,15);
write('Total Bayar untuk ',jml,' orang = Rp. ',ttl:7:0);
end
else
begin
gotoxy(12,13);write('Kode Tujuan tidak ada .... !!!');
end;
gotoxy(12,16);write('Masih Ada Data Y/T : ');adl:=readkey;
end;
end.


{ Contoh 18. Program menggunakan While .. do }

uses crt;
var
no_rek : string[6];
nm_lang: string[25];
mad,kd_wil,jns_lang : char;
mba,mbi,i,pakai,hrg_air,dana_m,dana_adm : integer;
jml_tagih : longint;
begin
mad := 'Y';
while upcase(mad) = 'Y' do
begin
clrscr;
gotoxy(2,2);write('PDAM DAERAH');
gotoxy(2,3);write('DAFTAR PEMAKAIAN AIR/M3');
gotoxy(2,4);write('------------------------------------');
gotoxy(2,6);write('No_Rek : ');readln(no_rek);
gotoxy(2,7);write('Nama Pelanggan : ');readln(nm_lang);
gotoxy(2,8);write('Kode Wilayah : ');readln(kd_wil);
gotoxy(2,9);write('Jenis Pelanggan : ');readln(jns_lang);
gotoxy(2,10);write('MBA : ');readln(mba);
gotoxy(2,11);write('MBI : ');readln(mbi);
pakai:=mba-mbi;
case jns_lang of
'1' : hrg_air := 150;
'2' : hrg_air := 200;
'3' : hrg_air := 250;
'4' : hrg_air := 275;
end;
case kd_wil of
'a','A' : begin
dana_m := 850;
dana_adm := 1500;
end;
'b','B' : begin
dana_m := 1000;
dana_adm := 1750;
end;
'c','C' : begin
dana_m := 1500;
dana_adm := 2000;
end;
'd','D' : begin
dana_m := 2000;
dana_adm := 2500;
end;
end;
jml_tagih := pakai * hrg_air + dana_m + dana_adm;
clrscr;
gotoxy(2,5);write('PDAM DAERAH X');
gotoxy(2,6);write('DAFTAR REKENING');
gotoxy(2,8);write('Kode_Wil : ',kd_wil);
gotoxy(2,9);write('No_Rek : ',no_rek);
gotoxy(35,9);write('Nama Langganan : ',nm_lang);
gotoxy(2,10); write('------------------------------------------------------------------------------------');
gotoxy(2,11); write(' MBA MBI Terpakai Harga_Air Dana_M Dana_Adm Jml_Tagihan');
gotoxy(2,12); write('------------------------------------------------------------------------------------');
gotoxy(3,13);write(mba:4);
gotoxy(9,13);write(mbi:4);
gotoxy(16,13);write(pakai:4);
gotoxy(28,13);write(hrg_air);
gotoxy(37,13);write(dana_m);
gotoxy(46,13);write(dana_adm);
gotoxy(56,13);write(jml_tagih);
gotoxy(2,14); write('------------------------------------------------------------------------------------');
gotoxy(2,15);write('Ada Lagi Y/T : ');mad:=readkey;
end;
end.


{ Contoh 19. Program mencari nilai Diskriminan }
{ dan penggunaan statement : }
{ sqr -> pangkat dua }
{ sqrt -> akar }

uses crt;
var
A, B, C , D, x1, x2 : real;
begin
clrscr;
writeln('MENGHITUNG PERSAMAAN KUADRAT');
writeln('----------------------------------------------');
writeln;
write('Input Nilai A : ');readln(A);
write('Input Nilai B : ');readln(B);
write('Input Nilai C : ');readln(C);
writeln;
if A = 0 then
exit
else
begin
D := sqr(B)-4*A*C;
if D < 0 then
writeln('Akar tidak nyata')
else
begin
if D = 0 then
begin
x1 := -B / 2 * A; x2 := -B / 2 * A;
end
else
begin
x1 := (-B+sqrt(D))/2 * A;
x2 := (-B-sqrt(D))/2 * A;
end;
writeln('Nilai X1 = ',x1:4:2);
writeln('Nilai X2 = ',x2:4:2);
end;
end;
readln;
end.


{ Contoh 20. Program menggunakan Repeat .. until }

uses crt;
var
dc,trf,ttl : real; jml : integer;
nama : string[20]; alamat : string[25];
adl,vtj : char; tj : string[15];
begin
adl:='Y';
repeat
clrscr;
gotoxy(10,4);write('>> DATA PENUMPANG PESAWAT GARUDA <<');
gotoxy(10,5);write('---------------------------------------------------------');
gotoxy(12,7);write('Nama Penumpang : ');readln(nama);
gotoxy(12,8);write('Alamat : ');readln(alamat);
gotoxy(36,9);write('Orang');
gotoxy(12,9);write('Jumlah Berangkat : ');readln(jml);
gotoxy(12,10);write('Kode Tujuan : ');readln(vtj);
if vtj in ['j','p','b','r','k','J','P','B','R','K'] then
{ in digunakan apakah karakter yang kita inputkan ada dalam …..}
begin
case vtj of
'j','J' : begin
tj := 'Jakarta';
trf:= 450000;
end;
'b','B' : begin
tj := 'Bandung';
trf:= 350000;
end;
'p','P' : begin
tj := 'Padang';
trf:= 200000;
end;
'r','R' : begin
tj := 'Pekan Baru';
trf:= 250000;
end;
'k','K' : begin
tj := 'Kerinci';
trf:= 150000;
end;
end;
gotoxy(12,11);write('Tujuan : ',tj);
gotoxy(12,12);write('Tarif Pesawat : Rp. ',trf:6:0);
if jml >= 3 then
dc := 0.05 * trf * jml
else
dc := 0;
ttl := trf * jml - dc;
gotoxy(12,13);write('Discount : Rp. ',dc:6:0);
gotoxy(12,15);
write('Total Bayar untuk ',jml,' orang = Rp. ',ttl:7:0);
end
else
begin
gotoxy(12,13);write('Kode Tujuan tidak ada .... !!!');
end;
gotoxy(12,16);write('Masih Ada Data Y/T : ');adl:=readkey;
until upcase(adl)='T';
end.


{ Contoh 21. Program menggunakan while..do dan case .. of }

uses crt;
var
nik : string[9]; alt,nama : string[25];
mad,jekel,sk,gol : char;
ja,mk : integer; gapok : longint;
gaber,tj : real;
begin
mad := 'Y';
while (upcase(mad)='Y') do
begin
clrscr;
writeln(' PT. ANDIKA PUTRA KERINCI');
writeln(' -----------------------------------');
write('Nomor Induk Karyawan : ');readln(nik);
write('Nama Karyawan : ');readln(nama);
write('Alamat : ');readln(alt);
write('Golongan : ');gol := readkey;
writeln;
write('Masa Kerja : ');readln(mk);
if (mk < 5) then
begin
case gol of
'1' : gapok := 650000; '2' : gapok := 750000;
'3' : gapok := 900000; '4' : gapok := 1500000;
end;
end;
if mk >= 5 then
begin
case gol of
'1' : gapok := 850000; '2' : gapok := 950000;
'3' : gapok := 1250000; '4' : gapok := 1800000;
end;
end;
write('Gaji Pokok : ',gapok:9);
writeln;
write('Jenis Kelamin [L/P] : ');jekel:=readkey;
writeln;
write('Status Keluarga [S/K] : ');sk:=readkey;
writeln;
case sk of
'S','s' : tj := 0;
'K','k' : tj := 0.15 * gapok;
end;
writeln('Tunjangan : ',tj:9:0);
gaber := gapok + tj;
write('Gaji Bersih : ',gaber:9:0);
writeln;
write('Masih Ada Data [Y/T] : ');mad:=readkey;
end;
end.


{ Contoh 22. Program menggunakan repeat .. until }

uses crt;
var
nik : string[9]; alt,nama : string[25];
mad,jekel,sk,gol : char;
ja,mk : integer; gapok : longint;
gaber,tj : real;
begin
mad := 'Y';
repeat
clrscr;
writeln(' PT. ANDIKA PUTRA KERINCI');
writeln(' -----------------------------------');
write('Nomor Induk Karyawan : ');readln(nik);
write('Nama Karyawan : ');readln(nama);
write('Alamat : ');readln(alt);
write('Golongan : ');gol := readkey;
writeln;
write('Masa Kerja : ');readln(mk);
if (mk < 5) then
begin
case gol of
'1' : gapok := 650000; '2' : gapok := 750000;
'3' : gapok := 900000; '4' : gapok := 1500000;
end;
end;
if mk >= 5 then
begin
case gol of
'1' : gapok := 850000; '2' : gapok := 950000;
'3' : gapok := 1250000; '4' : gapok := 1800000;
end;
end;
write('Gaji Pokok : ',gapok:9);
writeln;
write('Jenis Kelamin [L/P] : ');jekel:=readkey;
writeln;
write('Status Keluarga [S/K] : ');sk:=readkey;
writeln;
case sk of
'S','s' : tj := 0;
'K','k' : tj := 0.15 * gapok;
end;
writeln('Tunjangan : ',tj:9:0);
gaber := gapok + tj;
write('Gaji Bersih : ',gaber:9:0);
writeln;
write('Masih Ada Data [Y/T] : ');mad:=readkey;
until (upcase(mad)='T');
end.


{ Contoh 23. Program menggunakan if..else dan case .. of }

uses crt;
var
nik : string[9]; alt,nama : string[25];
jekel,sk,gol : char;
ja,mk : integer; gapok : longint;
gaber,ta,ti,ts,pot : real;
begin
clrscr;
gotoxy(15,02);writeln('PT. ANDIKA PUTRA KERINCI');
gotoxy(15,03);writeln(' ENTRY DATA KARYAWAN ');
gotoxy(15,04);writeln('-----------------------------------');
gotoxy(10,05);write('Nomor Induk Karyawan : ');readln(nik);
gotoxy(10,06);write('Nama Karyawan : ');readln(nama);
gotoxy(10,07);write('Alamat : ');readln(alt);
gotoxy(10,08);write('Golongan : ');gol := readkey;
gotoxy(10,09);write('Jenis Kelamin [L/P] : ');jekel := readkey;
gotoxy(10,10);write('Status Keluarga [S/K] : ');sk := readkey;
if upcase(sk)='K' then
begin
gotoxy(10,11);write('Jumlah Anak : ');readln(ja);
end
else
ja := 0;
clrscr;
if gol = '1' then
begin
gapok := 650000;
pot := 0;
end
else if gol = '2' then
begin
gapok := 750000;
pot := 0.05 * gapok;
end
else if gol = '3' then
begin
gapok := 900000;
pot := 0.07 * gapok;
end
else if gol = '4' then
begin
gapok := 1500000;
pot := 0.1 * gapok;
end;
ts:=0;ti:=0;
if jekel in ['L','l'] then
begin
case sk of
'K','k' : begin
ts := 0.1 * gapok;
ta := 0.1 * gapok;
end;
'D','d' : begin
ts := 0; ta := 0.05 * gapok;
end;
'S','s' : begin
ts := 0; ta := 0;
end;
end;
end
else if jekel in ['P','p'] then
begin
case sk of
'K','k' : begin
ti := 0.07 * gapok;
ta := 0.1 * gapok;
end;
'J','j' : begin
ti := 0; ta := 0.1 * gapok;
end;
'S','s' : begin
ti := 0; ta := 0;
end;
end;
end;
gaber := gapok + (ta * ja) + ti + ts - pot;
gotoxy(23,02);write(' SLIP GAJI KARYAWAN');
gotoxy(23,03);write('PT. ANDIKA PUTRA KERINCI');
gotoxy(10,05);write('NIK : ',nik);
gotoxy(39,05);write('Gol : ',gol);
gotoxy(10,06);write('Nama : ',nama);
gotoxy(39,06);write('Gaji Pokok : ',gapok:-9);
gotoxy(10,07);write('--------------------------------------------------------');
gotoxy(10,08);write('| Tunjangan | |');
gotoxy(10,09);write('----------------------------------- Potongan |');
gotoxy(10,10);write('| Anak | Istri | Suami | |');
gotoxy(10,11);write('------------------------------------------------------|');
gotoxy(10,12);write('| | | | |');
gotoxy(12,12);write(ta:9:0);
gotoxy(26,12);write(ti:9:0);
gotoxy(38,12);write(ts:9:0);
gotoxy(51,12);write(pot:9:0);
gotoxy(10,13);write('------------------------------------------------------|');
gotoxy(10,14);write('| Gaji Bersih | |');
gotoxy(51,14);write(gaber:9:0);
gotoxy(10,15);write('--------------------------------------------------------');
readkey;
end.