Contoh Program menggunakan procedure dan case of DI Pascal

Program Menghitung_Luas_dan_Keliling_Bangun_Datar;
uses crt;
Var
Pilih : Integer;
Procedure Persegi; {Mencari Luas dan Keliling Persegi}
Var
s, L, K : Real;
Begin
Writeln(' ');
Textcolor(LightRed);
Writeln(' --==::Menghitung Luas dan Keliling Persegi::==--');
Textcolor(LightGreen);
Writeln(' ');
Write('Masukkan sisi : ');Readln(s);
L := s*s;
K := 4*s;
Writeln('Luas : ', L:0:0);
Writeln('Keliling : ', K:0:0);
Writeln(' ');
Textcolor(LightRed);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');
Readln;
end;
Procedure PersegiPanjang; {Mencari Luas dan Keliling Persegi Panjang}
Var
p, lbr, L, K : Real;
Begin
Writeln(' ');
Textcolor(LightRed);
Writeln(' --==::Menghitung Luas dan Keliling Persegi Panjang::==--');
Textcolor(LightGreen);
Writeln(' ');
Write('Masukkan panjang : ');Readln(p);
Write('Masukkan lebar : ');Readln(lbr);
L := p*lbr;
K := 2*(p+lbr);
Writeln('Luas : ', L:0:0);
Writeln('Keliling : ', K:0:0);
Writeln(' ');
Textcolor(LightRed);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');
Readln;
end;
Procedure Segitiga; {Mencari Luas dan Keliling Segitiga}
Var
a, t, sm, L, K : Real;
Begin
Writeln(' ');
Textcolor(LightRed);
Writeln(' --==::Menghitung Luas dan Keliling Segitiga Siku-Siku::==--');
Textcolor(LightGreen);
Writeln(' ');
Write('Masukkan alas : ');Readln(a);
Write('Masukkan tinggi : ');Readln(t);
L:= 0.5*a*t;
sm:= sqrt(sqr(a)+sqr(t));
K:= a+t+sm;
Writeln('Luas : ', L:0:2);
Writeln('Keliling : ', K:0:2);
Writeln(' ');
Textcolor(LightRed);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');
Readln;
end;
Procedure Lingkaran; {Mencari Luas dan Keliling Lingkaran}
Var
r, L, K : Real;
Begin
Writeln(' ');
Textcolor(LightRed);
Writeln(' --==::Menghitung Luas dan Keliling Lingkaran::==--');
Textcolor(LightGreen);
Writeln(' ');
Write('Masukan jari-jari : ');Readln(r);
L:= 22/7*(sqr(r));
K:= 2*22/7*r;
Writeln('Luas : ', L:0:2);
Writeln('Keliling : ', K:0:2);
Writeln(' ');
Textcolor(12);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');
Readln;
end;
Procedure Kubus; {Mencari Volume dan Luas permukaan Kubus}
Var
s, V, Lp : Real;
Begin
Writeln(' ');
Textcolor(LightRed);
Writeln(' --==::Menghitung Volume dan Luas permukaan Kubus::==--');
Textcolor(LightGreen);
Writeln(' ');
Write('Masukan sisi : ');Readln(s);
V:= s*s*s;
Lp:= 6*s*s;
Writeln('Volume : ', V:0:0);
Writeln('Luas Permukaan : ', Lp:0:0);
Writeln(' ');
Textcolor(LightRed);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');
Readln;
end;
Procedure Balok; {Mencari Volume dan Luas permukaan Balok}
Var
p, l, t, V, Lp : Real;
Begin
Writeln(' ');
Textcolor(LightRed);
Writeln(' --==::Menghitung Volume dan Luas Permukaan Balok::==--');
Textcolor(LightGreen);
Writeln(' ');
Write('Masukan panjang : ');Readln(p);
Write('Masukan lebar : ');Readln(l);
Write('Masukan tinggi : ');Readln(t);
V:= p*l*t;
Lp:= 2*p*l+2*p*t+2*l*t;
Writeln('Volume : ', V:0:0);
Writeln('Luas Permukaan : ', Lp:0:0);
Writeln(' ');
Textcolor(LightRed);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');
Readln;
end;
Procedure Latihan1;
var
a, b, c, d, e : Real;
f, g, h, i : Integer;
Begin
Writeln(' ');
Textcolor(LightRed);
Writeln(' --==::Mengerjakan Soal-Soal Mengenai Bangun Datar::==--');
Textcolor(LightGreen);
Writeln(' ');
Writeln(' ');
Writeln(' 1. Diketahui sebuah Persegi Mempunyai Panjang sisi 5');
Writeln(' Berapakah Luas Dan Kelilingnya..?');
Writeln(' ');
Write('Luas : ');Readln(a);
Write('Keliling : ');Readln(b);
Textcolor(LightRed);
if a*b/2+5=255
then write('Bagus, Lanjutkan Ke soal Berikutnya ')
else write('Maaf, anda salah, lebih teliti lagi di soal berikutnya ! ');
Readln;
Textcolor(LightGreen);
Writeln(' ');
Writeln(' 2. Diketahui sebuah Lingkaran Mempunyai Jari-jari 7');
Writeln(' Berapakah Luas Dan Kelilingnya..?');
Write('Luas : ');Readln(c);
Write('Keliling : ');Readln(d);
Textcolor(LightRed);
if c+d=198
then write('SELAMAT')
else write('Maaf Coba Lagi Yah.!');
Writeln(' ');
Writeln(' ');
Textcolor(LightRed);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');

Readln;
end;
Procedure Credits;
Begin
Writeln(' ');
Writeln(' ');
Writeln(' ');
Writeln(' ');
Textcolor(LightCyan);
Writeln('***************************************** ****************************** ');
Textcolor(LightGreen);
Writeln(' ');
Writeln(' Cah SMANSA Community ');
Writeln(' Simbah Google ');
Writeln(' Komputer Bokap Gue ');
Writeln(' ');
Textcolor(LightCyan);
Writeln('***************************************** ****************************** ');
Writeln(' ');
Textcolor(LightRed);
Writeln(' CopyLeft@2008 Teatzo_system.corp (TS.corp) ');
Readln;
end;
Procedure BangunDatar;
Begin {Sub Program}
repeat
clrscr;
Textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(LightRed);
Writeln(' ---==::BANDIT CYBER PINGIN TOBAT::==--- ');
Textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(Yellow);
writeln(' ');
Writeln('<<<<<<< Cara Cepat Menghitung Luas dan Keliling Bangun Datar >>>>>>>) ');
Writeln(' <<<<< Lebih Cepat daripada Menggunakan Jari tangan anda >>>>) ');
writeln(' ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(LightRed);
writeln(' = Provided by Teatzo = ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(Yellow);
Writeln(' Pilihan : ');
Textcolor(LightGreen);
Writeln(' 1. Menghitung Luas dan Keliling Persegi ');
Writeln(' 2. Menghitung Luas dan Keliling Persegi Panjang ');
Writeln(' 3. Menghitung Luas dan Keliling Segitiga siku-siku ');
Writeln(' 4. Menghitung Luas dan Keliling Lingkaran ');
Writeln(' 5. Keluar ');
Textcolor(Yellow);
Write(' Pilih Angka untuk memilih pilihan : ');
Readln(pilih);
case pilih of
1 : Persegi;
2 : PersegiPanjang;
3 : Segitiga;
4 : Lingkaran;
5 : exit;
end;
until pilih = 5;
end;
Procedure BangunRuang;
Begin {Sub Program}
repeat
clrscr;
Textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(LightRed);
Writeln(' ---==::BANDIT CYBER PINGIN TOBAT::==--- ');
Textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(Yellow);
writeln(' ');
Writeln('<<<< Cara Cepat Menghitung Volume dan Luas Permukaan Bangun Ruang >>>)');
Writeln(' <<<<< Lebih Cepat daripada Menggunakan Jari tangan anda >>>>) ');
writeln(' ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(LightRed);
writeln(' = Provided by Teatzo = ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(Yellow);
Writeln(' Pilihan : ');
Textcolor(LightGreen);
Writeln(' 1. Menghitung Volume dan Luas Permukaan Kubus ');
Writeln(' 2. Menghitung Volume dan Luas Permukaan Balok ');
Writeln(' 3. Keluar ');
Textcolor(Yellow);
Write(' Pilih Angka untuk memilih pilihan : ');
Readln(pilih);
case pilih of
1 : Kubus;
2 : Balok;
3 : exit;
end;
until pilih = 3;
end;
Procedure Latihan;
Begin {Sub Program}
repeat
clrscr;
Textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(LightRed);
Writeln(' ---==::BANDIT CYBER PINGIN TOBAT::==--- ');
Textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(Yellow);
writeln(' ');
Writeln(' <<<< Contoh Soal-Soal Latihan Yang Sangat Mudah >>>)');
Writeln(' <<<<< Kalau gak Bisa Menjawab, lebih baik Sekolah SD dulu >>>>) ');
writeln(' ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(LightRed);
writeln(' = Provided by Teatzo = ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(Yellow);
Writeln(' Pilihan : ');
Textcolor(LightGreen);
Writeln(' 1. Soal-soal Menghitung Luas dan Keliling Bangun datar ');
Writeln(' 2. Keluar ');
Textcolor(Yellow);
Write(' Pilih Angka untuk memilih pilihan : ');
Readln(pilih);
case pilih of
1 : Latihan1;
2 : exit;
end;
until pilih = 2;
end;

Begin {Main Program}
repeat
clrscr;
textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(LightRed);
Writeln(' ---==::BANDIT CYBER PINGIN TOBAT::==--- ');
Textcolor(LightCyan);
Writeln('***************************************** **************************** ');
Textcolor(Yellow);
writeln(' ');
Writeln(' <<<<<<< Cara Cepat Mengerjakan Soal-Soal Matematika >>>>>>) ');
Writeln(' <<<<< disertai contoh soal dan pembahasan >>>>) ');
writeln(' ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(LightRed);
writeln(' = Provided by Teatzo = ');
Textcolor(LightCyan);
writeln('--------------------------------------------------------------------- ');
Textcolor(Yellow);
Writeln(' Pilihan : ');
Textcolor(LightGreen);
Writeln(' 1. Mengerjakan Soal-Soal Mengenai Bangun Datar ');
Writeln(' 2. Mengerjakan Soal-Soal Mengenai Bangun Ruang ');
Writeln(' 3. Mengerjakan Latihan-latihan ');
Writeln(' 4. Credits ');
Writeln(' 5. Keluar ');
Textcolor(Yellow);
Write(' Pilih Angka untuk memilih pilihan : ');
Readln(pilih);
case pilih of
1 : BangunDatar;
2 : BangunRuang;
3 : Latihan;
4 : Credits;
5 : exit;
end;
until pilih = 5;
End.

source From :
Untuk Contoh Program Pascal Lainnya :
- bagaimana-cara-tips.blogspot.com