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.

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.

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.

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 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.

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

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.

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.