Contoh Program Turbo Pascal Mengenai "" PROCEDURE ""

program procedur;

uses wincrt;

var

pilihan:integer;

ulang:char;

procedure judul;

begin

writeln(' PROGRAM PERHITUNGAN ');

writeln(' =============================');

end;

procedure menu_pilihan;

begin

writeln(' MENU PILIHAN ');

writeln(' 1. KUBUS ');

writeln(' 2. BALOK ');

writeln(' 3. SILINDER ');

writeln(' 4. KERUCUT ');

writeln(' 5. PRISMA TEGAK SEGITIGA ');

writeln(' 6. TRAPESIUM ');

writeln(' 7. FAKTORIAL ');

writeln(' 8. KECEPATAN ');

writeln(' 9. PERCEPATAN ');

writeln(' 10. LABA_RUGI ');

end;

procedure kubus;

var

r,vol:longint;

begin

writeln;write('PROGRAM KUBUS');writeln;

write('--Masukkan panjang rusuk kubus : ');readln(r);

vol:=r*r*r;

writeln('Volume Kubus tersebut adalah ',vol);

end;

procedure balok;

var

p,l,t,vol:longint;

begin

writeln;

write('PROGRAM BALOK');writeln;

write('--Masukkan panjang balok : ');readln(p);

write('--Masukkan lebar balok : ');readln(l);

write('--Masukkan tinggi balok : ');readln(t);

vol:=p*l*t;

writeln('Volume Balok tersebut adalah ',vol);

end;

procedure silinder;

var

r,t,vol:real;

begin

write('PROGRAM SILINDER');writeln;

write('--Masukkan jari-jari alas silinder : ');readln(r);

write('--Masukkan tinggi tabung : ');readln(t);

vol:=22/7*r*r*t;

writeln('Volume Tabung tersebut adalah ',vol:0:2);

end;

procedure kerucut;

var

r,t,vol:real;

begin

writeln;

write('PROGRAM KERUCUT');writeln;

write('--Masukkan jari-jari alas kerucut : ');readln(r);

write('--Masukkan tinggi kerucut : ');readln(t);

vol:=22/7*r*r*t/3;

writeln('Volume Kerucut tersebut adalah ',vol:0:2);

end;

procedure prisma_tegak_segitiga;

var

a,t,t_pris,vol:real;

begin

writeln;

write('PROGRAM PRISMA TEGAK SEGITIGA');writeln;

write('--Masukkan alas segitiga : ');readln(a);

write('--Masukkan tinggi segitiga : ');readln(t);

write('--Masukkan tinggi prisma : ');readln(t_pris);

vol:=a*t*t_pris/6;

writeln('Volume Prisma tegak segitiga tersebut adalah ',vol:0:2);

end;

procedure trapesium;

var

sisi1,sisi2,t,lu:real;

begin

writeln;

write('PROGRAM TRAPESIUM');writeln;

write('--Masukkan panjang sisi atas : ');readln(sisi1);

write('--Masukkan panjang sisi bawah : ');readln(sisi2);

write('--Masukkan tinggi trapesium : ');readln(t);

lu:=(sisi1+sisi2)*t/2;

writeln('Luas Trapesium tersebut adalah ',lu:0:2);

end;

procedure faktorial;

var

i,n,faktorial:longint;

begin

writeln;

write('PROGRAM FAKTORIAL');writeln;

write('--Masukkan nilai n : ');readln(n);

begin

i:=1;

faktorial:=1;

while i<=n do

begin

faktorial:=faktorial*i;

i:=i+1;

end;

end;

writeln('Faktorial dari bilangan ',n,' adalah : ',faktorial);

end;

procedure kecepatan;

var

jarak,waktu,kec:real;

begin

writeln;

write('PROGRAM KECEPATAN');writeln;

write('--Masukkan jarak yang ditempuh : ');readln(jarak);

write('--Masukkan waktu yang diperlukan : ');readln(waktu);

kec:=jarak/waktu;

writeln('Kecepatannya adalah ',kec:0:2);

end;

procedure percepatan;

var

kec,waktu,perc:real;

begin

writeln;

write('PROGRAM PERCEPATAN');writeln;

write('--Masukkan kecepatannya : ');readln(kec);

write('--Masukkan waktu yang diperlukan : ');readln(waktu);

perc:=kec/waktu;

writeln('Percepatan : ',perc:0:2);

end;

procedure laba_rugi;

var

h_beli,h_jual,laba,rugi:longint;

begin

writeln;

write('PROGRAM LABA_RUGI');writeln;

write('--Masukkan harga pembelian : ');readln(h_beli);

write('--Masukkan harga penjualan : ');readln(h_jual);

laba:=h_jual-h_beli;

rugi:=h_beli-h_jual;

if h_beli>h_jual then

writeln('Rugi : ',rugi);

if h_beli

writeln('Laba : ',laba) else writeln('Laba = 0 , Rugi = 0');

end;

begin

ulang:='y';

while (ulang='y') or (ulang='Y') do

begin

clrscr;

judul;writeln;

menu_pilihan;writeln;

write('Procedure yang akan dipilih (1-10) : ');readln(pilihan);

case pilihan of

1:KUBUS;

2:BALOK;

3:SILINDER;

4:KERUCUT;

5:PRISMA_TEGAK_SEGITIGA;

6:TRAPESIUM;

7:FAKTORIAL;

8:KECEPATAN;

9:PERCEPATAN;

10:LABA_RUGI else

writeln;writeln('Anda salah meng-input kategori !');

end;writeln;

write('Apakah anda mau mengulang (y/n)? ');readln(ulang);

end;

readln;donewincrt;

end.