contoh 3, program prosedur (turbo pascal)

program prosedur;


uses

wincrt;

var

pilihan:integer;

ulang:string;

procedure judul;

begin

writeln('program anak putera batam 2009/2010');

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

end;



procedure menupilihan;

begin

writeln('-----menu pilihan-----');

writeln(' 1. persegi panjang ');

writeln(' 2. segitiga ');

writeln(' 3. lingkaran ');

writeln(' 4. jajaran genjang ');

writeln(' 5. bujur sangkar ');



end;

procedure p_panjang;

var

pa,le,lu:integer;

begin

writeln('prosedur I');

writeln('program persegi panjang');

write('input panjang : ');readln(pa);

write('input lebar : ');readln(le);

lu:=pa*le;

writeln('luas persegi panjang = ',lu);

end;



procedure segitiga;

var

a,ti,lu:real;

begin

writeln('prosedur II');

writeln('program luas segitiga');

write('input alas: ');readln(a);

write('input tinggi : ');readln(ti);

lu:=a*ti/2;

writeln('luas segitiga = ',lu:0:2);

end;



procedure lingkaran;

var

jari,lu,ke:real;

begin

writeln('prosedur III');

writeln('program luas dan keliling lingkaran');

write('input jari-jari : ');readln(jari);

lu:=3.14*jari*jari;

ke:=2*3.14*jari;

writeln('luas lingkaran = ',lu:0:2);

writeln('keliling lingkaran = ',ke:0:2);



end;

procedure jjrn_genjang;

var

alas,ti,luas:real;

begin

writeln('prosedur IV');

writeln('program jajaran genjang');

write('input alas : ');readln(alas);

write('input tinggi : ');readln(ti);

luas:=alas*ti;

writeln('luas jajaran genjang = ',luas:0:2);



end;



procedure bujur_sangkar;

var

sisi,luas:real;

begin

writeln('prosedur V');

writeln('program bujur sangkar');

write('sisi : ');readln(sisi);

luas:=sisi*sisi;



writeln('luas bujur sangakar = ',luas:0:2);



end;

begin

ulang:= 'YA';

while (ulang= 'YA') or (ulang= 'ya') do

begin

judul;

menupilihan;

write('silahkan anda pilih (1/2/3/4) dimenu pilihan: ');readln(pilihan);

case pilihan of

1:p_panjang;

2:segitiga;

3:lingkaran;

4:jjrn_genjang;

5:bujur_sangkar;

end;

write('mau mengulang lagi tekan YA: ');readln(ulang);

end;



readln;

donewincrt;

end.