CONTOH PROGRAM MENU

Program menu_coba;
uses wincrt;
var
pil, pil_u : string[1];
jari : integer;
luas, kel : real;

Procedure wd;
begin
clrscr;
Writeln('---------------------------------');
Writeln('Jari-jari Luas Keliling');
Writeln('---------------------------------');
jari:=10;
While jari < 20 Do
Begin
luas:=3.14*jari*jari;
kel:=2*3.14*jari;
Writeln(jari,' ',luas:4:2,' ',kel:4:2);
jari:= jari+2;
End;
end;

Procedure ru;
begin
clrscr;
Writeln('---------------------------------');
Writeln('Jari-jari Luas Keliling');
Writeln('---------------------------------');
jari:=8;
Repeat
jari:= jari+2;
luas:=3.14*jari*jari;
kel:=2*3.14*jari;
Writeln(jari,' ',luas:4:2,' ',kel:4:2);

Until jari=20;
end;

Procedure fd;
begin
clrscr;
Writeln('---------------------------------');
Writeln('Jari-jari Luas Keliling');
Writeln('---------------------------------');
For jari:=10 to 21 do
begin
luas:=3.14*jari*jari;
kel:=2*3.14*jari;
Writeln(jari,' ',luas:4:2,' ',kel:4:2);
jari:=jari+1;
end;
end;


Begin
repeat;
clrscr;
Writeln('-----------------------------------');
Writeln('PROGRAM LUAS DAN KELILING LINGKARAN');
Writeln('-----------------------------------');
Writeln('[1]. Dengan While Do ');
Writeln('[2]. Dengan Repeat Until ');
Writeln('[3]. Dengan For Do ');
Writeln('-----------------------------------');
Write('Pilih [1/2/3]');readln(pil);
if (pil='1') then
wd else
if (pil='2') then
ru else
fd;
Write('Kembali ke menu [Y/T]');readln(pil_u);
Until pil_u='T';
end.

PROGRAM PENJUMLAHAN MATRIX

Program Menjumlahkan_2Buah_Matriks;
Uses winCrt;
Var B,K,Br,Kl,C,L : Byte;
M1,M2,M3 : Array[1..10,1..10] of Byte;
Begin
Clrscr;
Gotoxy(10,5);Write('***** Menjumlahkan Dua Buah Matriks*****');
Gotoxy(10,7);Write('Jumlah Ordo Matriksnya = x ');
Gotoxy(35,7);Readln(B);
Gotoxy(39,7);Readln(K);

Gotoxy(10,9);write('Masukkan Matriks Ke Satu');
L:=10;
For br := 1 to b do
Begin
c := 15;
For kl :=1 to k do
Begin
gotoxy(c,l);readln(m1[br,kl]);
c := c + 2;
end;
l := l + 1;
end;

Gotoxy(10,14);write('Masukkan Matriks Ke Dua');
l:=15;
For br := 1 to b do
Begin
C := 15;
For kl := 1 to k do
Begin
Gotoxy(c,l);readln(m2[br,kl]);
C := c + 2;
end;
L := L + 1;
end;

Gotoxy(10,18);write('Maka Hasil Penjumlahan Matriks');
L:=20;
For br := 1 to b do
Begin
C:=15;
For kl := 1 to k do
Begin
M3[br,kl] := M1[br,kl] + M2[br,kl];
Gotoxy(c,l);Write(m3[br,kl]);
C := c + 2;
end;
L := L + 1;
end;
Readln;
End.

LATIHAN PROGRAM PASCAL : LOOPing

PROGRAM FOR-DO
Uses wincrt;
var
jari : integer;
luas, kel : real;
begin
Writeln('---------------------------------');
Writeln('Jari-jari Luas Keliling');
Writeln('---------------------------------');
For jari:=10 to 21 do
begin
luas:=3.14*jari*jari;
kel:=2*3.14*jari;
Writeln(jari,' ',luas:4:2,' ',kel:4:2);
jari:=jari+1;
end;
end.

PROGRAM WHILE-DO
Uses wincrt;
var
jari : integer;
luas, kel : real;
begin
Writeln('---------------------------------');
Writeln('Jari-jari Luas Keliling');
Writeln('---------------------------------');
jari:=10;
While jari < 20 Do
Begin
luas:=3.14*jari*jari;
kel:=2*3.14*jari;
Writeln(jari,' ',luas:4:2,' ',kel:4:2);
jari:= jari+2;
End;
end.


PROGRAM REPEAT-UNTIL
Uses wincrt;
var
jari : integer;
luas, kel : real;
begin
Writeln('---------------------------------');
Writeln('Jari-jari Luas Keliling');
Writeln('---------------------------------');
jari:=8;
Repeat
jari:= jari+2;
luas:=3.14*jari*jari;
kel:=2*3.14*jari;
Writeln(jari,' ',luas:4:2,' ',kel:4:2);

Until jari=18;
end.

JAWABAN LATIHAN SOAL HITUNG HONOR/GAJI

PROGRAM LAT_09_GAJI;
Uses WinCrt;
Var
nik : string[10];
nama : string[25];
gol : string[3];
jk : string[1];
status : string[2];
jml_hadir, jml_anak : real;
t_ia, pajak, gb, gp, tj_hadir : real;

Begin
Clrscr;
Gotoxy(10,3);Write('----------------------------------------------');
Gotoxy(10,4);Write('| Menghitung Gaji Karyawan PT. Maju Mundur |');
Gotoxy(10,5);Write('----------------------------------------------');
Gotoxy(10,6);Write('NIK = ');
Gotoxy(10,7);Write('Nama = ');
Gotoxy(10,8);Write('Gol [I/II/III] = ');
Gotoxy(10,9);Write('Jen. Kel [L/P] = ');
Gotoxy(10,10);Write('Status [K/TK] = ');
Gotoxy(10,11);Write('Jml. Anak = ');
Gotoxy(10,12);Write('Jml Hadir [1Bln] = ');
Gotoxy(10,13);Write('----------------------------------------------');

Gotoxy(30,6);readln(nik);
Gotoxy(30,7);readln(nama);
Gotoxy(30,8);readln(gol);
Gotoxy(30,9);readln(jk);
Gotoxy(30,10);readln(status);
Gotoxy(30,11);readln(jml_anak);
Gotoxy(30,12);readln(jml_hadir);

if (gol='I') then
gp:=750000 else
if (gol='II') then
gp:=850000 else
gp:=950000;

tj_hadir:= jml_hadir*15000;

if (jk='L') then

if (status='K') then

if (jml_anak=0) then
t_ia:=10/100*gp else
if (jml_anak=1) then
t_ia:=20/100*gp else
t_ia:=35/100*gp

else
t_ia:=0

else
t_ia:=0;
pajak:=7/100 * gp;
gb := (gp + tj_hadir + t_ia)-pajak;
Gotoxy(10,14);Write('gaji Pokok :', gp:6:2);
Gotoxy(10,15);Write('Transport :', tj_hadir:6:2);
Gotoxy(10,16);Write('Tunjangan Istri Anak :', t_ia:6:2);
Gotoxy(10,17);Write('Pajak :', pajak:6:2);
Gotoxy(10,18);Write('Gaji Bersih :', gb:6:2);
Gotoxy(10,19);Write('================================================');

end.

REFRESHING WITH PASCAL FOR WIN

PROGRAM LAT_03;
Uses Wincrt;
Const
pi=3.14;
Var luas : real;
r : integer;
Begin
clrscr;
Writeln('====================================');
Writeln('Menghitung Luas Lingkaran ');
Writeln('------------------------------------');
Writeln('Jari-Jari Lingkaran : ');readln(r);
luas := pi * r * r;
Writeln('Luas Lingkaran :',luas:3:2);
End.

PROGRAM LAT_04;
Uses Wincrt;
Var luas : real;
alas, tinggi : integer;
Begin
clrscr;
Writeln('====================================');
Writeln('Menghitung Luas Segitiga : ');
Writeln('------------------------------------');
Writeln('Alas : ');readln(alas);
Writeln('Tinggi : ');readln(tinggi);
luas := 0.5*(alas * tinggi);
Writeln('Luas Segitiga :',luas:3:2);
End.

PROGRAM LAT_05;
Uses Wincrt;
Var luas : rata;
n_uas, n_uts, n_quis, n_tb, n_hadir : integer;
Begin
clrscr;
Writeln('====================================');
Writeln('Menghitung Rata-Rata Nilai: ');
Writeln('------------------------------------');
Writeln('Nilai UAS : ');readln(n_uas);
Writeln('Nilai UTS : ');readln(n_uts);
Writeln('Nilai Quis : ');readln(n_quis);
Writeln('Nilai Tugas Berstruktur : ');readln(n_tb);
Writeln('NIlai Kehadiran : ');readln(n_hadir);

rata := (n_uas+n_uts+n_quis+n_tb+n_hadir)/5;
Writeln('Rata –Rata Nilai :',rata:3:2);
End.

PROGRAM LAT_06;
{Buat Rumusnya dengan prosentase seperti yang dibahas dalam matakuliah Algoritma…!

PROGRAM PASCAL_PEMROGRAMAN_FILE;

Uses
Wincrt;
type
rec_mhs = record
glb : string[3];
no_dft : string[12];
nama : string[25];
nilai : integer;
end;
var
fmhs : file of rec_mhs;
data_mhs : rec_mhs;
nil2 : real;
grade : char;
ulang : boolean;
yn : char;
jumrec : longint;
tcari : string;
i,brs,hal : integer;

Procedure tampil;
begin
ulang:=true;
while ulang do
begin
assign(fmhs,'mahas.dat');
reset(fmhs);
jumrec:=filesize(fmhs);
clrscr;
brs:=0;hal:=0;
gotoxy(3,2);Write('Laporan Test Penentuan Grade Gelombang ke [I/II/III] :');readln(tcari);
seek(fmhs,0);
for i:=1 to jumrec do
begin
if brs=0 then
begin
clrscr;
hal:=hal+1;
Writeln('<-SEKOLAH TINGGI MANAJEMEN INFORMATIKA DAN KOMPUTER BANTEN JAYA SERANG->');
Writeln(' <-- DAFTAR NILAI CALON MAHASISWA BARU --> ');
Writeln(' Hal :',hal);
Writeln('________________________________________________________________________');
Writeln(' NO No. Daftar Nama Calon Mhs Jwb. Benar Nilai Grade ');
Writeln('________________________________________________________________________');
end;
brs:=brs+1;
read(fmhs,data_mhs);
With data_mhs do
begin
if tcari=glb then
begin
{nil2:=(nilai*5)/3;}
nil2:=nilai;
if (nil2>=85) and (nil2<=100) then
grade := ('A') else
if (nil2>=70) and (nil2<85) then
grade := ('B') else
if (nil2>=55) and (nil2<70) then
grade := ('C') else
if (nil2>=40) and (nil2<55) then
grade := ('D') else
grade := ('E');
Writeln(i:3,' ',no_dft:10,' ',nama:20,' ',nilai:2,' ',nil2:0:2,' ',grade:2,'');
if brs=10 then
begin
Writeln('_______________________________________________________________________');
writeln('Tekan Enter Untuk melanjutkan......');
readln;
brs:=0;
end;
end;
end;
end;
Writeln('________________________________________________________________________');
Writeln ('Data habis...........');
Write('Cetak Lagi (Y/T):');
readln(yn);
If (yn='T') or (yn='t') then
ulang:=false;
readln;
end;
close(fmhs);
end;

begin
clrscr;
assign(fmhs,'mahas.dat');
{$i-}
reset(fmhs);
{$i+}
if ioresult<>0 then rewrite(fmhs);
jumrec:=filesize(fmhs);
seek(fmhs,jumrec);
ulang:=true;
while ulang do
begin
clrscr;
gotoxy(5,2);write(' P E N E R I M A A N M A H A S I S W A B A R U ( P M B ) ');
gotoxy(5,3);write(' T A H U N A K A D E M I K 2 0 0 4 / 2 0 0 5 ');
gotoxy(5,4);write('_____________________________________________________________________');
gotoxy(5,6);write(' GELOMBANG [I/II/III] :');
gotoxy(5,7);write(' NOMOR PENDAFTARAN :');
gotoxy(5,8);write(' NAMA CALON MAHASISEWA:');
gotoxy(5,9);write(' NILAI TOTAL :');
gotoxy(5,10);write('_____________________________________________________________________');
with data_mhs do
begin
gotoxy(30,6);readln(glb);
gotoxy(30,7);readln(no_dft);
gotoxy(30,8);readln(nama);
gotoxy(30,9);readln(nilai);
write(fmhs,data_mhs);
end;
gotoxy(4,11);write ('Input Lagi [Y/T] =:');
gotoxy(5,12);write('_____________________________________________________________________');
gotoxy(30,11);readln(yn);
if (yn='t') or (yn='T') then
ulang:=false;
end;
close(fmhs);
tampil;
end.