DASAR-DASAR PEMROGRAMAN PASCAL
program Luas_segitiga;
uses wincrt;
procedure
var a,t,L: real;
begin
write('tulis alas'); readln(a);
write('tulis tinggi'); readln(t);
L:= a*t/2;
write('luas segitiga',L);
end.
program akar_kuadrat;
uses wincrt;
var
a,b,c:real;
function akar(a,b,c:real):real;
begin
akar:=sqrt (a*a)+(b*b)+(c*c);
end;
begin
writeln(' PROGRAM AKAR KUADRAT');
writeln(' ********************');
writeln;
writeln;
writeln;
write(' masukan angka pertama:');readln(a);
write(' masukan angka kedua :');readln(b);
write(' masukan angka ketiga :');readln(c);
writeln('--------------------------');
writeln(' hasil akar dari:',akar(a,b,c):8:2);
end.
Program Menara;
uses wincrt;
Var
Jarak, Alfa, Rad, Tinggi : Real;
begin
Writeln(' PROGRAM MENGHITUNG TINGGI MENARA');
Writeln(' ________________________________');
Writeln;
writeln;
Write ('Jarak pengukur hingga menara (meter) =');readln(Jarak);
Write ('Sudut antara tanah & puncak (derajat) =');readln(alfa);
rad:= alfa *pi/180;
tinggi:= sin (rad) / cos (rad) * jarak;
Writeln('TInggi Menara adalah = ',Tinggi:0:4, ' meter');
readln;
end.
program konversi_suhu;
uses wincrt;
var celcius,fahrenheit,reamour: real;
begin
clrscr;
writeln ('konversi derajad celcius ke fahrenheit dan reamour');
writeln ('--------------------------------------------------');
writeln;
write ('berapa derajad celcius yang akan di konversikan:');
readln(celcius);
fahrenheit:= 9/5*celcius + 32;
reamour := 4/5*celcius;
writeln;
writeln ('derajad celcius =',celcius:1:3);
writeln ('derajad fahrenheit=',fahrenheit:1:3);
writeln ('derajad reamour =',reamour:1:3);
end.
PENGGUNAAN WHILE DO
Program menghitung_nilai_rata2;
uses wincrt;
var x,n,k,jumlah:integer;
rata: real;
begin
clrscr;
write('masukkan data:'); readln (n);
k:=1;
jumlah:=0;
while k <= n do
begin
write('x=?'); readln(x);
jumlah:= jumlah+x;
k:=k+1;
end;
rata:=jumlah/n;
writeln('rata-rata seluruh data=',rata);
end.
PENGGUNAAN IF THEN
program warisan_Pak_Hamzah;
uses wincrt;
var i,al,ap,x: real;
begin
clrscr;
writeln ('Telah Meninggal Dengan Tenang');
writeln ('Prof. Dr. Ir. Hamka Hamzah, M.Sc');
writeln ('Pada tanggal 25 Desember 2008');
writeln ('Dengan usia 112 tahun');
writeln ('Dengan meninggalkan warisan senilai "x"juta rupiah');
writeln ('Tertanda');
writeln ('=====Notaris "Adi Prasetia,S.H, M.Hum.=====');
writeln ('masukkan warisan:'); readln(x);
i:= 1/2*x;
al:=1/3*x;
ap:=1/6*x;
writeln ('bagian istri adalah:',i:4:0,' juta rupiah');
writeln ('bagian anal laki-laki adalah:',al:4:0,' juta rupiah');
writeln ('bagian anak perempuan adalah:',ap:4:0,' juta rupiah');
writeln;
if i>al then
if i>ap then
writeln ('bagian istri paling banyak senilai',i:4:0,' juta rupiah')
else
writeln ('bagian anak perempuan paling banyak senilai',ap:4:0,' juta rupiah')
else
if al>ap then
writeln ('bagian anak laki-laki paling banyak senilai',al:4:0,' juta rupiah')
else
writeln ('bagian anak perempuan paling banyak senilai',ap:4:0,' juta rupiah')
end.
Program Bonus;
uses wincrt;
Var
TotalPembelian : LongInt;
Begin
Clrscr;
Write (' Total Pembelian Anda = '); readln(TotalPembelian);
If TotalPembelian >= 100000 then
Writeln ('Anda Mendapat Diskon 10%')
else
If TotalPembelian >= 50000 then
Writeln ('ANda Mendapat Bonus 1 buah piring cantik')
else
If TotalPembelian >=10000 then
Writeln('anda Mendapat Bonus 1 buah Gelas')
else
Writeln('Maaf .............. anda Lom Dapat Bonus...!!! silakan belanja Lebih Banyak yaaa!!!');
End.
PROCEDURE DALAM PEMROGRAMAN PASCAL
Program prosedur_input_dan_output;
uses wincrt;
var A,B,x,y: integer;
procedure Input (var A,B:integer);
begin
writeln(' Prosedur Memasukkan dan Menampilkan Dua Bilangan'); {prosedur Memasukkan dua bilangan} writeln;
Writeln('------------------------------------------------------');writeln;
write('Masukkan bilangan pertamanya! : ');readln(a);
write('Masukkan juga bilangan kedua! : '); readln(b);
end;
procedure Output (var x,y:integer);
begin
x:=A;
y:=B;
writeln; { prosedur menampilkan dua bilangan yang diinput diantara dua bilangan tersebut}
writeln(' kedua bilangan yang diminta untuk ditampilkan yaitu: ',x,', ',a,', ',b,', ',y); writeln;
writeln('(bilangan itu berada diantara dua bilangan yang diinput/pangkal dan ujung).');
end;
begin
input(A,B);
output(X,Y);
end.
PENGGUNAAN CASE OF
program des_hexa;
uses wincrt;
var x,des,hexa: integer;
A,B,C,D,E,F: string;
begin
clrscr;
write('brp des_nya?????');readln(des);
x:=28;
repeat
GOTOXY (X,12);
hexa:= des mod 16;
des := des mod 16;
x:=x-1;
case hexa of
0..9:write(hexa) ;
10:write('A') ;
11:write('B') ;
12:write('C') ;
13:write('D') ;
14:write('E') ;
15:write('F') ;
until des=0;
end.
Program Hari;
uses wincrt;
Var
KodeBulan : integer;
Begin
Write ('bingung Menghitung Jumlah Hari ?? Tulislah kode bulannya [1..12] :');
readln(kodebulan);
Case KodeBulan Of
1, 3, 5, 7, 8, 10, 12: Writeln (' Jumlah hari adalah 31');
4,6,9, 11 : Writeln ('Jumlah Hari adalah 30');
2 : Writeln ('Jumlah adalah 28 atau 29, kalo tahun kabisat berarti ya 29 hari.');
end;
end.
program Channel_TV;
uses wincrt;
Var
no_ke : Integer;
Saluran_ke : string;
begin
Write ('Masukkan Saluran yang anda pilih ');
readln (no_ke);
Case no_ke of
1: saluran_ke := 'TVRI';
2: saluran_ke := 'TPI';
3: saluran_ke := 'RCTI';
4: saluran_ke := 'SCTV';
5: saluran_ke := 'ANTV';
6: saluran_ke := 'Indosiar';
else
saluran_ke := 'Saluran anda salah, Error Not Responding!! Try Again.. he..he..he';
end;
writeln ('Saluran ke ',no_ke, ' adalah ', saluran_ke);
end.
PENGGUNAAN REPEAT UNTIL
program des_ke_oktaf;
uses wincrt;
var x,des,okt:integer;
begin
clrscr;
write('brp des?');readln(des);
x:=6;
repeat
gotoxy (x,6);
okt := des mod 8;
des := des div 8;
write(okt);
x:=x-1;
until des =0;
end.
program kon_des_biner;
uses wincrt;
var des,x,bin:integer;
begin
clrscr;
write('brp des?');readln(des);
X:=30;
repeat
gotoxy (x-1,15);
write(des mod 2);
des := des div 2;
until des = 0;
end.
program des_ke_hexa;
uses wincrt;
var x,des,hexa:integer;
begin
clrscr;
write('brp des?');readln(des);
x:=6;
repeat
gotoxy (x,6);
hexa := des mod 16;
des := des div 16;
write(hexa);
x:=x-1;
until des =0;
end.
PENGGUNAAN ARRAY DALAM MATRIKS
program penjumlahan_matriks;
uses wincrt;
type
matriks=array[1..10,1..10]of real;
var
mat_a,mat_b,mat_c:matriks;
baris,kolom,i,j:byte;
procedure baca(var x:matriks);
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
write('element matriks[',i,',',j,']='); readln(x[i,j]);
end;
end;
procedure jumlah (A,B:matriks; var C:matriks);
var i,j:byte;
begin
for i:=1 to baris do
for j:=1 to kolom do
begin
c[i,j]:=A[i,j]+B[i,j];
writeln('matriks C[',i,',',j,']=',C[i,j]);
end;
end;
begin
clrscr;
write('berapa jumlah baris:'); readln(baris);
write('berapa jumlah kolom:'); readln(kolom);
writeln('masukan element matriiks A');
baca(mat_a);
writeln('masukan element matriks B');
baca (mat_b);
jumlah(mat_a,mat_b,mat_c);
end.
PENGGUNAAN FOR
Program Bintang;
Uses wincrt;
Const
Akhir = 10;
Var
Baris, kolom : integer;
BEGIN
Clrscr;
For Baris := 1 TO Akhir DO
BEGIN
FOR kolom := 1 TO Baris DO
Write ('=ADEC=');
Writeln;
END;
END.
PROGRAM TINGKAT TINGGI
program averagewaittime;
uses wincrt;
type
time1=array [1..100] of integer;
wait1=array [1..100] of integer;
var
ulang:char;
pilih:byte;
n:integer;
procedure FCFS;
var
waktu:time1;
wait:wait1;
i,jumlah,sum:integer;
awt:real;
begin
clrscr;
writeln('#################################');
writeln('First Come First Server ( FCFS )');
writeln('#################################');
write('Jumlah proses : '); readln(n);
jumlah:=0;
sum:=0;
wait[1]:=0;
for i:=1 to n do
begin
write('Masukan lama proses ke-',i,':'); readln(waktu[i]);
jumlah:=wait[i];
wait[i+1]:=jumlah+waktu[i];
sum:=sum+wait[i];
end;
gotoxy(1,5+n);
writeln('#################################');
writeln('Proses |Working Time| Waiting Time ( WT )');
writeln('#################################');
for i:=1 to n do;
begin
gotoxy(1,(7+n)+i); write('|');
gotoxy(11,(7+n)+i); write('|');
gotoxy(24,(7+n)+i); write('|');
gotoxy(38,(7+n)+i); write('|');
end;
gotoxy(1,((7+n)+n)+i);
write('################################');
for i:=1 to n do
begin
gotoxy(2,(7+n)+i);
write('Proses',i);
gotoxy(14,(7+n)+i);
write(waktu[i]);
gotoxy(26,(7+n)+i);
write(wait[i]);
end;
awt:=sum/n;
gotoxy(1,(9+n)+n);
writeln('Average Waiting Time ( AWT ) :',sum,'/',n,':',awt:2:2);
readln;
end;
procedure SJF;
var
i,j,jumlah,sum,temp:integer;
awt:real;
waktu:time1;
wait:wait1;
begin
clrscr;
writeln('##############################');
writeln('Shortest Job First ( SJF )');
writeln('##############################');
write('Jumlah proses : '); readln(n);
jumlah:=0;
sum:=0;
wait[1]:=0;
temp:=0;
for i:=1 to n do
begin
write('Masukan lama proses ke-',i,':'); readln(waktu[i]);
end;
for i:=1 to (n-1) do
for j:=(i+1)to n do
begin
if waktu[j]
begin
temp:=waktu[i];
waktu[i]:=waktu[j];
waktu[j]:=temp;
end;
end;
gotoxy(1,5+n);
writeln('###############################');
writeln('Proses |Working Time|Waiting Time ( WT )');
writeln('###############################');
for i:=1 to n do
begin
gotoxy(1,(7+n)+i);write('|');
gotoxy(11,(7+n)+i);write('|');
gotoxy(24,(7+n)+i);write('|');
gotoxy(38,(7+n)+i);write('|');
end;
gotoxy(1,((7+n)+n)+1);
write('################################');
for i:=1 to n do
begin
gotoxy(2,(7+n)+i);write('Proses',i);
gotoxy(14,(7+n)+i);write(waktu[i]);
gotoxy(26,(7+n)+i);write(wait[i]);
jumlah:=wait[i];
wait[i+1]:=jumlah+waktu[i];
sum:=sum+wait[i];
end;
awt:=sum/n;
gotoxy(1,(9+n)+n);
writeln('Averge Waiting Time ( AWT ) :',sum,'/',n,';',awt:2:2);
readln;
end;
procedure pilihan(pilih:byte);
begin
clrscr;
writeln('Pilihan :');
writeln('1. First Come First Served');
writeln('2. Shortest Job First');
writeln('3. Exit');
write('Your Choice : ');readln(pilih);
case pilih of
1:fcfs;
2:sjf;
3:exit;
end;
end;
begin
ulang:='Y';
repeat
clrscr;
pilihan(pilih);
gotoxy(1,(10+n)+n);
write('Back to Main Menu (y/n) ?');
readln(ulang);
until upcase(ulang)='N';
end.
