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.
Output:
program menghitung jarak titik A dan B
masukan nilai A (X1):2
- - - - - - - B (x2):3
- - - - - - - A (x3):4
- - - - - - - b (x4):5
Jadi jarak a Ke B adalah 1,41

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.
Output:
program kinversi fahrenheit ke celcius
masukan suhu dalam fahrenheit :100
jadi suhu dalam celcius adalah:37.78

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.
Output:
Program Faktorial
masukan nilai faktorial : 4
Hasil faktorial :24

Komunitas eLearning IlmuKomputer.Com
Copyright © 2003-2008 IlmuKomputer.Com
8
Output:
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.
Output:
program menghitung pangkat
masukan jumlah pangkat :3
masukan bil yg di pangkat:2
hasil pangkat : 8.00

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.
Output:
Masukan jumlah baris : 6
*
**
***
****
*****
******

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.
Output:
Masukan jumlah data :5
4
23
17
9
10
data yang sudah di masukan: 4 23 17 9 10

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 (maxmax:=x[i]
else
min:=x[i];
End;
Writeln;
Writeln('Nilai Maximal: ',max);
Writeln('Nilai Minimal: ',min);
End.
Output:

program array
masukan jumlah data :4
data harus urut
4
8
10
34
data yang telah di masukan: 4 8 10 34
nilai max : 34
nilai min : 4

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.
Output:
Nim : 12345
nama:uihguh
program studi : si
Ip :3.70

Nim : 12345
nama:uihguh
program studi : si
Ip :3.70

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.
output:
program konversi desimal ke romawi
masukan bil antara [1..9999]:3456
desimal3456 : MMMCDLVI romawi
mau lagi[Y/T]:

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.
Output:
prog konversi desimal ke romawi
masukan bil des :5
5 desimal=101 biner
mau ulang lagi[Y/T]:

Komunitas

Selasa, 09 Februari 2010 Posted in | | 0 Comments »

One Responses to "Kumpulan Program Pascal"

Write a comment