Kumpulan Program PASCAL

Program Menghitung_Jarak;
Uses WinCrt;
var
x1,x2,y1,y2:integer;
d:real;
begin
Writeln('Program Menghitung Jarak Titik A dan B');
Writeln('======================================');
Writeln;
Write('Masukan Nilai A (X1): ');readln(x1);
Write('Masukan Nilai B (X2): ');readln(x2);
Write('Masukan Nilai A (Y1): ');readln(y1);
Write('Masukan Nilai B (Y2): ');readln(y2);
d:=sqrt(sqr(x2-x1)+sqr(y2-y1));
Writeln;
Writeln('Jadi Jarak Titik A ke B Adalah: ',d:4:2);
end.

Program Konversi_Suhu;
Uses WinCrt;
var f,c:real;
begin
Writeln('Program Konversi Fareinheit Ke Celcius');
Writeln('======================================');
Writeln;
Write('Masukan Suhu dalam Farenheit: ');readln(f);
c:=5/9*(f-32);
Writeln;
Writeln('Jadi Suhu Dalam Celcius Adalah: ',c:4:2);
end.

Program Konversi_Waktu;
Uses Wincrt;
Var j,m,d,h:integer;
begin
Writeln('Program Konversi Waktu');
Writeln('======================');
Writeln;
Write('Masukkan Jumlah Jam : ');readln(j);
Write('Masukkan Jumlah Menit : ');readln(m);
Write('Masukkan Jumlah Detik : ');readln(d);
Writeln;
h:=(j*3600)+(m*60)+d;
Writeln('Jadi Hasil Konversi : ',h,' Detik');
end.

Program Konversi_Waktu1;
Uses WinCrt;
var j,m,d,dm,sisa,sisa1:integer;
begin
Writeln('Program Konversi Waktu 1');
Writeln('========================');
Writeln;
Write('Masukkan Jumlah Detik : ');readln(dm);
if (dm/3600)>0 then
begin
j:=dm div 3600;
sisa:=dm-(j*3600);
end
else
begin
j:=0;
sisa:=dm;
end;
if (sisa/60)>0 then
begin
m:=sisa div 60;
sisa1:=sisa-(m*60);
end
else
begin
m:=0;
sisa1:=sisa;
end;
d:=sisa1;
Writeln;
Writeln('Hasil => ',j,' jam ',m,' menit ',d,' detik');
end.

Program Menghitung_Selisih_Waktu;
Uses WinCrt;
Var j,m,d,h,j1,m1,d1,h1,hj,hm,sl,sisa,sisa1:longint;
Begin
Writeln('Program Menghitung Selisih Waktu');
Writeln('================================');
Writeln;
Write('Waktu ke-1 jam : ');readln(j);
Write('Waktu ke-1 Menit : ');readln(m);
Write('Waktu ke-1 Detik : ');readln(d);
Writeln('================================');
Write('Waktu ke-2 jam : ');readln(j1);
Write('Waktu ke-2 Menit : ');readln(m1);
Write('Waktu ke-2 Detik : ');readln(d1);
h:=(j*3600)+(m*60)+d;
h1:=(j1*3600)+(m1*60)+d1;
sl:=h1-h;
if (sl/3600)>0 then
begin
hj:=sl div 3600;
sisa:=sl-(hj*3600);
end
else
begin
hj:=0;
sisa:=sl;
end;
if (sisa/60)>0 then
begin
hm:=sisa div 60;
sisa1:=sisa-(hm*60);
end
else
begin
hm:=0;
sisa1:=sisa;
end;
Writeln;
Writeln('Selisih Waktu: ',hj,' jam ',hm,' Menit ',sisa1,' Detik');
End.

Program Menukar_Nilai;
Uses WinCrt;
var A,B,C:integer;
Begin
Writeln('Program Menukar Nilai A Menjadi B');
Writeln('=================================');
Writeln;
Write('Masukkan Nilai A: ');readln(A);
Write('Masukkan Nilai B: ');readln(B);
Writeln;
C:=A;
A:=B;
B:=C;
Writeln;
Writeln('Hasil A=',A,' B=',B);
End.

Program Menukar_Nilai1;
Uses WinCrt;
var A,B:integer;
Begin
Writeln('Program Menukar Nilai A Menjadi B');
Writeln('=================================');
Writeln;
Write('Masukkan Nilai A: ');readln(A);
Write('Masukkan Nilai B: ');readln(B);
Writeln;
A:=A-B;
B:=B+A;
A:=B-A;
Writeln;
Writeln('Hasil A=',A,' B=',B);
End.

Program Urut_Bilangan;
Uses Wincrt;
Var A,B,C:integer;
Begin
Writeln('Program Mengurut Bilangan');
Writeln('=========================');
Writeln;
Write('Masukkan Nilai A: ');readln(A);
Write('Masukkan Nilai B: ');readln(B);
Write('Masukkan Nilai C: ');readln(C);
Writeln;
if (A<=B) and (A<=C) then
if (B<=C) then
Writeln(A,' ',B,' ',C)
else
Writeln(A,' ',C,' ',B)
else if (B<=A) and (B<=C) then
if (A<=C) then
Writeln(B,' ',A,' ',C)
else
Writeln(B,' ',C,' ',A)
else if (C<=A) and (C<=B) then
if (A<=B) then
Writeln(C,' ',A,' ',B)
else
Writeln(C,' ',B,' ',A)
End.

Program Menentukan_Segitiga;
Uses Wincrt;
Var A,B,C,X,Y:integer;
Begin
Writeln('Program Menentukan Segitiga');
Writeln('=========================');
Writeln;
Write('Masukkan Sisi A: ');readln(A);
Write('Masukkan Sisi B: ');readln(B);
Write('Masukkan Sisi C: ');readln(C);
Writeln;
X:=sqr(C);
Y:=sqr(A)+sqr(B);
if (X<Y) then
Writeln('Segitiga Lancip')
else if (X=Y) then
Writeln('Segitiga Siku-Siku')
else
Writeln('Segitiga Tumpul')
End.

Program Persamaan_Kuadrat;
Uses Wincrt;
Var A,B,C:integer;
D,X1,X2:real;
Begin
Writeln('Program Persamaan Kuadrat');
Writeln('=========================');
Writeln;
Write('Masukkan Nilai A: ');readln(A);
Write('Masukkan Nilai B: ');readln(B);
Write('Masukkan Nilai C: ');readln(C);
Writeln;
D:=sqr(B)-(4*A*C);
if (D>0) then
begin
X1:=(-B+sqrt(D))/2*A;
X2:=(-B-sqrt(D))/2*A;
Writeln('X1= ',X1:4:1,' ','X2= ',X2:4:1);
end
else if (D=0) then
begin
X1:=-B/(2*A);
Writeln('X1=X2=',X1:4:1);
end
else
Writeln('Akar Imajiner!');
End.

Program Faktorial;
Uses Wincrt;
Var i,n,x:integer;
Begin
Writeln('Program Faktorial');
Writeln('=================');
Writeln;
Write('Masukkan Nilai Faktorial: ');Readln(n);
Writeln;
if (n<=0) then
Writeln('Hasil Faktorial: ',1)
else
Begin
x:=1;
For i := 1 to n do
x:=x*i;
Writeln('Hasil Faktorial: ',x);
End;
End.

Program Menghitung_Rata_Rata;
Uses Wincrt;
Var n,x,i,tot:integer;
rata:real;
Begin
Writeln('Program Menghitung Rata-Rata');
Writeln('============================');
Writeln;
Write('Masukkan Jumlah Bilangan: ');readln(n);
Writeln;
Writeln('Masukkan Bilangan: ');
tot:=0;
For i:= 1 to n do
Begin
Readln(x);
tot:=tot+x;
End;
rata:=tot/n;
Writeln;
Writeln('Total Bilangan: ',tot:6);
Writeln('Rata-Rata : ',rata:6:2);
End.

Program Menghitung_Pangkat;
Uses Wincrt;
Var i,n,m: integer;
x: real;
Begin
Writeln('Program Menghitung Pangkat');
Writeln('==========================');
Writeln;
Write('Masukkan Jumlah Pangkat : ');readln(n);
Write('Masukkan Bil. Yang DiPangkat : ');readln(m);
Writeln;
x:=1;
if (n>0) then
For i:= 1 to n do
x:=x*m
else if (n=0) then
x:=1
else
begin
n:=-1*n;
For i:= 1 to n do
begin
x:=x*(1/m);
end;
end;
Writeln('Hasil Pangkat: ',x:6:2);
End.

Program Menampilkan_Bintang;
Uses Wincrt;
Var i,j,n:integer;
Begin
Writeln('Program Menampilkan Bintang');
Writeln('===========================');
Writeln;
Write('Masukkan Jumlah Baris: ');readln(n);
For i:= 1 to n do
Begin
For j:= 1 to i do
Write('*');
Writeln;
End;
End.

Program Solusi_Bilangan_Bulat;
Uses Wincrt;
Var i,n,x,y,z:integer;
Begin
Writeln('Program Solusi Bilangan Bulat');
Writeln('=============================');
Writeln;
for x:= 0 to 25 do
for y:= 0 to 25 do
for z:= 0 to 25 do
if (x+y+z=25) then
begin
writeln(x,' ',y,' ',z);
readln;
end;
End.

Program array1;
Uses Wincrt;
Var x : array [1..100] of integer;
n,i :integer;
Begin
Writeln('Program Array');
Writeln('=============');
Writeln;
Write('Masukkan Jumlah Data: ');readln(n);
Writeln;
For i:= 1 to n do
Readln(x[i]);
Writeln;
Write('Data Yang Telah Dimasukkan: ');
For i:= 1 to n do
Write(x[i],' ');
End.

Program Array2;
Uses Wincrt;
Var x : array [1..100] of integer;
n,i,max,min : integer;
Begin
Writeln('Program Array');
Writeln('=============');
Writeln;
Write('Masukkan Jumlah Data: ');readln(n);
Writeln;Writeln('Data Harus Urut');
For i:= 1 to n do
Readln(x[i]);
Writeln;
Write('Data Yang Telah Dimasukkan: ');
max:=x[1];
min:=x[1];
For i:= 1 to n do
Begin
Write(x[i],' ');
if (max<x[i]) then
max:=x[i]
else
min:=x[i];
End;
Writeln;
Writeln('Nilai Maximal: ',max);
Writeln('Nilai Minimal: ',min);
End.

Program Array3;
Uses Wincrt;
Var x: array [1..100] of integer;
n,i,max,min,tot,pos:integer;
rt,sdt,sd,md:real;
Begin
Writeln('Program Array');
Writeln('=============');
Writeln;
Write('Masukkan Jumlah Data (Data harus Urut): ');readln(n);
Writeln;
For i:= 1 to n do
Readln(x[i]);
Writeln;
Write('Data Yang Telah Dimasukkan: ');
max:=x[1];
min:=x[1];
tot:=0;
sdt:=0;
For i:= 1 to n do
Begin
Write(x[i],' ');
if (max<x[i]) then
max:=x[i]
else
min:=x[i];
tot:=tot+x[i];
End;
rt:=tot/n;
For i:= 1 to n do
Begin
sdt:=sdt+sqr(x[i]-rt);
End;
sd:=sqrt(sdt/(n-1));
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('Nilai Maximal : ',max);
Writeln('Nilai Minimal : ',min);
Writeln('Nilai Rata-Rata : ',rt:4:2);
Writeln('Standar Deviasi : ',sd:4:2);
Writeln('Median : ',md:4:2);
End.

Program Polindrom;
Uses Wincrt;
Var kt,hkt,hkt1:string;
i,j:integer;
Begin
Writeln('Program Polindrom');
Writeln('=================');
Writeln;
Write('Masukkan Kata: ');Readln(kt);
Writeln;
j:=length(kt);
hkt:='';
For i:= 1 to j do
hkt:=hkt+kt[i];
For i:= j downto 1 do
hkt1:=hkt1+kt[i];
Writeln('Asal: ',hkt,' Dibalik: ',hkt1);
Writeln;
if (hkt=hkt1) then
Writeln('Kata Tersebut Termasuk Polindrom!')
else
Writeln('Kata Tersebut Tidak Termasuk Polindrom!');
End.

Program Data_mahasiswa;
Uses Wincrt;
Type mhs = record
NIM : String[4];
Nama : String[20];
Prodi : String[20];
IP : Real;
End;
Var data : mhs;
Begin
With data do
Begin
Write('NIM : ');Readln(NIM);
Write('Nama : ');Readln(Nama);
Write('Program Studi : ');Readln(Prodi);
Write('IP : ');Readln(IP);
End;
Writeln;
Writeln;
Writeln('NIM : ',data.NIM);
Writeln('Nama : ',data.Nama);
Writeln('Program Studi : ',data.Prodi);
Writeln('IP : ',data.IP:2:2);
End.

Program Pecahan;
Uses Wincrt;
Var pmb,pny : array [1..10] of integer;
i,j,n,t1,t2 : integer;
Begin
Writeln('Program Pecahan');
Writeln('===============');
Writeln;
Write('Jumlah Data Pecahan: ');Readln(n);
Writeln;
For i := 1 to n do
Begin
Write('Pembilang ke-',i,' : ');Readln(pmb[i]);
Write('Penyebut ke-',i,' : ');Readln(pny[i]);
End;
Writeln;
Writeln('Pecahan Yang Di Masukkan:');
For i := 1 to n do
Writeln(pmb[i],'/',pny[i]);
For i := 1 to n-1 do
For j := i+1 to n do
Begin
if ((pmb[i]/pny[i])>(pmb[j]/pny[j])) then
munitas eLearning IlmuKomputer.Com
Copyright © 2003-2008 IlmuKomputer.Com
14
Begin
t1:=pmb[i];
t2:=pny[i];
pmb[i]:=pmb[j];
pny[i]:=pny[j];
pmb[j]:=t1;
pny[j]:=t2;
End;
End;
Writeln;
Writeln('Hasilnya: ');
For i := 1 to n do
Writeln(pmb[i],'/',pny[i]);
End.

Program DataPegawai;
Uses Wincrt;
Type Pegawai = record
NIP : String[9];
Nama : String[30];
Golongan : Char;
Jamkerja : Real;
End;
Var
Data : Pegawai;
Gapok : Real;
Insentif,Gaber : Real;
Ul : Char;
Begin
Repeat
Clrscr;
Writeln('Entry Data Pegawai PT. XYZ');
Writeln('==========================');
Writeln;
Write('NIP : ');Readln(Data.NIP);
Write('Nama : ');Readln(Data.Nama);
Write('Golongan : ');Readln(Data.Golongan);
Write('Jam Kerja : ');Readln(Data.Jamkerja);
Writeln;
Writeln;
Case Data.Golongan of
'1' : Gapok:=1000000;
'2' : Gapok:=1500000;
'3' : Gapok:=2000000;
Else
Gapok:=0;
End;
if Data.Jamkerja>200 then
Insentif:=(Data.Jamkerja-200)*10000
else
Insentif:=0;
Gaber:=Gapok+Insentif;
Clrscr;
Writeln('Laporan Gaji Pegawai');
Writeln('PT. XYZ');
Writeln;
Writeln('=============================================================
===============');
Writeln('|NIP | Nama | Golongan | Jam
Kerja | Gaji |');
Writeln('=============================================================
===============');
Writeln('|',Data.NIP:10,'|',Data.Nama:25,'|',Data.Golongan:10,'|',Data
.Jamkerja:11:0,'|',Gaber:14:2,'|');
Writeln('=============================================================
===============');
Writeln;
Write('Mau Ulang Lagi? [Y/T]: ');Readln(Ul);
Until Upcase(Ul)<>'Y';
End.

Program DataPegawai_Array;
Uses Wincrt;
Type Pegawai = record
NIP : String[9];
Nama : String[30];
Golongan : Char;
Jamkerja : Real;
End;
Var
Data : Array [1..100] of Pegawai;
Gapok,Insentif,Gaber : Real;
Tot,Rata : Real;
Ul : Char;
i,n : Integer;
Begin
Repeat
Clrscr;
Write('Masukkan Jumlah Data Pegawai : ');Readln(n);
For i := 1 to n do
Begin
Clrscr;
Writeln('Entry Data Pegawai PT. XYZ');
Writeln('==========================');
Writeln;
Writeln('Data Ke-',i);
Writeln;
Write('NIP : ');Readln(Data[i].NIP);
Write('Nama : ');Readln(Data[i].Nama);
Write('Golongan : ');Readln(Data[i].Golongan);
Write('Jam Kerja : ');Readln(Data[i].Jamkerja);
Writeln;
End;
Clrscr;
Writeln('Laporan Gaji Pegawai');
Writeln('PT. XYZ');
Writeln;
Writeln('=============================================================
==================');
Writeln('|NO. |NIP | Nama | Golongan | Jam
Kerja | Gaji |');
Writeln('=============================================================
==================');
Tot:=0;
For i := 1 to n do
Begin
Case Data[i].Golongan of
'1' : Gapok:=1000000;
'2' : Gapok:=1500000;
'3' : Gapok:=2000000;
Else
Gapok:=0;
End;
if Data[i].Jamkerja>200 then
Insentif:=(Data[i].Jamkerja-200)*10000
else
Insentif:=0;
Gaber:=Gapok+Insentif;
Tot:=Tot+Gaber;
Writeln('|',i:4,'|',Data[i].NIP:10,'|',Data[i].Nama:25,'|',Data[i].Gol
ongan:10,'|',Data[i].Jamkerja:10:0,
'|',Gaber:13:0,'|');
End;
Rata:=Tot/n;
Writeln('=============================================================
==================');
Writeln('Total Gaji Keseluruhan : Rp.',Tot:12:0);
Writeln('Rata Gaji Pegawai : Rp.',Rata:12:0);
Writeln;
Write('Mau Ulang Lagi? [Y/T]: ');Readln(Ul);
Until Upcase(Ul)<>'Y';
End.

Program Prosedur_aktual;
Uses Wincrt;
Var Y:char;
m:byte;
Procedure Tampil(x:char;n:byte);
Var i:integer;
Begin
for i := 1 to n do
Write(x);
Writeln;
End;
Begin
Tampil('+',8);
Tampil('*',10);
Tampil('A',5);
Y:='B';
m:=11;
Tampil(Y,m);
End.

Program Prosedur_reference;
Uses Wincrt;
Var a,b,c : Integer;
Procedure Coba(x,y:integer; var z:integer);
Begin
x:=x+1;
y:=y+1;
z:=x+y;
End;
Begin
a:=2;b:=3;c:=0;
Coba(a,b,c);
Writeln('a = ',a);
Writeln('b = ',b);
Writeln('c = ',c);
End.

Program Tukar_Nilai;
Uses WinCrt;
Type Larik = Array [1..100] of Integer;
Var
A,B : Larik;
i,x,m : Byte;
Procedure Tukar;
Var T:Integer;
Begin
x:=0;
For i := 1 to m do
Begin
T:=A[i];
A[i]:=B[i];
B[i]:=T;
Gotoxy(15+x,6);Write(A[i]);
Gotoxy(15+x,7);Write(B[i]);
x:=x+2;
End;
End;
Procedure Input;
Var x:Byte;
Begin
Randomize;
x:=0;
For i := 1 to m do
Begin
A[i]:=Random(10);
B[i]:=Random(10);
Gotoxy(15+x,12);Write(A[i]);
Gotoxy(15+x,13);Write(B[i]);
x:=x+2;
End;
End;
Begin
Gotoxy(21,1);Write('Program Menukar Nilai Larik A & B');
Gotoxy(21,2);Write('=================================');
Gotoxy(1,4);Write('Jumlah Data : ');Readln(m);
Gotoxy(5,6);Write('Nilai A:');
Gotoxy(5,7);Write('Nilai B:');
Input;
Gotoxy(1,9);Write('Setelah Di Tukar');
Gotoxy(1,10);Write('================');
Gotoxy(5,12);Write('Nilai A:');
Gotoxy(5,13);Write('Nilai B:');
Tukar;
End.

Program Urut_Pecahan;
Uses Wincrt;
Var pmb,pny : array [1..10] of integer;
i,j,n : integer;
Procedure Urut(x : integer);
Var t1,t2 : integer;
Begin
For i := 1 to x-1 do
For j := i+1 to x do
Begin
if ((pmb[i]/pny[i])>(pmb[j]/pny[j])) then
Begin
t1:=pmb[i];
t2:=pny[i];
pmb[i]:=pmb[j];
pny[i]:=pny[j];
pmb[j]:=t1;
pny[j]:=t2;
End;
End;
End;
Begin
Gotoxy(30,1);Write('Program Urut Pecahan');
Gotoxy(30,2);Write('====================');
Gotoxy(1,4);Write('Jumlah Data Pecahan: ');Readln(n);
For i := 1 to n do
Begin
Gotoxy(1,5+i);Write('Input Pecahan ke-',i,' : ');Readln(pmb[i]);
Gotoxy(24,5+i);Write('/ ');Readln(pny[i]);
End;
Urut(n);
Writeln;
Writeln('Hasilnya: ');
For i := 1 to n do
Writeln(pmb[i],'/',pny[i]);
End.

Program Indeks_Larik;
Uses Wincrt;
Var
x : Array [1..100] of Integer;
i,n : Integer;
Ul : Char;
Procedure CekIndeks(m: integer);
Var t: Integer;
Begin
Writeln;
Write('Nomor Indeks > Total Nilai Larik Sebelumnya Adalah: ');
t:=0;
For i := 1 to m-1 do
Begin
t:=t+x[i];
if x[i+1]>t then
Write(i+1,' ');
End;
End;
Begin
Repeat
ClrScr;
Writeln('Program Menentukan Indeks Larik');
Writeln('===============================');
Writeln;
Write('Jumlah Data : ');Readln(n);
Writeln;
For i := 1 to n do
Begin
Write('Data Ke-',i,': ');Readln(x[i]);
End;
CekIndeks(n);
Writeln;Writeln;
Write('Mau Coba Lagi [Y/T]: ');Readln(Ul);
Until Upcase(Ul)<>'Y';
End.

Program Acckerman;
Uses Wincrt;
Function ACC(m,n:integer):integer;
Begin
if m=0 then
begin
ACC:=n+1;
Write(n+1,' ');
end
else if n=0 then
begin
ACC:=ACC(m-1,1);
Writeln(ACC(m-1,1),' ');
end
else
begin
ACC:=ACC(m-1,ACC(m,n-1));
Writeln(ACC(m-1,ACC(m,n-1)),' ');
end;
End;
Begin
Writeln(ACC(2,1));
End.

Program Menghitung_Suku;
Uses Wincrt;
Var tot,suku:real;
i:integer;
Begin
tot:=0;
suku:=2;
While tot <= 3.9999 Do
Begin
tot:=tot+suku;
i:=i+1;
suku:=suku/2;
End;
writeln(i);
End.

Program Menyusun_Kali_Matrik;
Uses Wincrt;
Var i,j,n:integer;
Begin
Write('Masukkan Jumlah Perkalian: ');Readln(n);
Write('*':5);
For i:= 1 to n do
Write(i:5);
Writeln;
For i:= 1 to n do
Begin
Write(i:5);
For j:= 1 to n do
write(i*j:5);
Writeln;
End;
End.

Program matrik;
uses wincrt;
type data = array[1..10,1..10] of integer;
var matrikI,matrikII : data;
baris,kolom,pil : integer;
procedure isimatrik;
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 jumlahmatrik(m1,m2 : data);
var hasil : data;
i,j : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=m1[i,j]+m2[i,j];
end;
clrscr;
writeln('Hasil Penjumlahan MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
procedure kurangmatrik(m1,m2 : data);
var hasil : data;
i,j : integer;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
hasil[i,j]:=m1[i,j]-m2[i,j];
end;
clrscr;
writeln('Hasil Penjumlahan MATRIK');
for i:=1 to baris do
for j:=1 to kolom do
begin
gotoxy(j*10,i*5);
write(hasil[i,j]);
end;
end;
procedure kalimatrik(m1,m2 : 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]+m1[i,z]*m2[z,j];
end;
clrscr;
writeln('Hasil Penjumlahan MATRIK');
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(' M E N U');
writeln('(1) Penjumlahan Matrik');
writeln('(2) Pengurangan Matrik');
writeln('(3) Perkalian Matrik');
write('Pilihan = ');readln(pil);
clrscr;
case pil of
1 : begin
isimatrik;
jumlahmatrik(matrikI,matrikII);
end;
2 : begin
isimatrik;
kurangmatrik(matrikI,matrikII);
end;
3 : begin
isimatrik;
kalimatrik(matrikI,matrikII);
end;
end;
end.

Program Max1_Max2;
Uses Wincrt;
Var
x: array[1..100] of integer;
i,n,max,sec: integer;
Begin
Write('Masukkan Jumlah Data: ');readln(n);
for i := 1 to n do
begin
x[i]:=random(18);
write(x[i],' ');
{readln(x[i]);}
end;
max:=x[1];
sec:=0;
for i := 1 to n do
begin
if (x[i]>max) then
begin
if (sec<max) then
sec:=max;
max:=x[i];
end;
if (max>x[i]) and (sec<x[i]) then sec:=x[i];
end;
writeln;
writeln('Max= ',max);
writeln('Second= ',sec);
End.

Program Pisahkan_Rekursif;
Uses Wincrt;
Procedure pisah(x,y:integer);
Begin
Writeln(x,'<--->',y);
if x<y then
begin
pisah(x,(x+y) div 2);
pisah((x+y) div 2+1,y);
end;
End;
Begin
pisah(5,10);
End.

Program Polinomial;
Uses Wincrt;
Type Larik = Array [1..10] of Integer;
var P1,P2,HP: Larik;
i,n,m,o: Integer;
Procedure Input(q:integer; var P:Larik);
Begin
for i := q+1 downto 1 do
begin
Write('nilai dari pangkat ke-',i-1,': ');Readln(P[i]);
end;
End;
Procedure Tampil(q:integer; P:Larik);
Begin
for i := q+1 downto 1 do
begin
if P[i]<>0 then
if i=q+1 then
Write(P[i],'x^',i-1)
else if P[i]>0 then
begin
if i=1 then
Write('+',P[i])
else if i=2 then
Write('+',P[i],'x')
else
Write('+',P[i],'x^',i-1);
end
else
begin
if i=1 then
Write(P[i])
else if i=2 then
Write(P[i],'x')
else
Write(P[i],'x^',i-1);
end;
end;
End;
Begin
Clrscr;
Writeln('Program Penjumlahan 2 Polinomial');
Writeln('================================');
Write('Masukkan Jumlah Pangkat Tertinggi Polinomial Ke-1:
');Readln(n);
Input(n,P1);
Write('P1 = ');
Tampil(n,P1);
Writeln;Writeln;
Write('Masukkan Jumlah Pangkat Tertinggi Polinomial Ke-2:
');Readln(m);
Input(m,P2);
Write('P2 = ');
Tampil(m,P2);
if m>n then
o:=m
else
o:=n;
Writeln;
Writeln;
Write('Hasil Polinomial (P1+P2): ');
for i := o+1 downto 1 do
HP[i]:=P1[i]+P2[i];
Tampil(o,HP);
End.

Program Menyusun_Rentang_Nilai;
Uses Wincrt;
Var i,tot,n:integer;
Begin
Write('Masukkan Jumlah Rentang Nilai: ');Readln(n);
For i:= 1 to n do
Begin
if (i mod 3 = 0) then
Begin
tot:=tot-i;
write('-',i);
End
else
Begin
tot:=tot+i;
if (i=1) then
write(i)
else
write('+',i);
End;
End;
Writeln;
Writeln('Total Rentang Nilai: ',tot);
End.

Program Segitiga_Pascal;
Uses Wincrt;
Var
i,j,n:integer;
x: array[1..100, 1..100] of integer;
Begin
Write('Masukkan Jumlah Baris: ');Readln(n);
For i:= 1 to n do
For j:= 1 to i do
Begin
if j=1 then x[i,j]:=1
else if j=i then x[i,j]:=1
else x[i,j]:=x[i-1,j-1]+x[i-1,j];
End;
For i:= 1 to n do
Begin
Gotoxy(40-3*i,2+i);
For j:= 1 to i do
write(x[i,j]:6);
End;
End.

Program Menyusun_Angka;
Uses Wincrt;
Var i,j,n:integer;
Begin
Write('Masukkan Jumlah Baris: ');Readln(n);
For i:= 1 to n do
Begin
Gotoxy(40-3*i,1+i);
For j:= 1 to i do
write(i:6);
End;
End.

Program Menyusun_Bintang;
Uses Wincrt;
Var i,j,n:integer;
Begin
Write('Masukkan Jumlah Baris: ');Readln(n);
For i:= 1 to n do
Begin
Gotoxy(40-3*i,1+i);
For j:= 1 to i do
write('*':6);
End;
End

Program Transpose_Matrix;
Uses Wincrt;
Var A: Array [1..10,1..10] of integer;
i,j,baris,kolom :integer;
Begin
Clrscr;
Write('Masukkan Jumlah Baris : ');Readln(baris);
Write('Masukkan Jumlah Kolom : ');Readln(kolom);
Writeln;
Gotoxy(1,5);Write('A= ');
for i := 1 to baris do
for j := 1 to kolom do
begin
Gotoxy(j*5,i*2+3);
Readln(A[i,j]);
end;
Gotoxy(20,5);Write('AT=');
for i := 1 to kolom do
for j := 1 to baris do
begin
Gotoxy(j*5+20,i*2+3);
Write(A[j,i]);
end;
End..

Program Hitung_Nilai_Mhs;
Uses Wincrt;
Type Larik = array [1..100] of integer;
Var nilai,A,B,C,D,E : Larik;
n,i,tot : Integer;
mean,sdt,sd : real;
iA,iB,iC,iD,iE : Integer;
Procedure input;
Begin
Writeln('Program Hitung Nilai');
Writeln('====================');
Write('Jumlah Data : ');readln(n);
Writeln;
Randomize;
For i:= 1 to n do
Begin
Write('Masukan Nilai [0..100] ke-',i,' : ');Readln(nilai[i]);
End;
Writeln;
End;
Procedure hitung_mean_sd;
Begin
tot:=0;
sdt:=0;
For i:= 1 to n do
Begin
tot:=tot+nilai[i];
End;
mean:=tot/n;
For i:= 1 to n do
Begin
sdt:=sdt+sqr(nilai[i]-mean);
End;
sd:=sqrt(sdt/(n));
End;
Procedure cari_nilai;
Begin
iA:=0; iB:=0; iC:=0; iD:=0; iE:=0;
For i := 1 to n Do
Begin
If (nilai[i]>=(mean+(1.5*sd))) Then
Begin
Inc(iA);
A[iA]:=nilai[i];
End
Else If ((nilai[i]>=mean+(0.5*sd)) And (nilai[i]<mean+(1.5*sd)))
Then
Begin
Inc(iB);
B[iB]:=nilai[i];
End
Else If ((nilai[i]>=mean-(0.5*sd)) And (nilai[i]<mean+(0.5*sd)))
Then
Begin
Inc(iC);
C[iC]:=nilai[i];
End
Else If ((nilai[i]>=mean-(1.5*sd)) And (nilai[i]<mean-(0.5*sd)))
Then
Begin
Inc(iD);
D[iD]:=nilai[i];
End
Else
Begin
Inc(iE);
E[iE]:=nilai[i];
End;
End;
End;
Procedure urut_desc(z:Integer;Var X:Larik);
Var i,j,T: Integer;
Begin
For i:= 1 to z-1 Do
For j := 1 to z-1 Do
If X[j]<x[j+1] Then {kalau ascending X[j]>x[j+1]}
Begin
T:=X[j];
X[j]:=X[j+1];
X[j+1]:=T;
End;
End;
Procedure tampil;
Begin
Writeln('Rata-Rata Nilai : ',mean:3:2);
Writeln('Standar Deviasi : ',sd:3:2);
Writeln;
Write('Nilai A: ');
urut_desc(iA,A);
For i:= 1 to iA Do
Write(A[i]:3,' ');
Writeln;
Write('Nilai B: ');
urut_desc(iB,B);
For i:= 1 to iB Do
Write(B[i]:3,' ');
Writeln;
Write('Nilai C: ');
urut_desc(iC,C);
For i:= 1 to iC Do
Write(C[i]:3,' ');
Writeln;
Write('Nilai D: ');
urut_desc(iD,D);
For i:= 1 to iD Do
Write(D[i]:3,' ');
Writeln;
Write('Nilai E: ');
urut_desc(iE,E);
For i:= 1 to iE Do
Write(E[i]:3,' ');
Writeln;
End;
Begin
Clrscr;
input;
hitung_mean_sd;
cari_nilai;
tampil;
End.

Program Konversi_Decimal_Ke_Romawi_Pakai_Array;
Uses WinCrt;
Const
Romawi : array [1..13] of String =
('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');
Desimal : array [1..13] of integer =
(1000,900,500,400,100,90,50,40,10,9,5,4,1);
Var
B,B1,i : Integer;
Ul:Char;
Rom : String;
Begin
Repeat
Clrscr;
Writeln('Program Konversi Desimal Menjadi Romawi');
Writeln('=======================================');
Writeln;
Write('Masukkan Bilangan Antara [1..9999] : ');Readln(B);
Writeln;
Rom:='';
B1:=B;
If (B>0) And (B<10000) Then
Begin
For i:=1 To 13 Do
Begin
While (B>=Desimal[i]) Do
Begin
B:=B-Desimal[i];
Rom:=Rom+Romawi[i]
End;
End;
Writeln('Desimal ',B1,' = ',Rom,' Romawi');
End
Else
Writeln('Tidak Diketahui Simbol Romawinya!');
Writeln;
Write('Mau Ulang Lagi? [Y/T]: ');Readln(Ul);
Ul:=Upcase(Ul);
Until (Ul<>'Y');
End.

Program Konversi_Decimal_Ke_Romawi_Pakai_If;
Uses WinCrt;
Var
B,B1,i : Integer;
Ul:Char;
Rom : String;
Begin
Repeat
Clrscr;
Writeln('Program Konversi Desimal Menjadi Romawi');
Writeln('=======================================');
Writeln;
Write('Masukkan Bilangan Antara [1..9999] : ');Readln(B);
Writeln;
Rom:='';
B1:=B;
if (B>0) And (B<10000) Then
Begin
While (B>0) Do
Begin
If (B>=1000) Then
Begin
B:=B-1000;
Rom:=Rom+'M';
End
Else If (B>=900) Then
Begin
B:=B-900;
Rom:=Rom+'CM';
End
Else If (B>=500) Then
Begin
B:=B-500;
Rom:=Rom+'D';
End
Else If (B>=400) Then
Begin
B:=B-400;
Rom:=Rom+'CD';
End
Else If (B>=100) Then
Begin
B:=B-100;
Rom:=Rom+'C';
End
Else If (B>=90) Then
Begin
B:=B-90;
Rom:=Rom+'XC';
End
Else If (B>=50) Then
Begin
B:=B-50;
Rom:=Rom+'L';
End
Else If (B>=40) Then
Begin
B:=B-40;
Rom:=Rom+'XL';
End
Else If (B>=10) Then
Begin
B:=B-10;
Rom:=Rom+'X';
End
Else If (B>=9) Then
Begin
B:=B-9;
Rom:=Rom+'IX';
End
Else If (B>=5) Then
Begin
B:=B-5;
Rom:=Rom+'V';
End
Else If (B>=4) Then
Begin
B:=B-4;
Rom:=Rom+'IV';
End
Else If (B>=1) Then
Begin
B:=B-1;
Rom:=Rom+'I';
End
Else
B:=B-1;
End;
Writeln('Desimal ',B1,' = ',Rom,' Romawi');
End
Else
Writeln('Tidak Diketahui Simbol Romawinya!');
Writeln;
Write('Mau Coba Lagi? [Y/T]: ');
Ul:=Upcase(ReadKey);
Until (Ul<>'Y');
End.

Program Konversi_Desimal_Ke_Biner;
Uses WinCrt;
Var
Des,Desi: Integer;
Bin: String;
Ul:Char;
Begin
Repeat
Clrscr;
Writeln('Program Konversi Desimal Menjadi Biner');
Writeln('======================================');
Writeln;
Write('Masukkan Bilangan Desimal: ');Readln(Des);
Desi:=Des;
Bin:='';
Repeat
If(Des Mod 2 = 0) Then
Bin:='0'+Bin
Else
Bin:='1'+Bin;
Des:=Des Div 2;
Until Des=0;
Writeln;
Writeln(Desi,' Desimal = ',Bin,' Biner');
Writeln;
Write('Mau Ulang Lagi? [Y/T]: ');Readln(Ul);
Ul:=Upcase(Ul);
Until (Ul<>'Y');
End.

Program String1;
Uses WinCrt;
Var JumKal : Integer;
Kal : String;
Ul : Char;
Procedure CekJKal(Teks: String; Var JK: Integer);
Var i: Integer;
Begin
If (Teks[1]=' ') Then
JK:=0
Else
JK:=1;
For i:= 1 To Length(Teks) Do
Begin
If (Teks[i]=' ') And (Teks[i+1]<>' ') And (Teks[i+2]<>' ') Then
Inc(JK)
Else If (Teks[i]='-') And (Teks[i-1]<>' ') And (Teks[i+1]<>' ')
Then
Inc(JK);
End;
End;
Begin
Repeat
Clrscr;
Writeln('Program Menghitung Jumlah Kata Dalam Kalimat');
Writeln('============================================');
Writeln;
Writeln('Masukkan Kalimat:');Readln(Kal);
CekJKal(Kal,JumKal);
Writeln;
Writeln('Jumlah Kata Dalam Kalimat Di Atas Sebanyak: ',JumKal,'
Buah');
Writeln;
Write('Mau Ulang Lagi [Y/T]: ');Ul:=Upcase(Readkey);
Until Ul<>'Y';
End.

Program String2;
Uses WinCrt;
Type Data=Record
Kata : String;
End;
Larikdata = Array [1..100] of Data;
Var KataPjg : Larikdata;
i,j,idx : Integer;
Kal : String;
Ul : Char;
Procedure Ambilkata(Var a,b: Integer; Kalimat: String);
Var Tmp : String;
Begin
Tmp:='';
While (Kalimat[a]<>' ') And (Kalimat[a]<>'-') And (Kalimat[a]<>'!')
And (Kalimat[a]<>'?') And (Kalimat[a]<>',') And
(Kalimat[a]<>'.')
And (Kalimat[a]<>':') And (Kalimat[a]<>';') And
(a<=Length(Kalimat)) Do
Begin
Tmp:=Tmp+Kalimat[a];
Inc(a);
End;
Inc(b);
KataPjg[b].Kata:=Tmp;
End;
Procedure CariKataTerpanjang(x:Integer;Var indeks: Integer);
Var i,max: Integer;
Begin
max:=0;
For i:= 1 to x Do
If max<Length(KataPjg[i].Kata) Then
Begin
max:=Length(KataPjg[i].Kata);
indeks:=i;
End;
End;
Begin
Repeat
Clrscr;
Writeln('Program Cari Kata Terpanjang Dalam Kalimat');
Writeln('==========================================');
Writeln;
Writeln('Masukkan Kalimat:');Readln(Kal);
i:=1;
j:=0;
While i<=Length(Kal) Do
Begin
If (i=1) And (Kal[1]<>' ') Then
AmbilKata(i,j,Kal)
Else If (Kal[i]=' ') And (Kal[i+1]<>' ') And (Kal[i+2]<>' ')
Then
Begin
Inc(i);
AmbilKata(i,j,Kal);
End
Else If (Kal[i]='-') And (Kal[i-1]<>' ') And (Kal[i+1]<>' ')
Then
Begin
Inc(i);
AmbilKata(i,j,Kal);
End
Else
Inc(i);
End;
CariKataTerpanjang(j,idx);
Writeln;
Writeln('Kata Terpanjang Dalam Kalimat Di Atas:
',Katapjg[idx].kata);
Writeln;
Write('Mau Ulang Lagi [Y/T]: ');Ul:=Upcase(Readkey);
Until Ul<>'Y';
End.

Program String3;
Uses WinCrt;
Type Data=Record
Kata : String;
End;
Larikdata = Array [1..100] of Data;
Var Katacr : Larikdata;
i,j : Integer;
Kal : String;
Ul : Char;
Crkata,idx : String;
ketemu : Integer;
Procedure Ambilkata(Var a,b: Integer; Kalimat: String);
Var Tmp : String;
Begin
Tmp:='';
While (Kalimat[a]<>' ') And (Kalimat[a]<>'-') And (Kalimat[a]<>'!')
And (Kalimat[a]<>'?') And (Kalimat[a]<>',') And
(Kalimat[a]<>'.')
And (Kalimat[a]<>':') And (Kalimat[a]<>';') And
(a<=Length(Kalimat)) Do
Begin
Tmp:=Tmp+Kalimat[a];
Inc(a);
End;
Inc(b);
Katacr[b].Kata:=Tmp;
End;
Procedure CariKata(x:Integer;Carikt:String;Var indeks:String;Var
ktm:Integer);
Function IntToStr(k: Longint): String;
Var
S: string[11];
Begin
Str(k, S);
IntToStr := S;
End;
Var i: Integer;
Begin
For i:= 1 to x Do
Begin
If Carikt=Katacr[i].Kata Then
Begin
Inc(ktm);
indeks:=indeks+IntToStr(i)+' ';
End;
End;
End;
Begin
Repeat
Clrscr;
Writeln('Program Cari Kata Dalam Kalimat');
Writeln('===============================');
Writeln;
Writeln('Masukkan Kalimat:');Readln(Kal);
Writeln;
Write('Masukkan Kata Yang Dicari: ');Readln(Crkata);
i:=1;
j:=0;
idx:='';
ketemu:=0;
While i<=Length(Kal) Do
Begin
If (i=1) And (Kal[1]<>' ') Then
AmbilKata(i,j,Kal)
Else If (Kal[i]=' ') And (Kal[i+1]<>' ') And (Kal[i+2]<>' ')
Then
Begin
Inc(i);
AmbilKata(i,j,Kal);
End
Else If (Kal[i]='-') And (Kal[i-1]<>' ') And (Kal[i+1]<>' ')
Then
Begin
Inc(i);
AmbilKata(i,j,Kal);
End
Else
Inc(i);
End;
CariKata(j,Crkata,idx,ketemu);
Writeln;
if (ketemu>0) then
Writeln('Kata "',Crkata,'" Ditemukan Dalam Kalimat Pada Posisi:
',idx,'.')
else
Writeln('Kata "',Crkata,'" Tidak Ditemukan Dalam Kalimat!');
Writeln;
Write('Mau Ulang Lagi [Y/T]: ');Ul:=Upcase(Readkey);
Until Ul<>'Y';
End.

Program Data_Mahasiswa;
Uses WinCrt;
Type Mahasiswa = Record
NoMhs : Word;
Nama : String[20];
IPK : Real;
Usia : Byte;
End;
Var Filemhs : File of Mahasiswa;
Data : Mahasiswa;
Pil,Ul : Char;
Procedure Menu;
Begin
Clrscr;
Gotoxy(34,1);Write('MENU PILIHAN');
Gotoxy(34,2);Write('============');
Gotoxy(27,4);Write('1. Tambah Data Mahasiswa');
Gotoxy(27,5);Write('2. Edit Data Mahasiswa');
Gotoxy(27,6);Write('3. Hapus Data Mahasiswa');
Gotoxy(27,7);Write('4. Tampilkan Data Mahasiswa');
Gotoxy(27,8);Write('5. View Mahasiswa Berdasarkan Umur');
Gotoxy(27,9);Write('6. Hapus NoMhs Ganjil');
Gotoxy(27,10);Write('9. Keluar (Exit)');
Gotoxy(32,12);Write('Pilihan [1..9]: ');Pil:=Readkey;
End;
Procedure BukaFile;
Begin
Assign(FileMhs,'Mhs.Dat');
{$I-};
Reset(FileMhs);
{$I+};
End;
Procedure Tambah;
Var Lagi: Char;
Ada : Boolean;
i : Integer;
NOCR: Word;
Begin
Ul:='Y';
Lagi:='Y';
Clrscr;
BukaFile;
If IOResult<>0 Then
Rewrite(FileMhs);
Repeat
Clrscr;
Ada:=False;
i:=0;
Gotoxy(30,1);Write('TAMBAH DATA MAHASISWA');
Gotoxy(30,2);Write('=====================');
Gotoxy(20,4);Write('No. Mahasiswa : ');Readln(NOCR);
While (Ada=False) And (i<>Filesize(FileMhs)) Do
Begin
Seek(FileMhs,i);
Read(FileMhs,Data);
If Data.NoMhs=NOCR Then
Ada:=True
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Gotoxy(20,9);Write('Nomor Mahasiswa "',NOCR,'" Ini Sudah
Ada!');
End
Else
Begin
Seek(FileMhs,Filesize(FileMhs));
Data.NoMhs:=NOCR;
Gotoxy(20,5);Write('Nama Mahasiswa : ');Readln(Data.Nama);
Gotoxy(20,6);Write('IPK : ');Readln(Data.IPK);
Gotoxy(20,7);Write('Umur : ');Readln(Data.Usia);
Write(FileMhs,Data);
End;
Gotoxy(20,10);Write('Mau Tambah Data Lagi [Y/T]:
');Lagi:=Upcase(Readkey);
Until Lagi<>'Y';
Close(FileMhs);
End;
Procedure Edit;
Var Lagi: Char;
Ada : Boolean;
i : Integer;
NOCR: Word;
Begin
Ul:='Y';
Lagi:='Y';
Clrscr;
BukaFile;
If IOResult<>0 Then
Write('Data Masih Kosong...!')
Else
Begin
Repeat
Clrscr;
Ada:=False;
i:=0;
Gotoxy(30,1);Write('EDIT DATA MAHASISWA');
Gotoxy(30,2);Write('=====================');
Gotoxy(20,4);Write('No. Mahasiswa : ');Readln(NOCR);
While (Ada=False) And (i<>Filesize(FileMhs)) Do
Begin
Seek(FileMhs,i);
Read(FileMhs,Data);
If Data.NoMhs=NOCR Then
Begin
Ada:=True;
Gotoxy(20,5);Write('Nama Mahasiswa : ',Data.Nama);
Gotoxy(20,6);Write('IPK : ',Data.IPK:1:2);
Gotoxy(20,7);Write('Umur : ',Data.Usia);
End
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Data.NoMhs:=NOCR;
Gotoxy(20,9);Write('Nama Mahasiswa : ');Readln(Data.Nama);
Gotoxy(20,10);Write('IPK : ');Readln(Data.IPK);
Komunitas eLearning IlmuKomputer.Com
Copyright © 2003-2008 IlmuKomputer.Com
42
Gotoxy(20,11);Write('Umur :
');Readln(Data.Usia);
Seek(FileMhs,i);
Write(FileMhs,Data);
End
Else
Begin
Gotoxy(20,13);Write('Nomor Mahasiswa "',NOCR,'" Ini Tidak
Ada!');
End;
Gotoxy(20,14);Write('Mau Edit Data Lagi [Y/T]:
');Lagi:=Upcase(Readkey);
Until Lagi<>'Y';
End;
Close(FileMhs);
End;
Procedure Hapus;
Var FileTmp : File of Mahasiswa;
Lagi,Hapus: Char;
Ada : Boolean;
i : Integer;
NOCR : Word;
Begin
Ul:='Y';
Lagi:='Y';
Clrscr;
Repeat
BukaFile;
If IOResult<>0 Then
Write('Data Masih Kosong...!')
Else
Begin
Clrscr;
Assign(FileTmp,'mhs.tmp');
Rewrite(FileTmp);
Ada:=False;
i:=0;
Gotoxy(30,1);Write('HAPUS DATA MAHASISWA');
Gotoxy(30,2);Write('=====================');
Gotoxy(20,4);Write('No. Mahasiswa : ');Readln(NOCR);
While (Ada=False) And (i<>Filesize(FileMhs)) Do
Begin
Seek(FileMhs,i);
Read(FileMhs,Data);
If Data.NoMhs=NOCR Then
Ada:=True
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Gotoxy(20,5);Write('Nama Mahasiswa : ',Data.Nama);
Gotoxy(20,6);Write('IPK : ',Data.IPK:1:2);
Gotoxy(20,7);Write('Umur : ',Data.Usia);
Gotoxy(20,9);Write('Data Ini Mau Di Hapus [Y/T]:
');Readln(Hapus);
If Upcase(Hapus)='Y' Then
Begin
For i := 1 to Filesize(FileMhs) Do
Begin
Seek(FileMhs,i-1);
Read(FileMhs,Data);
If Data.NoMhs<>NOCR Then
Write(FileTmp,Data);
End;
Close(FileMhs);
Assign(FileMhs,'MHS.Dat');
Erase(FileMhs);
Assign(FileTmp,'Mhs.tmp');
Rename(FileTmp,'Mhs.Dat');
Gotoxy(20,10);Write('Nomor Mahasiswa "',NOCR,'" Sudah
Di Hapus!');
End;
End
Else
Begin
Gotoxy(20,10);Write('Nomor Mahasiswa "',NOCR,'" Ini Tidak
Ada!');
End;
Gotoxy(20,11);Write('Mau Hapus Data Lagi [Y/T]:
');Lagi:=Upcase(Readkey);
End;
Until Lagi<>'Y';
End;
Function RataIPK(TIPK:Real;n:integer):Real;
Begin
RataIPK:=TIPK/n;
End;
Procedure Tampil;
Var i : Integer;
TIPK : Real;
Begin
Ul:='Y';
TIPK:=0;
BukaFile;
If IoResult <> 0 Then
Write('Maaf Data Masih Kosong ! ')
Else
Begin
Clrscr;
Writeln(' DATA MAHASISWA ');
Writeln;
Writeln('================================================');
Writeln(' NO NIM NAMA IPK UMUR ');
Writeln('================================================');
i:=0;
While Not EoF(FileMhs) Do
Begin
Inc(i);
Read(FileMhs,Data);
Writeln(i:3,Data.NoMhs:6,Data.Nama:20,Data.IPK:8:2,Data.Usia:10);
TIPK:=TIPK+Data.IPK;
End;
Writeln('================================================');
Writeln('Rata-Rata IPK: ',RataIPK(TIPK,i):1:2);
Writeln('================================================');
Close(FileMhs);
End;
Writeln;
Write('Press Any Key to Continue...');Readkey;
End;
Procedure View_Umur;
Var i : Integer;
Umur : Byte;
Lagi : Char;
Begin
Ul:='Y';
Lagi:='Y';
Repeat
Clrscr;
Write('Tampilkan Umur Besar Dari: ');Readln(Umur);
BukaFile;
If IoResult <> 0 Then
Write('Maaf Data Masih Kosong ! ')
Else
Begin
Writeln(' DATA MAHASISWA ');
Writeln(' UMUR DI ATAS ',Umur:2,' TAHUN');
Writeln;
Writeln('================================================');
Writeln(' NO NIM NAMA IPK UMUR ');
Writeln('================================================');
i:=0;
While Not EoF(FileMhs) Do
Begin
Read(FileMhs,Data);
If Data.Usia>Umur Then
Begin
Inc(i);
Writeln(i:3,Data.NoMhs:6,Data.Nama:20,Data.IPK:8:2,Data.Usia:10);
End;
End;
Writeln('================================================');
Close(FileMhs);
End;
Writeln;
Write('Mau Lihat Data Lagi [Y/T]: ');Lagi:=Upcase(Readkey);
Until Lagi<>'Y';
End;
Procedure Hapus_NoMhs;
Var FileTmp : File of Mahasiswa;
Lagi,Hapus: Char;
i : Integer;
Begin
Ul:='Y';
Lagi:='Y';
Clrscr;
Repeat
BukaFile;
Komunitas eLearning IlmuKomputer.Com
Copyright © 2003-2008 IlmuKomputer.Com
45
If IOResult<>0 Then
Write('Data Masih Kosong...!')
Else
Begin
Clrscr;
Assign(FileTmp,'mhs.tmp');
Rewrite(FileTmp);
i:=0;
Gotoxy(20,3);Write('Mau Menghapus No. Mahasiswa Yang Ganjil
[Y/T]: ');Readln(Hapus);
If Upcase(Hapus)='Y' Then
Begin
For i := 1 to Filesize(FileMhs) Do
Begin
Seek(FileMhs,i-1);
Read(FileMhs,Data);
If (Data.NoMhs Mod 2)=0 Then
Write(FileTmp,Data);
End;
Close(FileMhs);
Assign(FileMhs,'Mhs.Dat');
Erase(FileMhs);
Assign(FileTmp,'Mhs.tmp');
Rename(FileTmp,'Mhs.Dat');
Gotoxy(20,10);Write('Nomor Mahasiswa Sudah Di Hapus!');
End;
Gotoxy(20,11);Write('Mau Hapus Data Lagi [Y/T]:
');Lagi:=Upcase(Readkey);
End;
Until Lagi<>'Y';
End;
Begin
Repeat
Menu;
Case Pil Of
'1' : Tambah;
'2' : Edit;
'3' : Hapus;
'4' : Tampil;
'5' : View_Umur;
'6' : Hapus_NoMhs;
End;
Until (Ul<>'Y') Or (Pil='9');
DoneWinCrt;
End.

Program Antrian_Statis_Tanpa_Geser;
Uses Wincrt;
Const Max_Antrian = 10;
Type Antri = Array [1..Max_Antrian] of Char;
Var Antrian : Antri;
Depan, Belakang : Integer;
Elemen,Pil,Pil1 : Char;
Procedure InitAntrian;
Begin
Depan:=0;
Belakang:=0;
End;
Procedure Tambah(Var Antrian: Antri; X: Char);
Begin
If Belakang<>Max_Antrian Then
Begin
Inc(Belakang);
Antrian[Belakang]:=X;
End
Else
Writeln('ANTRIAN SUDAH PENUH');
End;
Procedure Hapus(Var Antrian: Antri);
Begin
If Depan<>Belakang Then
Begin
Inc(Depan);
Antrian[Depan]:=' ';
If Depan=Belakang Then
Begin
{Depan:=0;Belakang:=0;}InitAntrian;
End;
End
Else
Begin
Writeln('ANTRIAN KOSONG');
{Depan:=0;Belakang:=0;}w
InitAntrian;
End;
End;
Procedure Tampilkan;
Var i : Integer;
Begin
Write('Keluar <== |');
For i := 1 To Max_Antrian Do
Write(' ',Antrian[i],' |');
Write(' <== Masuk');
End;
Begin
InitAntrian;
Repeat
Clrscr;
Writeln('DAFTAR MENU PILIHAN');
Writeln('===================');
Writeln('1. Tambah Elemen');
Writeln('2. Hapus Elemen');
Writeln('3. Exit');
Write('Pilihan [1..3]: ');Pil:=ReadKey;
Case Pil of
'1' : Begin
Repeat
Clrscr;
Writeln('TAMBAH ELEMEN');
Writeln('=============');
Writeln;
Write('Isikan Elemen: ');Readln(Elemen);
Tambah(Antrian,Elemen);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Tambah Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
'2' : Begin
Repeat
Clrscr;
Writeln('HAPUS ELEMEN');
Writeln('=============');
Hapus(Antrian);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Hapus Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
End;
Until Pil='3';
End.

Program Antrian_Statis_Geser;
Uses Wincrt;
Const Max_Antrian = 5;
Type Antri = Array [1..Max_Antrian] of Char;
Var Antrian : Antri;
Depan, Belakang : Integer;
Elemen,Pil,Pil1 : Char;
Procedure InitAntrian;
Begin
Depan:=0;
Belakang:=0;
End;
Procedure Tambah(Var Antrian: Antri; X: Char);
Begin
If Belakang<>Max_Antrian Then
Begin
Inc(Belakang);
Antrian[Belakang]:=X;
End
Else
Writeln('ANTRIAN SUDAH PENUH');
End;
Procedure Hapus(Var Antrian: Antri);
Var i: Integer;
Begin
If Depan<>Belakang Then
Begin
For i:= 2 To Belakang Do
Begin
Antrian[i-1]:=Antrian[i];
End;
Antrian[Belakang]:=' ';
Dec(Belakang);
End
Else
Writeln('ANTRIAN KOSONG');
End;
Procedure Tampilkan;
Var i : Integer;
Begin
Write('Keluar <== |');
For i := 1 To Max_Antrian Do
Write(' ',Antrian[i],' |');
Write(' <== Masuk');
End;
Begin
InitAntrian;
Repeat
Clrscr;
Writeln('DAFTAR MENU PILIHAN');
Writeln('===================');
Writeln('1. Tambah Elemen');
Writeln('2. Hapus Elemen');
Writeln('3. Exit');
Write('Pilihan [1..3]: ');Pil:=ReadKey;
Case Pil of
'1' : Begin
Repeat
Clrscr;
Writeln('TAMBAH ELEMEN');
Writeln('=============');
Writeln;
Write('Isikan Elemen: ');Readln(Elemen);
Tambah(Antrian,Elemen);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Tambah Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
'2' : Begin
Repeat
Clrscr;
Writeln('HAPUS ELEMEN');
Writeln('=============');
Hapus(Antrian);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Hapus Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
End;
Until Pil='3';
End.

Program Antrian_Statis_Geser;
Uses Wincrt;
Const Max_Antrian = 5;
Type Antri = Array [1..Max_Antrian] of Char;
Var Antrian : Antri;
Depan, Belakang : Integer;
Elemen,Pil,Pil1 : Char;
Procedure InitAntrian;
Begin
Depan:=0;
Belakang:=0;
End;
Procedure Tambah(Var Antrian: Antri; X: Char);
Begin
If Belakang<>Max_Antrian Then
Begin
Inc(Belakang);
Antrian[Belakang]:=X;
End
Else
Writeln('ANTRIAN SUDAH PENUH');
End;
Procedure Hapus(Var Antrian: Antri);
Var i: Integer;
Begin
If Depan<>Belakang Then
Begin
For i:= 2 To Belakang Do
Begin
Antrian[i-1]:=Antrian[i];
End;
Antrian[Belakang]:=' ';
Dec(Belakang);
End
Else
Writeln('ANTRIAN KOSONG');
End;
Procedure Tampilkan;
Var i : Integer;
Begin
Write('Keluar <== |');
For i := 1 To Max_Antrian Do
Write(' ',Antrian[i],' |');
Write(' <== Masuk');
End;
Begin
InitAntrian;
Repeat
Clrscr;
Writeln('DAFTAR MENU PILIHAN');
Writeln('===================');
Writeln('1. Tambah Elemen');
Writeln('2. Hapus Elemen');
Writeln('3. Exit');
Write('Pilihan [1..3]: ');Pil:=ReadKey;
Case Pil of
'1' : Begin
Repeat
Clrscr;
Writeln('TAMBAH ELEMEN');
Writeln('=============');
Writeln;
Write('Isikan Elemen: ');Readln(Elemen);
Tambah(Antrian,Elemen);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Tambah Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
'2' : Begin
Repeat
Clrscr;
Writeln('HAPUS ELEMEN');
Writeln('=============');
Hapus(Antrian);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Hapus Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
End;
Until Pil='3';
End.

Program Antrian_Statis_Circular;
Uses Wincrt;
Const Max_Antrian = 5;
Type Antri = Array [1..Max_Antrian] of Char;
Var Antrian : Antri;
Depan, Belakang : Integer;
Elemen,Pil,Pil1 : Char;
Procedure InitAntrian;
Begin
Depan:=0;
Belakang:=0;
End;
Procedure Tambah(Var Antrian: Antri; X: Char);
Begin
If Belakang=Max_Antrian Then
Begin
Belakang:=1;
End
Else
Inc(Belakang);
If Depan=Belakang Then
Begin
Writeln('ANTRIAN SUDAH PENUH');
Dec(Belakang);
If Belakang=0 Then
Belakang:=Max_Antrian;
End
Else
Antrian[Belakang]:=X;
Writeln('Depan: ',Depan,' Belakang: ',Belakang);
End;
Procedure Hapus(Var Antrian: Antri);
Begin
If Depan<>Belakang Then
Begin
If Depan=Max_Antrian Then
Depan:=1
Else
Begin
Inc(Depan);
Antrian[Depan]:=' ';
End;
End
Else
Writeln('ANTRIAN KOSONG');
Writeln('Depan: ',Depan,' Belakang: ',Belakang);
End;
Procedure Tampilkan;
Var i : Integer;
Begin
Write('Keluar <== |');
For i := 1 To Max_Antrian Do
Write(' ',Antrian[i],' |');
Write(' <== Masuk');
End;
Begin
InitAntrian;
Repeat
Clrscr;
Writeln('DAFTAR MENU PILIHAN');
Writeln('===================');
Writeln('1. Tambah Elemen');
Writeln('2. Hapus Elemen');
Writeln('3. Exit');
Write('Pilihan [1..3]: ');Pil:=ReadKey;
Case Pil of
'1' : Begin
Repeat
Clrscr;
Writeln('TAMBAH ELEMEN');
Writeln('=============');
Writeln;
Write('Isikan Elemen: ');Readln(Elemen);
Tambah(Antrian,Elemen);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Tambah Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
'2' : Begin
Repeat
Clrscr;
Writeln('HAPUS ELEMEN');
Writeln('=============');
Hapus(Antrian);
Writeln;Writeln;
Tampilkan;
Writeln;Writeln;
Write('Mau Hapus Elemen Lagi? [Y/T]:
');Pil1:=Upcase(ReadKey);
Until Pil1<>'Y';
End;
End;
Until Pil='3';
End.

Ufi Hauzaan Al-Farrozii