CONTOH-CONTOH PROGRAM PASCAL
CONTOH PROGRAM ARRAY
uses crt;
type maju = record
nilai : integer;
ket : string;
end;
var i: integer;
data : array[1..10] of maju;
tnil: integer;
rnil: real;
begin
clrscr;
for i:=1 to 5 do
begin
write ('masukkan data : '); readln(data[i].nilai);
tnil:= tnil + data[i].nilai;
end;
rnil:=tnil/5;
for i:= 1 to 5 do
begin
if (data[i].nilai > rnil) then
begin
data[i].ket := 'BAIK';
end
else
begin
data[i].ket := 'KURANG';
end;
end;
for i:= 1 to 5 do
begin
writeln('nilai : ',data[i].nilai);
writeln('ket : ',data[i].ket);
end;
readln;
end.
CONTOH PROGRAM CASE OF
Program case_of;
uses crt;
var i,j:integer;
begin
clrscr;
write('Tuliskan Bulan (1-12):');
readln(i);
case i of
1:writeln('January');
2:writeln('February');
3:writeln('March');
end;
readln;
end.
CONTOH PROGRAM BERAT IDEAL
Program berat_ideal;
uses crt;
var bi,tb,jk:integer;
begin
clrscr;
write('masukan tinggi badan:');
readln(tb);
write('masukan jenis kelamin(1=pria/0=wanita):');
readln(jk);
if (jk=1) then
begin
bi:=tb-100;
end
else
begin
bi:=tb-110;
end;
write('jenis kelamin:');
writeln(jk);
write('berat ideal:');
writeln(bi);
readln;
end.
CONTOH PROGRAM BILANGAN PRIMA
program bil_prima;
uses crt;
var x,i,s:integer;
begin
clrscr;
write('masukan angka anda:');
readln(x);
i:=1; s:=1;
while s>0 do
begin
i:=i+1;
s:=x mod i;
end;
if (i=x) then
begin
write('Bil Prima');
end
else
begin
write(' bukan bil prima');
end;
readln;
end.
CONTOH PROGRAM FAKTORIAL
program faktorial;
uses crt;
var z,n,i:integer;
begin
clrscr;
z:=1;
write('inputkan n:');
read(n);
for i:=1 to n do
begin
z:=z*i
end;
write(z);
readln;
readln;
end.
CONTOH PROGRAM PERULANGAN
program urut;
uses crt;
var b,k,c:integer;
begin
clrscr;
write('jumlah input:'); read(c);
for b:=1 to c do
begin
for k:=b to c do
write(k);
end;
readln;
readln;
end.
CONTOH PROGRAM FUNCTION DASAR
uses crt;
var i : integer;
begin
clrscr;
function kali(a, b : integer): integer;
begin
kali := a * b;
end;
procedure bagi(a,b : integer;);
var l := real;
begin
l := a / b;
writeln('luas = ', l);
end;
write('Masukkan nilai a '); readln(ac);
write('Masukkan nilain b '); readln(bc);
writeln(' luas ', kali(ac,bc);
bagi(ac,bc);
readkey;
end.
CONTOH PROGRAM GAJI PEGAWAI
Program gaji_pegawai;
uses crt;
var status:string;
jumlah_anak,golongan,gaji_pokok,ti,ta,tj:integer;
begin
clrscr;
write('masukan gaji pokok: '); readln(gaji_pokok);
write('masukan status (m/t): '); readln(status);
write('masukan jumlah anak: '); readln(jumlah_anak);
write('masukan golongan: '); readln(golongan);
if status=m then
ti:=gaji_pokok*0.25
else
ti:=0
end if
if jumlah_anak=1 then
ta:=gaji_pokok*0.5
else
if jumlah_anak=2 then
ta:=gaji_pokok*(0.5*2)
end if
end if
if golongan=a then tj:=gaji_pokok*0.30
else
if golongan=b then tj:=gaji_pokok*0.25
else
if golongan=c then tj:=gaji_pokok*0.15
else
if golongan=d then tj:=gaji_pokok*0.10
end if
write('gaji pokok adalah: '); readln(gaji_pokok);
readln;
end
CONTOH PROGRAM GAME DARI PASCAL
Program Game_Tebak_Kata;
uses crt;
const
havetry=10;
s: array[0..18] of string=
('hello', 'mouse', 'hacher', 'programmer', 'killer', 'facebook', 'twitter',
'email', 'computer', 'pascal', 'algoritma', 'keyboard', 'harddisk', 'software',
'pointblank', 'notebook', 'flasdisk', 'counter-strike', 'pes2010');
var ch: char;
gue,b,nowwrd,trynow: byte;
s1,wrs,alr: string;
r: boolean;
win: integer;
begin
win:=0;
clrscr;
writeln('Game Tebak Kata, ESC untuk keluar');
writeln;
randomize;
repeat
writeln;
nowwrd:=random(18);
s1:=s[nowwrd];
gue:=0;
wrs:='';
alr:='';
trynow:=havetry;
for b:=1 to length(s[nowwrd]) do write('_');
repeat
gotoxy(20,wherey);
write('anda memiliki ',trynow,' kali lagi');
ch:=readkey;
r:=false;
if ch<>#0 then
repeat
b:=pos(ch,s1);
if (b<>0) and (s1[b]<>#0) then
begin
gotoxy(b,wherey);
write(s1[b]);
alr:=alr+ch;
s1[b]:=#0;
gue:=gue+1;
gotoxy(45,wherey);
write(' ');
r:=true;
end else
if (pos(ch,alr)<>0) and (r=false) then
begin
gotoxy(45,wherey);
write(',',ch,' udah dicoba!');
end else
if (b=0) and (r=false) then
begin
trynow:=trynow-1;
alr:=alr+ch;
wrs:=wrs+ch;
gotoxy(60,wherey);
write('salah: ',wrs);
gotoxy(45,wherey);
write(' ');
end;
until (b=0) or (trynow=0);
until (ch=#27) or (gue=length(s1)) or (trynow=0);
if (trynow=0) then
begin
win:=win-1;
delline;
gotoxy(1,wherey);
write(s[nowwrd]);
gotoxy(20,wherey);
write('anda kalah! skor anda: ',win);
end else
if (gue=length(s1)) then
begin
win:=win+1;
delline;
gotoxy(1,wherey);
write(s[nowwrd]);
gotoxy(20,wherey);
write('anda menang! skor anda: ',win);
end;
until ch=#27;
end.
CONTOH PROGRAM GENAP-GANJIL
Program genap_ganjil;
uses crt;
var n,b:integer;
begin
clrscr;
write('masukan angka anda:');
readln(n);
write('masukan angka anda:');
readln(n);
b:=n mod 2;
if b=0 then
begin
write('angka anda genap');
end
else
begin
write('angka anda ganjil');
end;
readln;
readln;
end.
CONTOH PROGRAM JAJAR GENJANG
program luas_jajar_genjang;
uses crt;
var a,t,L:real;
begin
clrscr;
write('Masukan alas jajar genjang:');
readln(a);
write('Masukan tinggi jajar genjang:');
readln(t);
L:=a*t;
write('Luasnya adalah:');
writeln(L:0:2);
readln;
end.
CONTOH PROGRAM LINGKARAN
Program luas_lingkaran;
uses crt;
var r,L:real;
begin
clrscr;
writeln('Program Luas Lingkaran');
write('Masukan jari-jari lingkaran:');
readln(r);
L:=3.14*r*r;
write('Luas lingkaran adalah:');
write(L:0:2);
readln;
end.
CONTOH PROGRAM MATRIKS
program matriks;
uses crt;
var b1,k1,b2,k2,b3,k3:integer;
begin
clrscr;
for b1:=1 to 4 do
for k1:=1 to 3 do
write('masukan b1 :');readln(b1);
write('masukan k1 :');readln(k1);
for b2:=1 to 4 do
for k2:=1 to 3 do
write('masukan b2 :');readln(b2);
write('masukan k2 :');readln(k2);
for b3:=1 to 4 do
for k3:=1 to 3 do
b3:=((b1+k1)+(b2+k2));
k3:=((b1+k1)+(b2+k2));
for b3:=1 to 4 do
write('hasil:','b3','k3');readln(b3,k3);
readln;
end.
CONTOH PROGRAM PROCEDURE
uses crt;
var i : integer;
begin
clrscr;
procedure kali(a, b : integer);
var l := integer;
begin
l := a * b;
writeln('luas = ', l);
end;
procedure bagi(a,b : integer;);
var l := real;
begin
l := a / b;
writeln('luas = ', l);
end;
write('Masukkan nilai a '); readln(ac);
write('Masukkan nilain b '); readln(bc);
kali(ac,bc);
bagi(ac,bc);
readkey;
end.
CONTOH PROGRAM REPEAT UNTIL
program bil_prima;
uses crt;
var x,i,s:integer;
begin
clrscr;
write('masukan angka anda:');
readln(x);
i:=1; s:=1;
repeat
i:=i+1;
s:=x mod i;
until s=0;
if (i=x) then
begin
write('Bil Prima');
end
else
begin
write(' bukan bil prima');
end;
readln;
end.
CONTOH PROGRAM WHILE DO
program while_do;
uses crt;
var x:integer;
begin
clrscr;
x:=1;
while x>0 do
begin
write('masukan nilai x:');
readln(x);
end;
readln;
end.
0 comments:
by Pakto
by misterdarvus
Post a Comment