Wednesday 15 January 2014
FUNGSI IF
PROGRAM PASCAL DATA PEGAWAI MENGGUNAKAN IF
Program dp;
uses wIncrt;
var np,nm,g:string[25];
t,h,gp,gk,gb :reaL;
u:char;
Begin
REPEAT
CLRSCR;
Write('nip = ');readln(np);
Write('nama = ');readln(nm);
Write('golongan = ');readln(g);
Write('tunjangan= ');readln(t);
Write('hutang = ');readln(h);
(*rumus*)
if g = 'IIIB' THEN BEGIN GP:=2000000 END
ELSE IF G = 'iiib'THEN BEGIN GP:= 2000000 END
ELSE GP:= 1500000;
GK:= GP + T;
GB:= GP - H;
WRITELN(' GAJI POKOK : ',GP:0:0);
WRITELN(' GAJI KOTOR : ',GK:0:0);
WRITELN(' GAJI BERSIH : ',GB:0:0);
writeln('masukan data kembali [Y/T] ' ); READLN (U);
UNTIL UPCASE (U) <> 'Y';
End.
Program dp;
uses wIncrt;
var np,nm,g:string[25];
t,h,gp,gk,gb :reaL;
u:char;
Begin
REPEAT
CLRSCR;
Write('nip = ');readln(np);
Write('nama = ');readln(nm);
Write('golongan = ');readln(g);
Write('tunjangan= ');readln(t);
Write('hutang = ');readln(h);
(*rumus*)
if g = 'IIIB' THEN BEGIN GP:=2000000 END
ELSE IF G = 'iiib'THEN BEGIN GP:= 2000000 END
ELSE GP:= 1500000;
GK:= GP + T;
GB:= GP - H;
WRITELN(' GAJI POKOK : ',GP:0:0);
WRITELN(' GAJI KOTOR : ',GK:0:0);
WRITELN(' GAJI BERSIH : ',GB:0:0);
writeln('masukan data kembali [Y/T] ' ); READLN (U);
UNTIL UPCASE (U) <> 'Y';
End.
Monday 6 January 2014
kumpulan contoh pascal 2
a. median
Program median;
Uses Wincrt;
Var
x: array [1..100] of integer;
n,i,pos:integer;
md:real;
lagi:char;
Begin
lagi:='y';
while lagi='y' do
begin
writeln('=============');
Writeln('Program median');
Writeln('=============');
Writeln;
writeln('*dalam program mini ini, data yang harus dimasukkan nanti harus sudah urut*');
writeln;
Write('Masukkan Jumlah Data (n): ');
readln(n);
clrscr;
Writeln;
For i:= 1 to n do
Readln(x[i]);
Writeln;
For i:= 1 to n do
if (n mod 2 = 1) then
begin
pos:=(n div 2)+1;
md:=x[pos];
end
else
begin
pos:=(n div 2);
md:=(x[pos]+x[pos+1])/2;
end;
writeln;
Writeln('Median dari data berjumlah ', n,' tadi adalah : ',md:4:2);
writeln;
writeln('*terimakasih sudah menggunakan program ini*');
writeln('hitung lagi?');
readln(lagi);
end;
End.
b. mean
program rata_rata;
uses wincrt;
var
i,n: integer;
x,sum,mean:real;
begin
write('banyaknya data = ');
readln(n);
sum:=0;
for i:=1 to n do
begin
writeln('data ke',i,'=');
readln(x);
sum:=sum+x;
end;
mean:=sum/n;
writeln('rata-rata = ',mean:9:4);
end.
c.binominal
program binomial;
uses wincrt;
var
i,j,k,n,x:longint;
a,b,c,d,e,p:real;
begin
writeln('nilai n = ');readln(n);
writeln('nilai x dari n = ');readln(x);
writeln('peluang sukses p = ');readln(p);
a:=1;
b:=1;
c:=1;
d:=1;
e:=1;
for i:=1 to n do
a:=a*i;
for j:=1 to x do
begin
b:=b*j;
c:=c*p;
end;
for k:=1 to (n-x) do
begin
d:=d*k;
e:=e*(1-p);
end;
writeln(a/(b*d)*c*e:0:4);
end.
Program median;
Uses Wincrt;
Var
x: array [1..100] of integer;
n,i,pos:integer;
md:real;
lagi:char;
Begin
lagi:='y';
while lagi='y' do
begin
writeln('=============');
Writeln('Program median');
Writeln('=============');
Writeln;
writeln('*dalam program mini ini, data yang harus dimasukkan nanti harus sudah urut*');
writeln;
Write('Masukkan Jumlah Data (n): ');
readln(n);
clrscr;
Writeln;
For i:= 1 to n do
Readln(x[i]);
Writeln;
For i:= 1 to n do
if (n mod 2 = 1) then
begin
pos:=(n div 2)+1;
md:=x[pos];
end
else
begin
pos:=(n div 2);
md:=(x[pos]+x[pos+1])/2;
end;
writeln;
Writeln('Median dari data berjumlah ', n,' tadi adalah : ',md:4:2);
writeln;
writeln('*terimakasih sudah menggunakan program ini*');
writeln('hitung lagi?');
readln(lagi);
end;
End.
b. mean
program rata_rata;
uses wincrt;
var
i,n: integer;
x,sum,mean:real;
begin
write('banyaknya data = ');
readln(n);
sum:=0;
for i:=1 to n do
begin
writeln('data ke',i,'=');
readln(x);
sum:=sum+x;
end;
mean:=sum/n;
writeln('rata-rata = ',mean:9:4);
end.
c.binominal
program binomial;
uses wincrt;
var
i,j,k,n,x:longint;
a,b,c,d,e,p:real;
begin
writeln('nilai n = ');readln(n);
writeln('nilai x dari n = ');readln(x);
writeln('peluang sukses p = ');readln(p);
a:=1;
b:=1;
c:=1;
d:=1;
e:=1;
for i:=1 to n do
a:=a*i;
for j:=1 to x do
begin
b:=b*j;
c:=c*p;
end;
for k:=1 to (n-x) do
begin
d:=d*k;
e:=e*(1-p);
end;
writeln(a/(b*d)*c*e:0:4);
end.
kumpulan contoh pascal latihan 1
a. program konversi
program konversi;
uses wincrt ;
var
biner,desimal,sisa,b: integer ;
begin
desimal:=0; b:= 1;
writeln('Masukkan bilangan biner :');
readln(biner);
repeat
sisa := biner mod 10;
biner := biner div 10;
desimal := desimal + sisa * b;
b:= b*2;
until
biner =0;
writeln('Hasil konversi ke desimal adalah : ');
writeln(desimal);
end.
b. program deret aritmatika
program deret_aritmatika;
uses wincrt;
var
a,b,n,u:integer;
s:real;
begin
writeln('PROGRAM DERET ARITMATIKA');
writeln('————————');
write('a = ');readln(a);
write('b = ');readln(b);
write('n = ');readln(n);
s:=n*((2*a)+((n-1)*b))/2;
u:=a+((n-1)*b);
writeln('Un= ',u);
writeln('Sn= ',s:10:2);
end.
c. program deret fionacci
program deret_fibonacci;
uses wincrt;
function fibonacci(n:integer):integer;
begin
if n=0 then fibonacci:=0
else
if n=1 then fibonacci:=1
else
fibonacci:=fibonacci(n-1)+fibonacci(n-2);
end;
var
n, jumlah:integer;
begin
Write('Masukkan bilangan: ');readln(n);
for n:= 1 to n do
Writeln('Deret Fibonacci ke-',n,' adalah: ',fibonacci(n));
for n:= 1 to n do
jumlah:=fibonacci(n) + fibonacci(n)+ fibonacci(n-1)-1;
writeln('==================================');
writeln('jumlah fibonacci ke-’,n,’ adalah: ',jumlah);
readkey;
donewincrt;
end.
d. program deret
Program Deret;
Uses winCrt;
Var
a,b,n:integer;
begin
a:=1;
b:=1;
write('Jumlah Digit Deret yang anda inginkan: '); readln(n);
writeln;
while (b<=n) do
begin
write(a,' ');
a:=a+2 ;
b:=b+1 ;
end;
writeln;
writeln;
writeln('Jumlah seluruh deretnya adalah : ',sqr(n));
readln;
end.
program konversi;
uses wincrt ;
var
biner,desimal,sisa,b: integer ;
begin
desimal:=0; b:= 1;
writeln('Masukkan bilangan biner :');
readln(biner);
repeat
sisa := biner mod 10;
biner := biner div 10;
desimal := desimal + sisa * b;
b:= b*2;
until
biner =0;
writeln('Hasil konversi ke desimal adalah : ');
writeln(desimal);
end.
b. program deret aritmatika
program deret_aritmatika;
uses wincrt;
var
a,b,n,u:integer;
s:real;
begin
writeln('PROGRAM DERET ARITMATIKA');
writeln('————————');
write('a = ');readln(a);
write('b = ');readln(b);
write('n = ');readln(n);
s:=n*((2*a)+((n-1)*b))/2;
u:=a+((n-1)*b);
writeln('Un= ',u);
writeln('Sn= ',s:10:2);
end.
c. program deret fionacci
program deret_fibonacci;
uses wincrt;
function fibonacci(n:integer):integer;
begin
if n=0 then fibonacci:=0
else
if n=1 then fibonacci:=1
else
fibonacci:=fibonacci(n-1)+fibonacci(n-2);
end;
var
n, jumlah:integer;
begin
Write('Masukkan bilangan: ');readln(n);
for n:= 1 to n do
Writeln('Deret Fibonacci ke-',n,' adalah: ',fibonacci(n));
for n:= 1 to n do
jumlah:=fibonacci(n) + fibonacci(n)+ fibonacci(n-1)-1;
writeln('==================================');
writeln('jumlah fibonacci ke-’,n,’ adalah: ',jumlah);
readkey;
donewincrt;
end.
d. program deret
Program Deret;
Uses winCrt;
Var
a,b,n:integer;
begin
a:=1;
b:=1;
write('Jumlah Digit Deret yang anda inginkan: '); readln(n);
writeln;
while (b<=n) do
begin
write(a,' ');
a:=a+2 ;
b:=b+1 ;
end;
writeln;
writeln;
writeln('Jumlah seluruh deretnya adalah : ',sqr(n));
readln;
end.
e. deret genap
program deret_genap;
uses wincrt;
var
i:integer;
begin
i:=2; write(2,' ');
repeat
i:=i+2; write(i,' ');
until i=10;
end.
f. program kombinasi
program permutasi_kombinasi;
uses wincrt;
var
a,b,a_k,kombinasi,permutasi:real;
i,n,k:longint;
begin
writeln('MENGHITUNG PERMUTASI DAN KOMBINASI:');
write('masukkan bilangan n = ');readln(n);
write('masukkan bilangan k = ');readln (k);
a:=1;
b:=1;
a_k:=1;
for i:=2 to n do
a := a*i;
for i:=2 to k do
b :=b*i;
for i :=2 to (n-k) do
a_k := a_k * i;
kombinasi := a/(b*a_k);
permutasi :=a/ (a_k);
writeln ( n, ' Kombinasi',k,' = ', kombinasi:4:1);
writeln (n, ' Permutasi',k,' = ',permutasi :4:1);
end.
g. median
Program median;
Uses Wincrt;
Var
x: array [1..100] of integer;
n,i,pos:integer;
md:real;
lagi:char;
Begin
lagi:='y';
while lagi='y' do
begin
writeln('=============');
Writeln('Program median');
Writeln('=============');
Writeln;
writeln('*dalam program mini ini, data yang harus dimasukkan nanti harus sudah urut*');
writeln;
Write('Masukkan Jumlah Data (n): ');
readln(n);
clrscr;
Writeln;
For i:= 1 to n do
Readln(x[i]);
Writeln;
For i:= 1 to n do
if (n mod 2 = 1) then
begin
pos:=(n div 2)+1;
md:=x[pos];
end
else
begin
pos:=(n div 2);
md:=(x[pos]+x[pos+1])/2;
end;
writeln;
Writeln('Median dari data berjumlah ', n,' tadi adalah : ',md:4:2);
writeln;
writeln('*terimakasih sudah menggunakan program ini*');
writeln('hitung lagi?');
readln(lagi);
end;
End.
kumpulan contoh pascal
a. program taxi
program ricky_taxi;
uses wincrt;
Var Jarak,Bayar:real;
begin
clrscr;
write('masukan jarak = ');readln(jarak);
if(jarak<=1)then
bayar:=750 else
Bayar :=750+(350*(jarak-1));
write('pembayaran adalah : Rp. ',bayar:3:0);
readln;
write ('RICky TAxi');
readln;
end.
b. program pangkat
program pangkat;
uses wincrt;
var pang,i,n,a:real;
begin
clrscr;
i:=1;
pang:=1;
write('masukan nilai a: ');readln(a);
write('masukan nilai n: ');readln(n);
while (i<=n)
do begin
pang:=pang*a;
i:=i+1;
end;
write('pangkat', pang:6:0);
readln;
end.
C. Array berdimensi
program array_berdimensi_1;
uses wincrt;
var
nim :array[1..5]of string[7];
nama:array[1..5]of string[15];
ipk :array[1..5]of real;
i,j:byte;
begin
clrscr;
for i:=1 to 5 do
begin
writeln('Data mahasiswa ke : ',i);
write('masukan NIM mahasiswa : ');readln(nim[i]);
write('masukan NAMA mahasiswa: ');readln(nama[i]);
write('masukan IPK mahasiswa : ');readln(ipk [i]);
writeln('=======================');
end;
writeln('DAFTAR NILAI IPK MAHASISWA');
writeln('……………………..');
writeln(' NIM NAMA IPK');
writeln('…….. ……………');
for j:=1 TO 5 DO
begin
writeln(nim[j],' ',nama[j],' ',IPK[j]:2:2);
end;
writeln('…….. ……………..');
end.
program ricky_taxi;
uses wincrt;
Var Jarak,Bayar:real;
begin
clrscr;
write('masukan jarak = ');readln(jarak);
if(jarak<=1)then
bayar:=750 else
Bayar :=750+(350*(jarak-1));
write('pembayaran adalah : Rp. ',bayar:3:0);
readln;
write ('RICky TAxi');
readln;
end.
b. program pangkat
program pangkat;
uses wincrt;
var pang,i,n,a:real;
begin
clrscr;
i:=1;
pang:=1;
write('masukan nilai a: ');readln(a);
write('masukan nilai n: ');readln(n);
while (i<=n)
do begin
pang:=pang*a;
i:=i+1;
end;
write('pangkat', pang:6:0);
readln;
end.
C. Array berdimensi
program array_berdimensi_1;
uses wincrt;
var
nim :array[1..5]of string[7];
nama:array[1..5]of string[15];
ipk :array[1..5]of real;
i,j:byte;
begin
clrscr;
for i:=1 to 5 do
begin
writeln('Data mahasiswa ke : ',i);
write('masukan NIM mahasiswa : ');readln(nim[i]);
write('masukan NAMA mahasiswa: ');readln(nama[i]);
write('masukan IPK mahasiswa : ');readln(ipk [i]);
writeln('=======================');
end;
writeln('DAFTAR NILAI IPK MAHASISWA');
writeln('……………………..');
writeln(' NIM NAMA IPK');
writeln('…….. ……………');
for j:=1 TO 5 DO
begin
writeln(nim[j],' ',nama[j],' ',IPK[j]:2:2);
end;
writeln('…….. ……………..');
end.
Sunday 5 January 2014
program pascal menggunakan array
Program kartun1;
Uses wincrt;
Const
max=5;
Type
kartun=array[1..max] of string[10];
Var
Jnskartun :kartun;
i:integer;
begin
For i:=1 to max do
Jnskartun[1]:='bleach';
Jnskartun[2]:='byakugan';
Jnskartun[3]:='Naruto';
Jnskartun[4]:='one piece';
Jnskartun[5]:='Avatar';
For i:=1 to max do
writeln(i,'. ',Jnskartun[i]);
end.
Uses wincrt;
Const
max=5;
Type
kartun=array[1..max] of string[10];
Var
Jnskartun :kartun;
i:integer;
begin
For i:=1 to max do
Jnskartun[1]:='bleach';
Jnskartun[2]:='byakugan';
Jnskartun[3]:='Naruto';
Jnskartun[4]:='one piece';
Jnskartun[5]:='Avatar';
For i:=1 to max do
writeln(i,'. ',Jnskartun[i]);
end.
contoh perulangan pascal repeat until
program repeat_until;
uses wincrt;
label back;
var
k,awal,akhir:integer;
rata,jum:real;
begin
back:
clrscr;
write('nilai awal = ');readln(awal);
write('nilai akhir = ');readln(akhir);
if awal<=akhir then
begin
repeat
jum:=jum+awal;
awal:=awal+2;
k:=k+1;
until awal>akhir;
end
else goto back;
rata:=jum/k;
writeln('rata-rata= ',rata:2:2);
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
B. PROGRAM REPEAT UNTIL 1
program faktorial;
uses wincrt;
var
i,n,f:integer;
begin
write('n = '); read(n);
i:=0;
f:=1;
repeat
i:=i+1;
f:=f*i;
until i=n;
writeln(n,' faktorial = ',f);
end.
C.PROGRAM REPEAT UNTL 2
Program Pengulangan;
Uses wincrt;
Var x:integer;
Begin
x:=1;
repeat
writeln(x,'. RICKY SEPRIYANTO adalah Seorang Mahasiswa Prodi TI/A5');
x:=x+1;
until x>9;
end
uses wincrt;
label back;
var
k,awal,akhir:integer;
rata,jum:real;
begin
back:
clrscr;
write('nilai awal = ');readln(awal);
write('nilai akhir = ');readln(akhir);
if awal<=akhir then
begin
repeat
jum:=jum+awal;
awal:=awal+2;
k:=k+1;
until awal>akhir;
end
else goto back;
rata:=jum/k;
writeln('rata-rata= ',rata:2:2);
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
B. PROGRAM REPEAT UNTIL 1
program faktorial;
uses wincrt;
var
i,n,f:integer;
begin
write('n = '); read(n);
i:=0;
f:=1;
repeat
i:=i+1;
f:=f*i;
until i=n;
writeln(n,' faktorial = ',f);
end.
C.PROGRAM REPEAT UNTL 2
Program Pengulangan;
Uses wincrt;
Var x:integer;
Begin
x:=1;
repeat
writeln(x,'. RICKY SEPRIYANTO adalah Seorang Mahasiswa Prodi TI/A5');
x:=x+1;
until x>9;
end
CONTOH prulangan pascal while do
A. PERULANGAN DENGAN WHILE DO
program while_do;
uses wincrt;
label back;
var
k,awal,akhir:integer;
rata,jum:real;
begin
back:
clrscr;
write('Nilai Awal =');readln(awal);
write('Nilai Akhir =');readln(akhir);
if awal<=akhir then
begin
while awal<=akhir do
begin
jum:=jum+awal;
awal:=awal+2;
k:=k+1;
end;
end
else goto back;
rata:=jum/k;
writeln('rata-rata = ',rata:2:2); write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
B.PROGRAM WHILE DO 1
Program whiledo1;
Uses wincrt;
Var i:byte;
Begin
Writeln('Kelipatan 7 sampai 70:');
i:=1;
While i<=70 Do
Begin
If i mod 7 = 0 then
Writeln(i);
i:=i+1;
end;
end.
C. PROGRAM WHILE DO 2
Program whiledo0;
Uses wincrt;
Var i:byte;
Begin
Writeln('Bilangan cacah ganjil sampai 20:');
i:=0;
While i<=20 Do
Begin
If i mod 2 = 1 then
Writeln(i);
i:=i+1;
end;
end.
program while_do;
uses wincrt;
label back;
var
k,awal,akhir:integer;
rata,jum:real;
begin
back:
clrscr;
write('Nilai Awal =');readln(awal);
write('Nilai Akhir =');readln(akhir);
if awal<=akhir then
begin
while awal<=akhir do
begin
jum:=jum+awal;
awal:=awal+2;
k:=k+1;
end;
end
else goto back;
rata:=jum/k;
writeln('rata-rata = ',rata:2:2); write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
B.PROGRAM WHILE DO 1
Program whiledo1;
Uses wincrt;
Var i:byte;
Begin
Writeln('Kelipatan 7 sampai 70:');
i:=1;
While i<=70 Do
Begin
If i mod 7 = 0 then
Writeln(i);
i:=i+1;
end;
end.
C. PROGRAM WHILE DO 2
Program whiledo0;
Uses wincrt;
Var i:byte;
Begin
Writeln('Bilangan cacah ganjil sampai 20:');
i:=0;
While i<=20 Do
Begin
If i mod 2 = 1 then
Writeln(i);
i:=i+1;
end;
end.
CONTOH program pascal perulangan for to do
A. PROGRAM FOR TO DO
program for_to_do;
uses wincrt;
label back;
var
i:byte;
k,awal,akhir:integer;
rata,jum:real;
begin
back:
clrscr;
write('Nilai Awal = ');readln(awal);
write('Nilai Akhir = ');readln(akhir);
if awal<=akhir then
begin
for i:=awal to akhir do
if i mod 2=1 then
begin
jum:=jum+i;
awal:=awal+2;
k:=k+1;
end;
end
else goto back;
rata:=jum/k;
writeln('rata-rata = ',rata:2:2);
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
B. PROGRAM KELIPATAN MENGUNAKAN FOR TO DO
program kelipatan_3;
uses wincrt;
var i:integer;
begin
writeln('kelipatan 3 sampai 21:');
for i:=3 to 21 do
if i mod 3 =0 then
writeln(i);
end.
program for_to_do;
uses wincrt;
label back;
var
i:byte;
k,awal,akhir:integer;
rata,jum:real;
begin
back:
clrscr;
write('Nilai Awal = ');readln(awal);
write('Nilai Akhir = ');readln(akhir);
if awal<=akhir then
begin
for i:=awal to akhir do
if i mod 2=1 then
begin
jum:=jum+i;
awal:=awal+2;
k:=k+1;
end;
end
else goto back;
rata:=jum/k;
writeln('rata-rata = ',rata:2:2);
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
B. PROGRAM KELIPATAN MENGUNAKAN FOR TO DO
program kelipatan_3;
uses wincrt;
var i:integer;
begin
writeln('kelipatan 3 sampai 21:');
for i:=3 to 21 do
if i mod 3 =0 then
writeln(i);
end.
contoh pascal menghitung Luas segi tiga
program segitiga;
uses wincrt;
var a,t,l:real;
begin
writeln(' ==============================');
writeln(' ==*Menghitung Luas Segitiga*==');
write('================================================================================');
writeln;
writeln;
write('Masukkan alas segitiga = '); readln(a);
write('Masukkan tinggi segitiga = '); readln(t);
writeln;
l:=1/2*a*t;
write('Maka luas segitiga = ',l:5:2);
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var a,t,l:real;
begin
writeln(' ==============================');
writeln(' ==*Menghitung Luas Segitiga*==');
write('================================================================================');
writeln;
writeln;
write('Masukkan alas segitiga = '); readln(a);
write('Masukkan tinggi segitiga = '); readln(t);
writeln;
l:=1/2*a*t;
write('Maka luas segitiga = ',l:5:2);
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
contoh pascal program menghitung luas bujur sangkar
program bujur_sangkar;
uses wincrt;
var s,l:real;
begin
writeln(' ===================================');
writeln(' ==*Menghitung Luas Bujur Sangkar*==');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan sisi bujur sangkar = '); readln(s);
writeln;
l:=s*s;
write('Maka luas bujur sangkar = ',l:5:2);
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var s,l:real;
begin
writeln(' ===================================');
writeln(' ==*Menghitung Luas Bujur Sangkar*==');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan sisi bujur sangkar = '); readln(s);
writeln;
l:=s*s;
write('Maka luas bujur sangkar = ',l:5:2);
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
contoh pascal menghitug Luas Lingkaran
program lingkaran;
uses wincrt;
var r,luas:real;
begin
writeln(' =====================================');
writeln(' =====*Menghitung Luas Lingkaran*=====');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari lingkaran = '); readln(r);
writeln;
luas:=3.14*r*r;
write('Maka luas lingkaran = ',luas:6:2);
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var r,luas:real;
begin
writeln(' =====================================');
writeln(' =====*Menghitung Luas Lingkaran*=====');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari lingkaran = '); readln(r);
writeln;
luas:=3.14*r*r;
write('Maka luas lingkaran = ',luas:6:2);
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
Contoh pascal menghtung luas persegi panjang
program persegi_panjang;
uses wincrt;
var p,l,luas:real;
begin
writeln(' =====================================');
writeln(' ==*Menghitung Luas Persegi Panjang*==');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan panjang persegi panjang = '); readln(p);
write('Masukkan lebar persegi panjang = '); readln(l);
writeln;
luas:=p*l;
write('Maka luas persegi panjang = ,luas:5:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var p,l,luas:real;
begin
writeln(' =====================================');
writeln(' ==*Menghitung Luas Persegi Panjang*==');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan panjang persegi panjang = '); readln(p);
write('Masukkan lebar persegi panjang = '); readln(l);
writeln;
luas:=p*l;
write('Maka luas persegi panjang = ,luas:5:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
Contooh program pascal menghitung volum balok
program balok;
uses wincrt;
var p,l,t,v:real;
begin
writeln(' =====================================');
writeln(' ======*Menghitung Volume balok*======');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan panjang balok = '); readln(p);
write('Masukkan lebar balok = '); readln(l);
write('Masukkan tinggi balok = '); readln(t);
writeln;
v:=p*l*t;
write('Maka volume balok = ',v:6:2);
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var p,l,t,v:real;
begin
writeln(' =====================================');
writeln(' ======*Menghitung Volume balok*======');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan panjang balok = '); readln(p);
write('Masukkan lebar balok = '); readln(l);
write('Masukkan tinggi balok = '); readln(t);
writeln;
v:=p*l*t;
write('Maka volume balok = ',v:6:2);
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
Contoh Pascal menghitung volume bola
program bola;
uses wincrt;
var r,v:real;
begin
writeln(' ====================================');
writeln(' ======*Menghitung Volume Bola*======');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari bola = '); readln(r);
writeln;
v:=4/3*(3.14*r*r*r);
write('Maka volume bola = ',v:8:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var r,v:real;
begin
writeln(' ====================================');
writeln(' ======*Menghitung Volume Bola*======');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari bola = '); readln(r);
writeln;
v:=4/3*(3.14*r*r*r);
write('Maka volume bola = ',v:8:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
contoh pascal menghitung volume kubus
program kubus;
uses wincrt;
var s,v:real;
begin
writeln(' =====================================');
writeln(' ======*Menghitung Volume kubus*======');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan sisi kubus = '); readln(s);
writeln;
v:=s*s*s;
write('Maka volume kubus = ',v:5:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var s,v:real;
begin
writeln(' =====================================');
writeln(' ======*Menghitung Volume kubus*======');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan sisi kubus = '); readln(s);
writeln;
v:=s*s*s;
write('Maka volume kubus = ',v:5:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
contoh pascal menghitung volume kerucut
program kerucut;
uses wincrt;
var r,t,v:real;
begin
writeln(' =====================================');
writeln(' =====*Menghitung Volume kerucut*=====');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari kerucut = '); readln(r);
write('Masukkan tinggi kerucut = '); readln(t);
writeln;
v:=(3.14*r*r*t)/3;
write('Maka volume kerucut = ',v:6:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var r,t,v:real;
begin
writeln(' =====================================');
writeln(' =====*Menghitung Volume kerucut*=====');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari kerucut = '); readln(r);
write('Masukkan tinggi kerucut = '); readln(t);
writeln;
v:=(3.14*r*r*t)/3;
write('Maka volume kerucut = ',v:6:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
contoh pascal MENGHITUNG VOLUME TABUNG
program tabung;
uses wincrt;
var r,t,v:real;
begin
writeln(' ====================================');
writeln(' =====*Menghitung Volume Tabung*=====');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari tabung = '); readln(r);
write('Masukkan tinggi tabung = '); readln(t);
writeln;
v:=3.14*r*r*t;
write('Maka volume tabung = ',v:6:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
uses wincrt;
var r,t,v:real;
begin
writeln(' ====================================');
writeln(' =====*Menghitung Volume Tabung*=====');
writeln('================================================================================');
writeln;
writeln;
write('Masukkan jari-jari tabung = '); readln(r);
write('Masukkan tinggi tabung = '); readln(t);
writeln;
v:=3.14*r*r*t;
write('Maka volume tabung = ',v:6:2);
writeln;
writeln;
writeln;
writeln;
write('================================================================================');
writeln(' ==*RICKYSEPRIYANTO_13010241*==');
writeln(' ==================================');
end.
PROGRAM PASCAL MENGGUNAKAN IF THEN
program point1;
uses wincrt;
var point:byte;
begin
writeln(' * Dibuat oleh * ');
writeln(' | NAMA : RIKI SEPRIYANTO | ');
writeln(' | NPM : 13010241 | ');
writeln(' * copyright 2013 * ');
writeln(' ============================================ ');
write('masukkan point anda = ');readln(point);
If point>100 Then
Writeln('Selamat Anda Menang')
else
writeln('Anda Belum Beruntung');
end.
uses wincrt;
var point:byte;
begin
writeln(' * Dibuat oleh * ');
writeln(' | NAMA : RIKI SEPRIYANTO | ');
writeln(' | NPM : 13010241 | ');
writeln(' * copyright 2013 * ');
writeln(' ============================================ ');
write('masukkan point anda = ');readln(point);
If point>100 Then
Writeln('Selamat Anda Menang')
else
writeln('Anda Belum Beruntung');
end.
PASCAL FUNCTION DENGAN PARAMETER
program function_dg_parameter;
uses wincrt;
var
c,d:integer; j:real;
function jumlah(a,b:integer; jum:real):real;
begin
jum:=a+b;
writeln('Jumlah A+B =',jum:6:2);
end;
function pembagi(a,b:integer; bagi:real):real;
begin
bagi:=a/b;
writeln('Bagi A/B =',bagi:6:2);
end;
function pengurang(a,b:integer; kurang:real):real;
begin
kurang:=a-b;
writeln('Bagi A-B =',kurang:6:2);
end;
function perkalian(a,b:integer; kali:real):real;
begin
kali:=a*b;
writeln('Kali A*B =',kali:6:2);
end;
begin
write('Masukan Nilai A : ');readln(c);
write('Masukan Nilai B : ');readln(d);
jumlah(c,d,j);
pembagi(c,d,j);
pengurang(c,d,j);
perkalian(c,d,j);
end.
uses wincrt;
var
c,d:integer; j:real;
function jumlah(a,b:integer; jum:real):real;
begin
jum:=a+b;
writeln('Jumlah A+B =',jum:6:2);
end;
function pembagi(a,b:integer; bagi:real):real;
begin
bagi:=a/b;
writeln('Bagi A/B =',bagi:6:2);
end;
function pengurang(a,b:integer; kurang:real):real;
begin
kurang:=a-b;
writeln('Bagi A-B =',kurang:6:2);
end;
function perkalian(a,b:integer; kali:real):real;
begin
kali:=a*b;
writeln('Kali A*B =',kali:6:2);
end;
begin
write('Masukan Nilai A : ');readln(c);
write('Masukan Nilai B : ');readln(d);
jumlah(c,d,j);
pembagi(c,d,j);
pengurang(c,d,j);
perkalian(c,d,j);
end.
PASCAL FUNCTION TANPA PAARAMETER
program function_tanpa_parameter;
uses wincrt;
var
a,b:integer;
jum,bagi,kurang,kali:real;
function jumlah:real;
begin
jum:=a+b;
end;
function pembagi:real;
begin
bagi:=a/b;
end;
function pengurang:real;
begin
kurang:=a-b;
end;
function perkalian:real;
begin
kali:=a*b;
end;
begin
write('Masukan Nilai A : ');readln(a);
write('Masukan Nilai B : ');readln(b);
WRITELN('_______________');
jumlah;
writeln('Jumlah A+B =',jum:6:2);
pembagi;
writeln('Bagi A/B =',bagi:6:2);
pengurang;
writeln('Kurang A-B =',kurang:6:2);
perkalian;
writeln('Kali A*B =',kali:6:2);
end.
contoh pasckal persaamaan kuadrat
Program persamaan_kuadrat;
Uses wincrt;
var
a,b,c,D,x1,x2:real;
begin
writeln('Program Persamaan Kuadrat');
write('Ketikkan nilai a: ');readln(a);
write('Ketikkan nilai b: ');readln(b);
write('Ketikkan nilai c: ');readln(c);
D:=(b*b)-(4*a*c);
writeln('D=',D:5:2);
if D<0 then
begin
writeln('D<0');
writeln('x1 dan x2 tidak real atau
imajiner');
end
else if D=0 then
begin
writeln('D=0');
writeln('x1 dan x2 real dan sama');
x1:=(-b+(sqrt(D)))/(2*a);
x2:=(-b-(sqrt(D)))/(2*a);
writeln('x1=',x1:5:2);
writeln('x2=',x2:5:2);
end
else if D>0 then
begin
writeln('D>0');
writeln('x1 dan x2 real dan berlainan');
x1:=(-b+(sqrt(D)))/(2*a);
x2:=(-b-(sqrt(D)))/(2*a);
writeln('x1=',x1:5:2);
writeln('x2=',x2:5:2);
end;
end.
program pascal tiket bus
program tiket_bus;
uses wincrt;
var
jurusan,jenisbus: string;
total,diskon,bayar: integer;
harga:real;
begin
clrscr;
writeln(' Pemesanan Tiket Bus YASSALAM ABADI ');
writeln(' PO YASSALAM ABADI ');
writeln(' Jurusan JOGJA, WONOSARI dan JAKARTA ');
writeln('+-----+--------+-------------------------+----------------+');
writeln('| Kode Jurusan | AC | Ekonomi |');
writeln('+-----+--------+------------------------------------------+');
writeln('|[1] JOGJA | Rp.60.000 (Disc. 10%) | Rp.40.000 |');
writeln('|[2] WONOSARI | Rp.75.000 | Rp.50.000 |');
writeln('|[3] JAKARTA | Rp.20.000 (Disc. 5%) | Rp.15.000 |');
writeln('+-----+--------+-------------------------+----------------+');
writeln('');
writeln('');
writeln('Silahkan isi data dibawah ini :');
begin
write('- Kode Jurusan : ');readln(jurusan);
write('- Jenis Bus : ');readln(jenisbus);
write('- Jumlah Tiket : ');readln(total);
write('- Harga bayar : ');
if (jurusan='1') and (jenisbus='ac')then harga:=60000-(60000*0.1);
if (jurusan='1') and (jenisbus='ekonomi')then harga:=40000;
if (jurusan='2') and (jenisbus='ac')then harga:=75000;
if (jurusan='2') and (jenisbus='ekonomi')then harga:=50000;
if (jurusan='3') and (jenisbus='ac')then harga:=20000-(20000*0.05);
if (jurusan='3') and (jenisbus='ekonomi')then harga:=15000;
writeln('Rp.',total*harga:0:2);
writeln('');
writeln(' Terimaksih atas pemesanannya ');
writeln(' Data Anda sedang kami proses ');
writeln(' Kami siap melayani dengan sepenuh hati #ricky# ');
readln;
end;
end.
uses wincrt;
var
jurusan,jenisbus: string;
total,diskon,bayar: integer;
harga:real;
begin
clrscr;
writeln(' Pemesanan Tiket Bus YASSALAM ABADI ');
writeln(' PO YASSALAM ABADI ');
writeln(' Jurusan JOGJA, WONOSARI dan JAKARTA ');
writeln('+-----+--------+-------------------------+----------------+');
writeln('| Kode Jurusan | AC | Ekonomi |');
writeln('+-----+--------+------------------------------------------+');
writeln('|[1] JOGJA | Rp.60.000 (Disc. 10%) | Rp.40.000 |');
writeln('|[2] WONOSARI | Rp.75.000 | Rp.50.000 |');
writeln('|[3] JAKARTA | Rp.20.000 (Disc. 5%) | Rp.15.000 |');
writeln('+-----+--------+-------------------------+----------------+');
writeln('');
writeln('');
writeln('Silahkan isi data dibawah ini :');
begin
write('- Kode Jurusan : ');readln(jurusan);
write('- Jenis Bus : ');readln(jenisbus);
write('- Jumlah Tiket : ');readln(total);
write('- Harga bayar : ');
if (jurusan='1') and (jenisbus='ac')then harga:=60000-(60000*0.1);
if (jurusan='1') and (jenisbus='ekonomi')then harga:=40000;
if (jurusan='2') and (jenisbus='ac')then harga:=75000;
if (jurusan='2') and (jenisbus='ekonomi')then harga:=50000;
if (jurusan='3') and (jenisbus='ac')then harga:=20000-(20000*0.05);
if (jurusan='3') and (jenisbus='ekonomi')then harga:=15000;
writeln('Rp.',total*harga:0:2);
writeln('');
writeln(' Terimaksih atas pemesanannya ');
writeln(' Data Anda sedang kami proses ');
writeln(' Kami siap melayani dengan sepenuh hati #ricky# ');
readln;
end;
end.
program diskon pada pascal
program disskon;
uses wincrt;
var
Harga : longint;
diskon, bayar : real;
begin
clrscr;
write('Inputkan Harga : ');read(Harga);
if (Harga >= 100000) and (Harga < 500000) then
begin
Diskon := Harga * (10/100);
Bayar := Harga - Diskon;
write('Bayar = ' , Bayar:0:0);
end
else
if (Harga >= 500000) then
begin
Diskon := Harga * (20/100);
Bayar := harga - Diskon;
write('Bayar = ' , Bayar:0:0);
end
else
if Harga < 100000 then
write('Bayar = ' , Harga);
readkey;
end.
uses wincrt;
var
Harga : longint;
diskon, bayar : real;
begin
clrscr;
write('Inputkan Harga : ');read(Harga);
if (Harga >= 100000) and (Harga < 500000) then
begin
Diskon := Harga * (10/100);
Bayar := Harga - Diskon;
write('Bayar = ' , Bayar:0:0);
end
else
if (Harga >= 500000) then
begin
Diskon := Harga * (20/100);
Bayar := harga - Diskon;
write('Bayar = ' , Bayar:0:0);
end
else
if Harga < 100000 then
write('Bayar = ' , Harga);
readkey;
end.
program pascal hitung nilai rata2
program HIT_RATA_RATA;
uses wincrt;
var
N:integer;
U:real;
procedure RATA_RATA(N:integer; var U:real);
var
I,Bil,Total:integer;
begin
Total:=0;
I:=1;
while I<=N do
begin
write('Masukan Bilangan ',I,' = ');
readln(Bil);
Total:=Total+Bil;
I:=I+1;
end;
U:=Total/N;
end;
begin {program utama}
clrscr;
write('Banyaknya Bilangan = ');
readln(N);
writeln('====================');
RATA_RATA(N,U);
writeln('Rata-Rata = ',U:10:2);
readln;
end.
uses wincrt;
var
N:integer;
U:real;
procedure RATA_RATA(N:integer; var U:real);
var
I,Bil,Total:integer;
begin
Total:=0;
I:=1;
while I<=N do
begin
write('Masukan Bilangan ',I,' = ');
readln(Bil);
Total:=Total+Bil;
I:=I+1;
end;
U:=Total/N;
end;
begin {program utama}
clrscr;
write('Banyaknya Bilangan = ');
readln(N);
writeln('====================');
RATA_RATA(N,U);
writeln('Rata-Rata = ',U:10:2);
readln;
end.
program bulan dengan pascal
program bulan;
uses wincrt;
var
no:integer;
function nama_bulan(no:integer):string;
begin
case (no) of
1:nama_bulan:='Januari';
2:nama_bulan:='Februari';
3:nama_bulan:='Maret';
4:nama_bulan:='April';
5:nama_bulan:='Mei';
6:nama_bulan:='Juni';
7:nama_bulan:='Juli';
8:nama_bulan:='Agustus';
9:nama_bulan:='September';
10:nama_bulan:='Oktober';
11:nama_bulan:='November';
12:nama_bulan:='Desember';
end;
end;
begin
clrscr;
writeln('Input Nomor Bulan : ');
readln(no);
writeln('Nama Bulan:',nama_bulan(no));
readln;
end.
uses wincrt;
var
no:integer;
function nama_bulan(no:integer):string;
begin
case (no) of
1:nama_bulan:='Januari';
2:nama_bulan:='Februari';
3:nama_bulan:='Maret';
4:nama_bulan:='April';
5:nama_bulan:='Mei';
6:nama_bulan:='Juni';
7:nama_bulan:='Juli';
8:nama_bulan:='Agustus';
9:nama_bulan:='September';
10:nama_bulan:='Oktober';
11:nama_bulan:='November';
12:nama_bulan:='Desember';
end;
end;
begin
clrscr;
writeln('Input Nomor Bulan : ');
readln(no);
writeln('Nama Bulan:',nama_bulan(no));
readln;
end.
PROGRAM pascal penjualan buah
Program
Penjualan_Buah_Segar_;
Uses
wincrt;
Var
napem,nb:string[15] ;
hrg,jb,jh,disc,tot:real;
Ul:char;
begin
Repeat
clrscr;
writeln;
writeln('----------------------------------------');
writeln('
DATA PENJUALAN BUAH SEGAR /KG');
writeln('----------------------------------------');
writeln;
write('Nama
Pembeli = '); readln(napem);
writeln;
write('Buah
Yang Dibeli = '); readln(nb);
writeln('.............................');
if
nb='jeruk' then hrg:=5000 else
if
nb='mangga' then hrg:=7000 else
if
nb='apel' then hrg:=9000 else
if
nb='duren' then hrg:=11000;
begin
end;
writeln;
write('HargaBuah =','Rp',hrg:6:0,'/Kg');
writeln;
writeln;
write('JumlahBeli =
'); readln(jb);
writeln;
jh:=
hrg*jb;
write('JumlahHarga =','Rp',jh:10:0);
writeln;
writeln('.............................');
writeln;
if
jb> 3 then disc:=0.2*jh;
begin
end;
write('Anda
Dapat Diskon=','Rp',disc:10:0);
writeln;
writeln('.............................');
writeln;
writeln;
write('Total
Bayar =','Rp',hrg*jb-disc:10:0);
writeln;
writeln('----------------------------------------');writeln;
write('Terima
kasih atas Kunjungannya#Ricky#');
readln;
Write('Mau
Ulang Lagi? [Y/T]: ');Readln(Ul);
Until
Upcase(Ul)<>'Y';
end.
CONTOH PROGRAM DERET KELIPATAN PASCAL
turbo pascal 1.5 - deret kelipatan x yang kurang dari y
program deretkelipatanxyangkurangdariy;
uses wincrt;
var
x,y,i:integer;
begin
writeln(' ================================================= ');
writeln('');
writeln(' PROGRAM DERET KELIPATAN ');
writeln(' Dibuat oleh ricky coebra ');
writeln(' @copyright 2013 ');
writeln('');
writeln(' ================================================= ');
write('X = ');readln(x);write('Y = ');readln(y);
write('Deret = ');
i:=x;
while x<y do
begin
write(x,' ');
x:=x+i;
end;
end.
contoh PRogram Faktorial menggunakan PASCAL
program faktorial; {program menghitung nilai faktorial dari inputan N}
uses wincrt;
var
i,N,jumlah :integer;
begin
writeln(' ================================================= ');
writeln('');
writeln(' PROGRAM MENGHITUNG FAKTORIAL ');
writeln(' Dibuat oleh ricky coebra ');
writeln(' @copyright 2013 ');
writeln('');
writeln(' ================================================= ');
jumlah:=1;
write('inputkan suatu nilai : '); readln(N);
write('faktorial dari ',N,' adalah : ');
write('1');
for i:=2 to N do
begin
write(' x ',i);
jumlah:=jumlah*i;
end;
write(' = ',jumlah);
end.
uses wincrt;
var
i,N,jumlah :integer;
begin
writeln(' ================================================= ');
writeln('');
writeln(' PROGRAM MENGHITUNG FAKTORIAL ');
writeln(' Dibuat oleh ricky coebra ');
writeln(' @copyright 2013 ');
writeln('');
writeln(' ================================================= ');
jumlah:=1;
write('inputkan suatu nilai : '); readln(N);
write('faktorial dari ',N,' adalah : ');
write('1');
for i:=2 to N do
begin
write(' x ',i);
jumlah:=jumlah*i;
end;
write(' = ',jumlah);
end.
CONTOH PROGRAM PASCAL PERULANGAN BERSARANG
program segitigabintang; {program menampilkan karakter bintang sebanyak N baris}
uses wincrt;
var
i,j,N :integer;
begin
writeln(' ================================================= ');writeln('');
writeln(' PROGRAM KARAKTER BINTANG ');
writeln(' Dibuat oleh ricky coebra ');
writeln(' @copyright 2013 ');
writeln('');
writeln(' ================================================= ');
write(' berapa jumlah baris bintang : '); readln(N);
writeln;
for i:=n downto 1 do
begin
for j:=1 to i do
begin
write(' ');
end;
for j:=i to N do
begin
write('*');
end;
writeln;
end;
end.
Contoh Program Bahasa Pascal Perpustakaan
program pinjam_buku_perpus;
uses wincrt;
type buku=record
judul,pengarang:string;
stok:byte;
end;
larik_buku=array[1..20] of buku;
type pinjam=record
nama,judulb:string;
end;
larik_pinjam=array[1..20] of pinjam;
var buk:larik_buku;
pinj:larik_pinjam;
m,n,i,j,pil:byte;
ketemu:boolean;
procedure tambah_buku(var x:larik_buku);
var baru1,baru2:string;
begin
ketemu:=false;
write('masukkan judul buku baru : ');readln(baru1);
write('masukkan pengarangnya : ');readln(baru2);
{cek judul sudah ada/belum}
for i:=1 to n do
begin
if (x[i].judul=baru1) and (x[i].pengarang=baru2) then
begin
ketemu:=true;
writeln('Judul tersebut sudah ada di perpus, lakukan proses no 2');
end;
end;
if not ketemu then
begin
inc(n);
x[n].judul:=baru1;
x[n].pengarang:=baru2;
write('berapa exemplar ');readln(x[n].stok);
end;
end;
procedure tambah_stok(var x:larik_buku);
var baru1,baru2:string;
ts,pos:byte;
oke:boolean;
begin
{cek judul di stok}
ketemu:=false;oke:=false;
write('masukkan judul buku yang akan ditambah stok : ');readln(baru1);
{cetak buku dengan judul tsb}
for i:=1 to n do
if x[i].judul=baru1 then
begin writeln(x[i].judul:15,' ',x[i].pengarang:15);oke:=true;end;
writeln;
if oke then
begin
write('masukkan pengarang yang anda maksud dr judul diatas : ');
readln(baru2);
end;
for i:=1 to n do
if (x[i].judul=baru1) and (x[i].pengarang=baru2) then
begin ketemu:=true;pos:=i;end;
if ketemu then
begin
write('berapa tambahan stok ? ');readln(ts);
x[pos].stok:=x[pos].stok+ts;
end
else
writeln('maaf buku tersebut belum ada, lakukan proses no 1');
end;
procedure cetak_buku(var x:larik_buku);
begin
writeln('DAFTAR BUKU YANG ADA DI PERPUSTAKAAN ');
writeln('------------------------------------------------');
writeln('No Judul Pengarang Stok');
writeln('------------------------------------------------');
for i:=1 to n do
writeln(i:3,' ',x[i].judul:15,' ',x[i].pengarang:15,' ',x[i].stok:3);
writeln('------------------------------------------------');
end;
procedure cetak_pinjam(var x:larik_pinjam);
begin
writeln('DAFTAR PEMINJAM BUKU YANG PERPUSTAKAAN ');
writeln('------------------------------------------------');
writeln('No Peminjam Judul Buku');
writeln('------------------------------------------------');
for i:=1 to m do
writeln(i:3,' ',x[i].nama:10,' ',x[i].judulb:20);
writeln('------------------------------------------------');
end;
procedure urut_judul(var x:larik_buku);
var dum:buku;
begin
for i:=1 to n-1 do
begin
for j:=i+1 to n do
begin
if x[i].judul>x[j].judul then
begin
dum:=x[i];
x[i]:=x[j];
x[j]:=dum;
end;
end;
end;
end;
procedure urut_pengarang(var x:larik_buku);
var dum:buku;
begin
for i:=1 to n-1 do
begin
for j:=i+1 to n do
begin
if x[i].pengarang>x[j].pengarang then
begin
dum:=x[i];
x[i]:=x[j];
x[j]:=dum;
end;
end;
end;
end;
procedure pinjam_buku(var x:larik_buku);
var cari:string;
nb,ya:string;
pos:byte;
label lagi;
begin
lagi:
write('masukkan judul buku yang akan dipinjam ');readln(cari);
{cek}
ketemu:=false;
for i:=1 to n do
if x[i].judul=cari then begin pos:=i;ketemu:=true;end;
{jika judul ditemukan}
if (ketemu) and (x[pos].stok>0) then
begin
write('buku tersedia, masukkan nama anda ');readln(nb);
{memasukkan ke array pinjam}
inc(m); dec(x[pos].stok);
pinj[m].nama:=nb;
pinj[m].judulb:=cari;
end
else
begin
writeln('maaf buku yang anda cari tidak ada');
write('apakah akan meminjam buku lain ?<y/t> ');readln(ya);
if ya='y' then goto lagi;
end;
end;
procedure kembali_buku(var x:larik_buku);
var kembali,nm:string;
pos:byte;
label selesai;
begin
if m=0 then
begin writeln('Maaf tidak ada yang meminjam buku');goto selesai;end;
pos:=0;
writeln('Selamat datang di pengembalian buku ');
write('masukkan nama peminjam ');readln(nm);
write('masukkan judul buku yg kembali '); readln(kembali);
{menambahkan stok buku dg judul tsb}
for i:=1 to n do
begin
if (x[i].judul)=kembali then inc(x[i].stok);
end;
{menghapus record di daftar peminjam buku}
for i:=1 to m do
if (pinj[i].judulb=kembali) and (pinj[i].nama=nm) then pos:=i;
if pos<>0 then
begin
writeln('judul ',kembali ,' dipinjam oleh ',nm,' sudah dikembalikan');
{hapus dan geser}
for j:=pos to m-1 do pinj[j]:=pinj[j+1];
dec(m);
end
else writeln('maaf nama peminjam atau buku yang dikembalikan tidak benar');
selesai: end;
begin{utama}
repeat
begin
clrscr;
writeln('Pengelolaan buku Perpustakaan Cerdas');
writeln('1.Tambah judul buku');
writeln('2.Tambah stok buku');
writeln('3. Cetak buku');
writeln('4. Cetak urut judul');
writeln('5. Cetak urut pengarang');
writeln('6. Pinjam buku');
writeln('7. Cetak peminjaman');
writeln('8. Pengembalian buku');
writeln('9. Selesai');
write('Pilihan anda ==> ');readln(pil);
case pil of
1: tambah_buku(buk);
2: tambah_stok(buk);
3: cetak_buku(buk);
4: begin
urut_judul(buk);cetak_buku(buk);
end;
5: begin
urut_pengarang(buk);cetak_buku(buk);
end;
6: pinjam_buku(buk);
7: if m=0 then writeln('tidak ada yang meminjam') else cetak_pinjam(pinj);
8: if m>0 then kembali_buku(buk) else
writeln('maaf saat ini tidak ada yang sedang meminjam buku') ;
9: writeln('Terimakasih ');
end;
readln;
end
until(pil=9);
end.
uses wincrt;
type buku=record
judul,pengarang:string;
stok:byte;
end;
larik_buku=array[1..20] of buku;
type pinjam=record
nama,judulb:string;
end;
larik_pinjam=array[1..20] of pinjam;
var buk:larik_buku;
pinj:larik_pinjam;
m,n,i,j,pil:byte;
ketemu:boolean;
procedure tambah_buku(var x:larik_buku);
var baru1,baru2:string;
begin
ketemu:=false;
write('masukkan judul buku baru : ');readln(baru1);
write('masukkan pengarangnya : ');readln(baru2);
{cek judul sudah ada/belum}
for i:=1 to n do
begin
if (x[i].judul=baru1) and (x[i].pengarang=baru2) then
begin
ketemu:=true;
writeln('Judul tersebut sudah ada di perpus, lakukan proses no 2');
end;
end;
if not ketemu then
begin
inc(n);
x[n].judul:=baru1;
x[n].pengarang:=baru2;
write('berapa exemplar ');readln(x[n].stok);
end;
end;
procedure tambah_stok(var x:larik_buku);
var baru1,baru2:string;
ts,pos:byte;
oke:boolean;
begin
{cek judul di stok}
ketemu:=false;oke:=false;
write('masukkan judul buku yang akan ditambah stok : ');readln(baru1);
{cetak buku dengan judul tsb}
for i:=1 to n do
if x[i].judul=baru1 then
begin writeln(x[i].judul:15,' ',x[i].pengarang:15);oke:=true;end;
writeln;
if oke then
begin
write('masukkan pengarang yang anda maksud dr judul diatas : ');
readln(baru2);
end;
for i:=1 to n do
if (x[i].judul=baru1) and (x[i].pengarang=baru2) then
begin ketemu:=true;pos:=i;end;
if ketemu then
begin
write('berapa tambahan stok ? ');readln(ts);
x[pos].stok:=x[pos].stok+ts;
end
else
writeln('maaf buku tersebut belum ada, lakukan proses no 1');
end;
procedure cetak_buku(var x:larik_buku);
begin
writeln('DAFTAR BUKU YANG ADA DI PERPUSTAKAAN ');
writeln('------------------------------------------------');
writeln('No Judul Pengarang Stok');
writeln('------------------------------------------------');
for i:=1 to n do
writeln(i:3,' ',x[i].judul:15,' ',x[i].pengarang:15,' ',x[i].stok:3);
writeln('------------------------------------------------');
end;
procedure cetak_pinjam(var x:larik_pinjam);
begin
writeln('DAFTAR PEMINJAM BUKU YANG PERPUSTAKAAN ');
writeln('------------------------------------------------');
writeln('No Peminjam Judul Buku');
writeln('------------------------------------------------');
for i:=1 to m do
writeln(i:3,' ',x[i].nama:10,' ',x[i].judulb:20);
writeln('------------------------------------------------');
end;
procedure urut_judul(var x:larik_buku);
var dum:buku;
begin
for i:=1 to n-1 do
begin
for j:=i+1 to n do
begin
if x[i].judul>x[j].judul then
begin
dum:=x[i];
x[i]:=x[j];
x[j]:=dum;
end;
end;
end;
end;
procedure urut_pengarang(var x:larik_buku);
var dum:buku;
begin
for i:=1 to n-1 do
begin
for j:=i+1 to n do
begin
if x[i].pengarang>x[j].pengarang then
begin
dum:=x[i];
x[i]:=x[j];
x[j]:=dum;
end;
end;
end;
end;
procedure pinjam_buku(var x:larik_buku);
var cari:string;
nb,ya:string;
pos:byte;
label lagi;
begin
lagi:
write('masukkan judul buku yang akan dipinjam ');readln(cari);
{cek}
ketemu:=false;
for i:=1 to n do
if x[i].judul=cari then begin pos:=i;ketemu:=true;end;
{jika judul ditemukan}
if (ketemu) and (x[pos].stok>0) then
begin
write('buku tersedia, masukkan nama anda ');readln(nb);
{memasukkan ke array pinjam}
inc(m); dec(x[pos].stok);
pinj[m].nama:=nb;
pinj[m].judulb:=cari;
end
else
begin
writeln('maaf buku yang anda cari tidak ada');
write('apakah akan meminjam buku lain ?<y/t> ');readln(ya);
if ya='y' then goto lagi;
end;
end;
procedure kembali_buku(var x:larik_buku);
var kembali,nm:string;
pos:byte;
label selesai;
begin
if m=0 then
begin writeln('Maaf tidak ada yang meminjam buku');goto selesai;end;
pos:=0;
writeln('Selamat datang di pengembalian buku ');
write('masukkan nama peminjam ');readln(nm);
write('masukkan judul buku yg kembali '); readln(kembali);
{menambahkan stok buku dg judul tsb}
for i:=1 to n do
begin
if (x[i].judul)=kembali then inc(x[i].stok);
end;
{menghapus record di daftar peminjam buku}
for i:=1 to m do
if (pinj[i].judulb=kembali) and (pinj[i].nama=nm) then pos:=i;
if pos<>0 then
begin
writeln('judul ',kembali ,' dipinjam oleh ',nm,' sudah dikembalikan');
{hapus dan geser}
for j:=pos to m-1 do pinj[j]:=pinj[j+1];
dec(m);
end
else writeln('maaf nama peminjam atau buku yang dikembalikan tidak benar');
selesai: end;
begin{utama}
repeat
begin
clrscr;
writeln('Pengelolaan buku Perpustakaan Cerdas');
writeln('1.Tambah judul buku');
writeln('2.Tambah stok buku');
writeln('3. Cetak buku');
writeln('4. Cetak urut judul');
writeln('5. Cetak urut pengarang');
writeln('6. Pinjam buku');
writeln('7. Cetak peminjaman');
writeln('8. Pengembalian buku');
writeln('9. Selesai');
write('Pilihan anda ==> ');readln(pil);
case pil of
1: tambah_buku(buk);
2: tambah_stok(buk);
3: cetak_buku(buk);
4: begin
urut_judul(buk);cetak_buku(buk);
end;
5: begin
urut_pengarang(buk);cetak_buku(buk);
end;
6: pinjam_buku(buk);
7: if m=0 then writeln('tidak ada yang meminjam') else cetak_pinjam(pinj);
8: if m>0 then kembali_buku(buk) else
writeln('maaf saat ini tidak ada yang sedang meminjam buku') ;
9: writeln('Terimakasih ');
end;
readln;
end
until(pil=9);
end.
CONTOH Program pascal program matriks
program matrik;
uses wincrt;
type data = array[1..5,1..5] of integer;
var
matrikI,matrikII : data;
baris,kolom,pil : integer;procedure isi;
var i,j :integer;
begin
writeln('Penentuan ORDO MATRIK I');
write('Masukan banyak baris matrik I : ');readln(baris);
write('Masukan banyak kolom matrik I : ');readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
readln(matrikI[i,j]);
end;
clrscr;
writeln('Penentuan ORDO MATRIK II');
write('Masukan banyak baris matrik II : ');
readln(baris);
write('Masukan banyak kolom matrik II : ');
readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
readln(matrikII[i,j]);
end;
end;procedure gagal;
begin
writeln('Program Dibatalkan');
end;procedure kali(a1,a2 : data);
var
hasil:data;
i,j,z:integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=0;
for z:=1 to baris do
hasil[i,j]:=hasil[i,j]+matrikI[i,z]*matrikII[z,j];
end;
clrscr;
writeln('Hasil perkalian');
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
begin
writeln('MENU');
writeln('Ketik(1) Perkalian Matrik');
writeln('ketik(2) Batal Program');
write('Pilihan = ');
readln(pil);
clrscr;
case pil of
1:begin
isi;
kali(matrikI,matrikII);
end;
2:begin
gagal;
end;
end;
end.
uses wincrt;
type data = array[1..5,1..5] of integer;
var
matrikI,matrikII : data;
baris,kolom,pil : integer;procedure isi;
var i,j :integer;
begin
writeln('Penentuan ORDO MATRIK I');
write('Masukan banyak baris matrik I : ');readln(baris);
write('Masukan banyak kolom matrik I : ');readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
readln(matrikI[i,j]);
end;
clrscr;
writeln('Penentuan ORDO MATRIK II');
write('Masukan banyak baris matrik II : ');
readln(baris);
write('Masukan banyak kolom matrik II : ');
readln(kolom);
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
readln(matrikII[i,j]);
end;
end;procedure gagal;
begin
writeln('Program Dibatalkan');
end;procedure kali(a1,a2 : data);
var
hasil:data;
i,j,z:integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=0;
for z:=1 to baris do
hasil[i,j]:=hasil[i,j]+matrikI[i,z]*matrikII[z,j];
end;
clrscr;
writeln('Hasil perkalian');
for i:=1 to baris do
for j:=1 to kolom do
begin gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
begin
writeln('MENU');
writeln('Ketik(1) Perkalian Matrik');
writeln('ketik(2) Batal Program');
write('Pilihan = ');
readln(pil);
clrscr;
case pil of
1:begin
isi;
kali(matrikI,matrikII);
end;
2:begin
gagal;
end;
end;
end.
Subscribe to:
Posts (Atom)