PROGRAM cek_bilangan_ganjil_genap;
uses wincrt;
var bil : integer;
begin
clrscr;
write('Masukkan suatu bil :');
read(bil);
if bil mod 2 = 0
then
begin
write('Bil tsb genap');
end;
if bil mod 2 <> 0
then
begin
write('Bil tsb ganjil');
end;
readln;
end.
Program mengecek_suatu_bilangan_adalah_bilangan_prima;uses wincrt;
var bil,i,x : integer;
prima : boolean;batas : integer;
ulang : char;
beginrepeat
clrscr; write('Masukkan bilangan : ');{input bilangan yg akan dicek} read(bil); {inisialisasi awal} batas := round(sqrt(bil))+1; prima := true;if (bil=2) or (bil=3) then {jika bilangan 2 dan 3 maka prima}
prima := true else{jika bukan 2 dan 3 maka} for i:=2 to batas do{dari i:=2 to batas} if bil mod i = 0 then{jika bilangan dibagi i = 0 maka bukan prima} prima := false; if prima = true then writeln(bil,' Adalah prima') else writeln(bil,' Bukan prima'); writeln; write('Ulang lagi [Y/T] : ');ulang:=upcase(readkey); writeln(ulang); until ulang <> 'Y';{akan terus mengulang jika di inputkan [y,Y]}end.
program sumcharacter;
uses wincrt;
var teks : string;
banyak: array ['A'..'Z'] of byte;
i : byte ;
uses wincrt;
var teks : string;
banyak: array ['A'..'Z'] of byte;
i : byte ;
begin
write('write a word:'); readln(teks);
for i:=1 to length(teks) do
banyak[upcase(teks[i])] := banyak[upcase(teks[i])] + 1;
for i:=1 to 26 do
if (banyak[upcase(chr(64+i))] <>0) then
writeln(upcase(chr(64+i)),' sum =' ,banyak[upcase(chr(64+i))]);
write('write a word:'); readln(teks);
for i:=1 to length(teks) do
banyak[upcase(teks[i])] := banyak[upcase(teks[i])] + 1;
for i:=1 to 26 do
if (banyak[upcase(chr(64+i))] <>0) then
writeln(upcase(chr(64+i)),' sum =' ,banyak[upcase(chr(64+i))]);
end.
if we run the statement,we are get output like this :
To conversion character or word from small character to big character or opposite,we can use statement like this :
program conversion_character;
uses wincrt;
function KHuruf(s:string) : string;
var
x : byte;
panjang : integer ;
begin
panjang:= length(s);
for x:=1 to panjang do
begin
if s[x] <> upcase (s[x]) then
s[x] :=upcase(s[x])
else
if s[x]=' 'then s[x] :=s[x]
else
s[x]:= chr(ord(s[x])+32);
end;
KHuruf :=s;
end;
var
k:string;
begin
write('Write a word='); readln(k);
writeln;
writeln('your ward are :',k);
writeln;
writeln('after conversion=',KHuruf(k));
end.
if we run the statement,we are get output like this :
program conversion_character;
uses wincrt;
function KHuruf(s:string) : string;
var
x : byte;
panjang : integer ;
begin
panjang:= length(s);
for x:=1 to panjang do
begin
if s[x] <> upcase (s[x]) then
s[x] :=upcase(s[x])
else
if s[x]=' 'then s[x] :=s[x]
else
s[x]:= chr(ord(s[x])+32);
end;
KHuruf :=s;
end;
var
k:string;
begin
write('Write a word='); readln(k);
writeln;
writeln('your ward are :',k);
writeln;
writeln('after conversion=',KHuruf(k));
end.
if we run the statement,we are get output like this :
0 komentar:
/*Program luas segitiga*/
/*Dengan memasukan alas dan tinggi suatu segitiga yang bertipe integer
maka akan dihitung luasNya dan kemudian akan dicetak keluaranNya*/
#include <stdio.h>
main()
{
/*DEKLARASI*/
int alas; /*Alas segitiga*/
int tinggi; /*Tinggi segitiga*/
int luas; /*Luas segitiga */
/*ALGORITMA*/
printf ("Alas = ");scanf("%d", &alas); /*Memasukkan panjang*/
printf ("Tinggi = ");scanf("%d", &tinggi); /*Memasukkan Lebar*/
luas = (alas * tinggi)/2 ; /*Menghitung luas*/
printf("Luas segitiga = %d \n", luas); /*Mencetak luas*/
scanf("%d");
}
Jika program diatas anda run maka akan menghasilkan output seperti dibawah ini :
ALGORITMA KONVERSI KE DETIK
1.scanf (jam,menit,detik);
2.total_detik =(jam*3600) + (menit *) 60 + detik;
3.printf (total_detik);
2.total_detik =(jam*3600) + (menit *) 60 + detik;
3.printf (total_detik);
PROGRAM KONVERSI KE DETIK
/*Prgram konversi dari jam dan menit kedetik*/
/*Program ini mengkonversi waktu dari jam ke detik dn dari menit kedetit
sehingga output berupa detik*/
#include <stdio.h>
main()
{
/*DEKLARASI*/
typedef struct {long int jam;
long int menit;
long int detik;
}
jam;
jam j;
long int total_detik;
/*PROGRAM UTAMA*/
printf ("Jam : "); scanf ("%ld", &j.jam);
printf ("Menit : "); scanf ("%ld", &j.menit);
printf ("Detik : "); scanf ("%ld", &j.detik);
total_detik = (j.jam * 3600) + (j.menit * 60) + j.detik ;
printf("Total detik : %ld",total_detik);
scanf("%ld");
}
Apabial program diatas kita run maka akan menghasilkan output seperti dibawah ini
Dalam ilmu matematika faktorial dari suatu bialngan dirumuskan dengan:
n ! = n*(n-1)……*1
atau
n ! = 1*(n+1)…..*n
Akan tetapi pada pembahasn kali ini kita hanya akan membahas penggunaan 1 rumus saja yaitu
n ! = 1*(n+1)…..*n
.
ALGORITMA MENGHITUNG FAKTORIAL
1.Tentukan fariabel i,n,faktorial
2.faktorial = 1;
3.scanf(n)
4.for (i=1; i<=n; i++) { faktorial= faktorial*i; }
5.printf(faktorial);
6.End.
PROGRAM MENGHITUNG NIALI FAKTORIAL DARI SUATU BILANGAN DENGAN BAHASA C++
/*Progra factorial dengan bahas c++*/
/*Menghitung niali faktorial dari suatu bilangan*/
#include <stdio.h>
main()
{/*DEKLARASI*/
int i,n,faktorial ;
/*program utama*/
faktorial = 1; /*inilialisasi faktorial dengan 1*/
printf("Masukkan bilangan : "); scanf("%d", &n);
for (i=1; i<=n; i++)
{
faktorial= faktorial*i;
}
printf("Hasil faktorial : %d",faktorial);
scanf("%d");
}
Apabila program diatas kita run maka akan menghasilkan output seperti dibaah ini :
ALGORITMA PEMROGRAMAN MENGHITUNG PANGKAT
1.buat variabel x,n,hasil,i ;
2.scanf(x)
3.scanf(n)
4.Inisialisasi i = 1; hasil = 1;
5.for (i=1; i<=n; i++) { hasil= hasil*x; }
6.printf(hasil)
end
Program menghitung nilai perpangkatan dari suatu bilangan dengan bahasa c++
/*Prpgram menghitung pangkat*/
/*Mengitung nilai pangkat dari suatu bilangan*/
#include <stdio.h>
main()
{
/*deklarasi*/
int x,i,n,hasil ;
/*program utama*/
printf("masukan angka:"); scanf ("%d", &x); /*masukan angka yg akan dipangkatkan*/
printf("masukan pangkat :"); scanf ("%d", &n);/*memasukkan pangkat*/
i = 1; hasil = 1; /*inilialisasi i dan hasil dengan 1*/
for (i=1; i<=n; i++)
{
hasil= hasil*x;
}
printf("%d",hasil); /*mencetak hasil pangkat*/
scanf("%d");
}
Apabial program tersebut anda Run maka akan menghasilkan output seperti dibawah ini :
ALGORITMA PEMROGRAMAN
1.inisialisasi semua variabel (i,N,Jumlah)
2.masukkan nilai N
3.inisialiasi jumlah = 0
4.for (i=1; i<=N; i++) {jumlah = jumlah + i ;}
5.printf(jumlah)
2.masukkan nilai N
3.inisialiasi jumlah = 0
4.for (i=1; i<=N; i++) {jumlah = jumlah + i ;}
5.printf(jumlah)
PROGRAM C++
/*Program penjumlahan deret bilangan bulat*/
/*Penjumlahan deret bilangan bulat dari mulai 1 sampai N bilangan
dengan N merupakan bilangan positif*/
#include <stdio.h>
main()
{ /*Variabel*/
int N,i,jumlah;
/*Program utama*/
printf ("Masukan jumlah suku bilangan [N] ="); scanf("%d",&N);
jumlah = 0 ;/*inilialisasi jumlah dengan 0*/
printf("deret bilangan adalah: ");
for (i=1; i<=N; i++)
{
printf("%d , ", i);
jumlah = jumlah + i ;
}
printf("Jumlah deret = %d ",jumlah);
scanf("%d");
}
Dan ketika program diatas anda RUN maka akan menghasilkan output seperti dibawah ini :
Disini kita akan belajar bersama bagaimana cara menghitung suatu luas bangun yang berbentuk persegi dengan bahasa c++.Dalam bahasa matematis luas segiempat dirumuskan dengan
:
Luas : panjang x lebar
Algoritma menghitung luas segiempat :
DEKLARASI :
panjang,lebar,luas : integer
ALGORITMA :
read(panjang,lebar)
luas : panjang * lebar
write(Luas)
end.
Jika anda ingin membuat program menghitung luas segiempat dengan bahasa c++ anda dapat liat pada source code dibawah ini :
/*Program luas segi empat*/
/*Dengan memasukan panjang dan lebar suatu persegi yang bertipe integer
maka akan dihitung luasNya dan kemudian akan dicetak keluaranNya*/
#include <stdio.h>
main()
{
/*DEKLARASI*/
int panjang; /*Panjang segiempat*/
int lebar; /*Lebar segiempat */
int luas; /*Luas segiempat */
/*ALGORITMA*/
printf ("Panjang = ");scanf("%d", &panjang); /*Memasukkan panjang*/
printf ("Lebar = ");scanf("%d", &lebar); /*Memasukkan Lebar*/
luas = panjang * lebar ; /*Menghitung luas*/
printf("Luas segiempat = %d \n", luas); /*Mencetak luas*/
scanf("%d");
}
Apabial program diatas kiata run maka akan menghasilkan output seperti di bawah ini :
Misal kita akan menghitung luas segi empat dengan panjang 5cm dan lebar 4cm,maka akan menghasilkan output seperti dibawah ini
Misal kita akan menghitung luas segi empat dengan panjang 5cm dan lebar 4cm,maka akan menghasilkan output seperti dibawah ini
uses wincrt;
const Nmaks = 100;
var
A: array [1..Nmaks] of integer;
I,j,N,temp : integer;
begin
writeln('write sum of input number :');readln(N);
for I:=1 to N do
begin
write('A[',i,'] =');readln(A[i]);
end;
for i:=1 to N do
for j:=i to N do
begin
if A[i]>A[j] then
begin
temp:=A[i];
A[i]:=A[j];
A[j]:=temp;
end;
end;
for i:=1 to n do
writeLN(A[I],' ');
end.
if we run the statement,we are get output like this :
program shortingbyname;
uses wincrt;
type maksStRing = string[30];
var
i,j,n : integer;
temp : maksStRing;
data : array [1..20] of maksString;
begin
writeln('sum of data :'); readln(n);
writeln;
writeln('before :');
writeln;
for i:=1 to n do
begin
write(i:2,'.');
readln(data[i]);
end;
for i:=1 to n do
for j:=1 to n do
if data[i]<data[j] then
begin
temp := data[i] ;
data[i]:=data[j] ;
data[j]:=temp ;
end;
writeln;
writeln('after :');
writeln;
for i:=1 to n do
writeln(i:2,'.',data[i]);
readln;
end.
if we run the statement,we are get output like this :
In mathematics combination is formulated with :
C(n,k) = n! / n!* (n-k)!
For example,combination from 5 and 2 is :
C(5,2) = 5! / 5!* (5-2)!
= 10
In pascal programming you can use statement like this to finish it.
program combinasi;
uses wincrt;
var fn,fk,fn_k,kombinasi : real;
i,n,k : integer;
begin
write('input n =');readln(n);
write('input k =');readln(k);
fn:=1;
fk:=1;
fn_k:=1;
for i:=2 to n do
fn := fn * i;
for i:=2 to k do
fk := fk * i;
for i:=2 to (n-k) do
fn_k := fn_k * i;
kombinasi:= fn/(fk*fn_k);
writeln(n,' kombinasi ',k,' = ',kombinasi:0:0);
end.
And the output is like this :
In mathematics combination is formulated with :
P(n,k) = n ! / (n-k)!
For example,combination from 5 and 2 is :
P(5,2) = 5 ! / (5-2)!
= 20
In pascal programming you can use statement like this to finish it.
program permutation1;
uses wincrt;
var fn,fk,fn_k,Permutation : real;
i,n,k : integer;
begin
write('input n =');readln(n);
write('input k =');readln(k);
fn:=1;
fk:=1;
fn_k:=1;
for i:=2 to n do
fn := fn * i;
for i:=2 to k do
fk := fk * i;
for i:=2 to (n-k) do
fn_k := fn_k * i;
permutation:= fn/(fn_k);
writeln(n,' Permutation ',k,' = ',Permutation:0:0);
end.
and the output is like this :
Factorial
we often finish the factorial case with formula like this:general formula =
n!=n*(n-1)*((n-1)-1).....*1
for the example:
5! =5*4*3*2*1
3! =3*2*1
We can finish the factorial case with statement like this :
program faktorial;
uses crt;
var I,N,fak: integer ;
begin
resdln(N) ;
fak:=1
for I:=1 to N do
fak:=fak*I;
writeln(fak);
readln;
end.
if we run the statement,we are get output like this :
Palindrom
program palindrom;uses wincrt;
var kt,huruf,huruf1:string;
i,j : integer;
begin
writeln('Write a word : ');readln(kt);
writeln;
j:=length(kt);
huruf:='';
for i:=1 to j do
huruf:=huruf + kt[i];
for i:=j downto 1 do
huruf1:=huruf1 + kt[i];
writeln('Origin Word: ',huruf);
writeln('the reverse side : ',huruf1);
writeln;
if (huruf=huruf1) then
writeln('this word included in Palindrom')
else
writeln('this word not included in Palindrom');
end.
if we run the statement,we are get output like this :
We can finish the pangkat case with statement like this :
program pankat;
uses wincrt;
var I,n,x,hasil :integer ;
begin
readln(x,n);
I:=1; hasil:=1;
for I:=1 to n do
hasil:=hasil*x;
writeln(hasil);
readln;
end.
program pankat;
uses wincrt;
var I,n,x,hasil :integer ;
begin
readln(x,n);
I:=1; hasil:=1;
for I:=1 to n do
hasil:=hasil*x;
writeln(hasil);
readln;
end.
Program bilangan romawi merupakan program untuk menconversi bilangan desimal menjadi bilangan romawi.
Berikut beberapa contoh bilangan romawi :
I = 1 XL = 40 D = 500
IV = 4 L = 50 CM = 900
V = 5 XC = 90 M = 1000
IX = 9 C = 100
X = 10 CD = 400
Berikut adalah source code dalam bahasa pascal untuk program conversi dari bilangan desimal ke bilangan romawi :
program Romawi;
uses wincrt;
const rom : array [1..13] of string =
('M','CM','D','CD','C','XC','L','XL','X','IX','V','IV','I');
des : array [1..13] of integer =
(1000,900,500,400,100,90,50,40,10,9,5,4,1);
var
bil,i: integer;
roma : string;
begin
write('Masukan suatu bilangan [1..3999] : ');
readln(bil);
if (bil>0) and (bil<4000) then
begin
for i:=1 to 13 do
begin
while (bil>= des[i]) do
begin
bil := bil - des[i];
roma := roma + rom[i];
end;
end;
writeln('angka romawi dari bilangan diatas adalah :',roma)
end
else
writeln('Tidak diketahui simbol romawinya...');
end.
Apabila program tersebut kita jalankan maka akan menghasilkan output seperti dibawah ini:
Program parking;
uses wincrt;
var kendaraan : string;
j1,m1,d1,j2,m2,d2,j3,m3,d3 : integer;
T :longint;
bayar : integer;
begin
writeln ('Program price of car and motorcycle');
writeln ('Input Time in and time out (clock, minute, sekon) separated with space');
write('Write type of transportation(car or motorcycle) : ' ); readln(kendaraan);
write('Input time In : '); readln(j1,m1,d1);
write('Input time Out : '); readln(j2,m2,d2);
T := (j2*3600+m2*60+d2)-(j1*3600 + m1*60 +d1);
j3 := T div 3600;
m3 := (T mod 3600) div 60;
d3 := (T mod 3600) mod 60;
if (m3>0) or (d3>0) then
j3:=j3+1;
if kendaraan = 'motorcycle' then
begin
if j3<=2 then
bayar := 1000
else bayar :=1000+500*(j3-2);
if bayar >=7500 then bayar := 7500;
end;
if kendaraan ='car' then
begin
if j3 <=2 then
bayar := 2000
else bayar := 2000+1000*(j3-2);
if bayar >=15000 then bayar := 15000;
end;
write('Biaya Parkir : ',bayar);
readln;
end.
if we run the statement,we are get output like this :
program segitiga_pascal;
uses wincrt;
type pas=array [1..20,1..20] of longint;
var pascal : pas;
i,j,n : integer;
begin
pascal[1,1]:=1;
write('Banyak Level :');readln(n);{:=10;}
for i:=2 to n do
begin
pascal[i,1]:=1;
Pascal[i,i]:=1;
for j:=2 to i-1 do
pascal[i,j]:=pascal[i-1,j-1]+pascal[i-1,j];
end;
{write(pascal[2,1],'');
writeln; }
for i:=1 to n do
begin
for j:=1 to i do
write(pascal[i,j]);
writeln;
end;
end.
Jika program diatas Kita RUN maka akan menghasilkan output seperti dibawah ini :
Change Desimal to Binner
When we studied about 'pemrograman sistem digital',there are lesson about 'sistem billangan'.In there we need skill to conversion one type of number to other type.
One of them is change circle number to binner number.
For example :
1=1
2=01
3=001
4=101
5=110
To finish that case,we can use statement like this :
uses wincrt;
var bil,b : integer;
b2 : char;
hasil : string;
begin
writeln('write a decimal number : ');readln(bil);
while bil>=1 do
begin
b:=bil mod 2;
bil:=bil div 2;
if b=1 then b2:='1' else b2:='0';
hasil:=hasil+b2;
end;
writeln('binner number of it: ',hasil)
end.
if we run the statement,we are get output like this :
Conversion Temperature
program convertoftemperature;uses wincrt;
var F:integer;
C,R,k:real;
begin
write('Write temperature in Farenhet :');readln(F);
C:=(F-32)/9*5;
R:=(F-32)/9*4;
K:=(C+273);
writeln('Celsius :', C:6:2);
writeln;
writeln('Reamur :', R:6:2);
writeln;
writeln('kelvin :', K:6:2);
end.
if we run the statement,we are get output like this :
Deret Fibonacci
Deret Fibbonacci is one kinds of deret with value of f0 and f1 are same.General formula of Deret Fibbonacci is :
fk = fk-1 + fk-2 . dengan k = 2, 3, 4, 5, …
And f0 = 1, f1 = 1.
We could finish the Deret Fibbonacci case with statement like this :
Program deretFibonaci;
uses wincrt;
var f : array[0..25] of integer;
I, n : integer;
begin
write('write sum of deret : ');
readln(n);
f[0] := 1; f[1] := 1;
write('Deret Fibonaci :');
Write(f[0]:5, f[1]:5);
For I := 2 to n do
begin
f[i] := f[i-1] + f[i-2];
write(f[i]:5);
end;
readln
end.
if we run the statement,we are get output like this :
0diggsdigg
Program encypt decrypt ini merupakan program yang digunakan untuk membuat pesan rahasia.Program dibawah ini mempunyai kunci untuk encrypt = alfabet + 3. Sedangkan untuk decrypt mempunyai rumus sebaliknya.
program enkripsi_diskripsi;
uses wincrt;
var
i : byte;
kata : string;
kunci,pil : char;
Procedure menu;
forward;
Procedure input;
begin
gotoxy(1,5);write ('Write a word : '); readln (kata);
end;
Procedure enkripsi;
begin
clrscr;
gotoxy(1,2);writeln('ENKRIPSI');
gotoxy(1,3);writeln('====================');
input;
for i:=1 to length(kata) do
begin
kata[i]:=chr(ord(kata[i])+ 3);
if (kata[i] in ['A'..'Z']) or (kata[i] in ['a'..'z']) then kata[i] := kata[i]
else
kata[i] := chr(ord(kata[i])- 26);
end;
gotoxy(1,7);write ('Result of Enkripsi : ',kata);
gotoxy(15,24);write('==== Press Enter to return Menu ==== ');
readln;
menu;
end;
Procedure dekripsi;
begin
clrscr;
gotoxy(1,2);writeln('DEKRIPSI');
gotoxy(1,3);writeln('====================');
input;
for i :=1 to length(kata) do
begin
kata[i]:=chr(ord(kata[i]) - 3);
if (kata[i] in ['A'..'Z']) or (kata[i] in ['a'..'z']) then kata[i] := kata[i]
else
kata[i] := chr(ord(kata[i]) + 26)
end;
gotoxy(1,7);write ('Hasil Dekripsi : ',kata);
gotoxy(15,24);write('==== Press Enter to Return Menu ==== ');
readln;
menu;
end;
Procedure menu;
var
pil : char;
begin
clrscr;
repeat
gotoxy(16,9); writeln(' ========================');
gotoxy(16,10);writeln(' NAMA : RIKY BAGUS.M ');
gotoxy(16,11);writeln(' NIM : M0508117 ');
gotoxy(16,12);writeln(' ========================');
gotoxy(21,15);writeln(' MENU ');
gotoxy(22,16);writeln('1. Enkripsi Massange');
gotoxy(22,17);writeln('2. Dekripsi Massange');
gotoxy(22,18);writeln('3. Exit ');
gotoxy(16,20);writeln('Your Choise : ');
gotoxy(31,20);readln(pil);
until (pil in ['1','2','3']);
case pil of
'1' : enkripsi;
'2' : dekripsi;
'3' : donewincrt;
end;
end;
begin
menu;
end.
Jika program diatas kita run maka akan menghasilkan output seperti dibawah ini :
Untuk output program encrypt
Sedangkan output program decrypt
To find the biggest end the smallest number of suite number,in this case I am use array type.
To fing it we must compare indeks[1] with other indeks.We can use indeks[1] (i[1]) for the reference.
We can compare the indeks with statement like this:
program bil_kecil_besar;
uses wincrt;
var dafbil : array [1..100] of integer;
terbesar,terkecil : integer;
i,n : integer;
begin
writeln('masukan jumlah bilangan imputan');
readln(n);
for i:=1 to n do
begin
write('bilangan ke-',i,'=') ; read(dafbil[i]);
end;
terbesar := dafbil[1];
terkecil := dafbil[1];
for i:=2 to n do
if dafbil[i] > terbesar then
terbesar := dafbil[i]
else
if dafbil[i] < style="margin: 0px auto 10px; display: block; text-align: center; cursor: pointer; width: 400px; height: 95px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiTvyM90QxQo-9C_yigdk7niKbBMauRxYqFWotOYObBDCfZsZoYSrQ6mbC3U0CZvA8PegHLnkmcCZiqJBSmxVvnM7riamsPFAYeIcsjG73cDdu9am47BiYHG_ymlGky8rCm7VfpgjU_2rs/s400/besar+kecil.jpg" alt="" id="BLOGGER_PHOTO_ID_5298001271877449042" border="0">
To fing it we must compare indeks[1] with other indeks.We can use indeks[1] (i[1]) for the reference.
We can compare the indeks with statement like this:
program bil_kecil_besar;
uses wincrt;
var dafbil : array [1..100] of integer;
terbesar,terkecil : integer;
i,n : integer;
begin
writeln('masukan jumlah bilangan imputan');
readln(n);
for i:=1 to n do
begin
write('bilangan ke-',i,'=') ; read(dafbil[i]);
end;
terbesar := dafbil[1];
terkecil := dafbil[1];
for i:=2 to n do
if dafbil[i] > terbesar then
terbesar := dafbil[i]
else
if dafbil[i] < style="margin: 0px auto 10px; display: block; text-align: center; cursor: pointer; width: 400px; height: 95px;" src="https://blogger.googleusercontent.com/img/b/R29vZ2xl/AVvXsEiTvyM90QxQo-9C_yigdk7niKbBMauRxYqFWotOYObBDCfZsZoYSrQ6mbC3U0CZvA8PegHLnkmcCZiqJBSmxVvnM7riamsPFAYeIcsjG73cDdu9am47BiYHG_ymlGky8rCm7VfpgjU_2rs/s400/besar+kecil.jpg" alt="" id="BLOGGER_PHOTO_ID_5298001271877449042" border="0">
Find Mean Median and Modus
program mean_median_modus;uses wincrt;
type larik = array[1..100] of integer;
var n,m,max : integer;
x,y,f : larik;
jawaban : char;
procedure inputdata(var x:larik; var n:integer);
var i : integer;
begin
write('Write sum of data input: ');readln(n);
for i:=1 to n do
begin
write('File of- ',i,' : ');readln(x[i]);
end;
end;
procedure urutdata(var x:larik; var n:integer);
var i, j, temp : integer;
begin
for i:= 1 to n-1 do
for j:= i to n do
begin
if x[j]<x[i] then
begin
temp:=x[i];
x[i]:=x[j];
x[j]:=temp;
end;
end;
writeln;
write('sort of data : ');
for i:=1 to n do
write(x[i]:4);
writeln;
end;
procedure mean(var x:larik; var max,n:integer);
var rata_rata:real; i,jml: integer;
begin
jml:=0;
max:=x[i];
for i:=1 to n do
jml:= jml+x[i];
rata_rata:=jml/n;
write('Average : ',rata_rata:4:0);
writeln;
end;
procedure frekuensi(x:larik; n:integer; var y,f:larik; var m:integer);
var i, j : integer;
begin
for i:=1 to n do
f[i]:=1;
x[n+1]:=x[n]+1;
j:=1;
for i:=1 to n do
if x[i] = x[i+1] then f[j]:=f[j]+1
else
begin
y[j] := x[i];
j := j + 1;
end;
m:=j-1;
end;
procedure maxfrekuensi(f,x:larik; m:integer; var max:integer);
var i:integer;
begin
max:=x[i];
for i:=1 to m do
if f[i]>max then max:=f[i];
end;
procedure modus(y,f:larik; m, max:integer);
var i:integer;
begin
if max = 1 then write('There are not modus')
else
begin
for i:=1 to m do
if f[i]=max then write ('Modus : ',y[i]);
end;
writeln;
end;
procedure median(var x:larik; n:integer);
var md:real; ltk:integer;
begin
if (n mod 2 = 1) then
begin
ltk:=(n div 2)+1;
md := x[ltk]
end
else
begin
ltk:=(n div 2);
md :=(x[ltk]+x[ltk+1])/2;
end;
write('Nilai Median : ',md:4:0);
end;
begin
repeat
clrscr;
gotoxy(20,2);writeln('***************************************** ');
gotoxy(20,3);writeln('* Find Mean Median and Modus * ');
gotoxy(20,4);writeln('***************************************** ');
writeln;
inputdata(x,n);
urutdata(x,n);
mean(x,max,n);
frekuensi(x,n,y,f,m);
maxfrekuensi(f,x,m,max);
modus(y,f,m,max);
median(x,n);
writeln;writeln;
write('Repeat again [Y/T]? : ');readln(jawaban);
until upcase(jawaban)<>'Y';
end.
if we run the statement,we are get output like this :
Program age;
uses wincrt;
var tgl1, tgl2, bl1, bl2, th1, th2, jmlHari : longint;
year, month, day : integer;
again : boolean; choose : char;
Begin
clrscr;
again := true;
while again Do
Begin
writeln('program to know your birth day');
writeln('input your birth day ');
write('day :');readln(tgl1);
write('month :');readln(bl1);
write('year :');readln(th1);
writeln('input this day ');writeln;
write('day :');readln(tgl2);
write('month :');readln(bl2);
write('year :');readln(th2);
Jmlhari := (th2-th1)*360+(bl2-bl1)*30+(tgl2-tgl1);
year := Jmlhari div 360;
month:= Jmlhari mod 360 div 30;
day := Jmlhari mod 360 mod 30;
write('your age ',Year,' year ',month,' Month ',day,' day');
writeln; writeln;
write('Mau coba lagi? (Y/T)'); readln(choose);
if (choose ='t') or (choose='T') then again := False;
end;
readln;
End.
and the output is like this :
Magic Square
program magic_square;uses wincrt;
type
matriks = Array[1..20,1..20] of Integer;
var
x: matriks;
n,i,j,k : Integer;
jwb:char;
Begin
clrscr;
repeat
writeln('Please input queer number ');
writeln;
writeln;
write('Input ordo matriks, n = '); Readln(n);
if n mod 2 = 0 then writeln('wrong input (please input queer number)')
else
begin
{ inisialisasi kotak, array di isi dengan 0 }
For i:=1 to n do
For j:=1 to n do x[i,j]:= 0;
i:=1;
j:= (n + 1) div 2;
k:=0;
end;
repeat
k:=k+1;
begin
x[i,j]:=k;
i:=i-1;
j:=j-1;
end;
Begin
if (i=0) and (j<>0) then
i:=n
else if (j=0) and (i<>0) then
j:=n
else if (i=0) and (j=0) then
begin
i:=2;
j:=1;
end;
if x[i,j]<>0 then
begin
i:=i+2;
j:=j+1;
End;
end;
until k > sqr(n);
For i:= 1 to n do
begin
For j:=1 to n do
begin
write(x[i,j]:4);
end;
writeln;
end;
writeln('repeat again?? [Y/N]') ;
readln(jwb);
until not (jwb in['y','Y']);
end.
if we run the statement,we are get output like this :
Program TLMatrik;
uses wincrt;
type matrik = array [1..20,1..20] of integer;
var
i, j : integer;
barisa, koloma, barisb, kolomb, baris1, kolom1, baris2, kolom2, pil : integer;
matrika, matrikb, matrik1, matrik2 : matrik;
pilihan : char;
Procedure Identitas;
{prosedur untuk menampilkan biodata pembuat program}
begin
writeln(' ========================================= ');
writeln('| |');
writeln('| PROGRAM INI DIBUAT OLEH : |');
writeln('| |');
writeln('|-----------------------------------------|');
writeln('| |');
writeln('| Nama : Riky |');
writeln('| NIM : M0508117 |');
writeln('| Nama Program : Program Matrik |');
writeln('| Tanggal pembuatan : 23 Februari 2008 |');
writeln('| |');
writeln(' ========================================= ');
readln;
end;
Procedure Bacadataa;
{prosedur untuk input data manual matrik pertama}
begin
writeln('Memasukkan input data secara manual');
writeln('Masukkan ordo matrik A');
write('Jumlah baris : '); readln(barisa);
write('Jumlah kolom : '); readln(koloma);
end;
Procedure Bacadatab;
{prosedur untuk input data manual matrik kedua}
begin
writeln('Memasukkan input data secara manual');
writeln('Masukkan ordo matrik B');
write('Jumlah baris : '); readln(barisb);
write('Jumlah kolom : '); readln(kolomb);
end;
Procedure buatdata1;
{prosedur untuk input data random matrik pertama}
begin
writeln('Anda memilih input data random');
writeln('Masukan ordo matrik 1');
write('Jumlah baris : '); readln(baris1);
write('Jumlah kolom : '); readln(kolom1);
writeln;
end;
Procedure buatdata2;
{prosedur untuk input data random matrik pertama}
begin
writeln('Masukan ordo matrik 2');
write('Jumlah baris : '); readln(baris2);
write('Jumlah kolom : '); readln(kolom2);
writeln;
end;
Procedure matrikmanuala;
{prosedur unutk membuat matrik A dengan input manual}
begin
for i:= 1 to barisa do
for j:= 1 to koloma do
begin
writeln('Masukan data untuk matrik A : ');
write('matrik [',i,',',j,'] = ');readln(matrika[i,j]);
end;
end;
Procedure matrikmanualb;
{prosedur untuk membuat matrik B dengan input manual}
begin
for i:= 1 to barisb do
for j:= 1 to kolomb do
begin
writeln('Masukan data untuk matrik B : ');
write('matrik [',i,',',j,'] = ');readln(matrikb[i,j]);
end;
end;
Procedure cetakmatrika;
{prosedur unutk mencetak matrik A input manual}
begin
writeln('tampilan matrik A adalah');readln;
for i:= 1 to barisa do
begin
for j:= 1 to koloma do
write(matrika[i,j],' ':15);
writeln;
end;
end;
Procedure cetakmatrikb;
{prosedur untuk mencetak matrik B input manual}
begin
writeln('tampilan matrik B adalah');readln;
writeln;
for i:= 1 to barisb do
begin
for j:= 1 to kolomb do
write(matrikb[i,j],' ':15);
writeln;
end;
end;
Procedure random1;
{prosedur untuk membuat matrik dengan cara random}
var i,j : integer;
begin
randomize;
for i:= 1 to baris1 do
for j:= 1 to kolom1 do
begin
matrik1[i,j]:=random(20);
end;
end;
Procedure random2;
{prosedur unutk membuat matrik dengan cara random}
var i,j : integer;
begin
randomize;
for i:= 1 to baris2 do
for j:= 1 to kolom2 do
begin
matrik2[i,j]:=random (20);
end;
end;
Procedure cetakmatrik1;
{prosedur untuk mencetak matrik 1 dengan input random}
begin
writeln;
writeln('tampilan matrik 1 adalah'); readln;
for i:= 1 to baris1 do
begin
for j:= 1 to kolom1 do
write(matrik1[i,j],' ':15);
writeln;
end;
readln;
end;
Procedure cetakmatrik2;
{prosedur untuk mencetak matrik 2 dengan input manual}
begin
writeln;
writeln('tampilan matrik 2 adalah');readln;
writeln;
for i:= 1 to baris2 do
begin
for j:= 1 to kolom2 do
write(matrik2[i,j],' ':15);
writeln;
end;
readln;
end;
Procedure jumlahmatrikm(matrika,matrikb:matrik;barisa,koloma,barisb,kolomb :integer);
{prosedur untuk menjumlahkan matrik dengan input manual}
var i,j : integer;
hsl : matrik;
begin
if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
begin
writeln('Hasil penjumlahan matrik adalah');
for i:=1 to barisa do
begin
for j:=1 to koloma do
begin
hsl[i,j]:=matrika[i,j]+matrikb[i,j];
end;
end;
end;
if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
for i:= 1 to barisa do {mencetak hasil penjumlahan}
begin
for j:= 1 to koloma do
write(hsl[i,j],' ':15);
writeln;
end
else writeln('Matrik tidak dapat dijumlahkan karena dimensinya tidak cocok');
end;
Procedure jumlahmatrikr(matrik1,matrik2:matrik;baris1,kolom1,baris2,kolom2 :integer);
{prosedur untuk menjumlahkan matrik dengan input random}
var i,j : integer;
hsl : matrik;
begin
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
begin
writeln('Hasil penjumlahan matrik adalah');
for i:=1 to baris1 do
begin
for j:=1 to kolom1 do
begin
hsl[i,j]:=matrik1[i,j]+matrik2[i,j];
end;
end;
end;
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
for i:= 1 to baris1 do {mencetak hasil penjumlahan}
begin
for j:= 1 to kolom1 do
write(hsl[i,j],' ');
writeln;
end
else writeln('Matrik tidak dapat dijumlahkan karena dimensinya tidak cocok')
end;
Procedure kurangmatrikm(matrika,matrikb:matrik;barisa,koloma,barisb,kolomb :integer);
{prosedur untuk mengurangkan matrik dengan input manual}
var i,j : integer;
hsl : matrik;
begin
if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
begin
writeln('Hasil pengurangan matrik adalah');
for i:=1 to barisa do
begin
for j:=1 to koloma do
begin
hsl[i,j]:=matrika[i,j]-matrikb[i,j];
end;
end;
end;
if (barisa=barisb) and (koloma=kolomb) then {mengecek apakah matrik tersebut bujur sangkar}
for i:= 1 to barisa do {mencetak hasil pengurangan}
begin
for j:= 1 to koloma do
write(hsl[i,j],' ':15);
writeln;
end
else writeln('Matrik tidak dapat dikurangkan karena dimensinya tidak cocok');
end;
Procedure kurangmatrikr(matrik1,matrik2:matrik;baris1,kolom1,baris2,kolom2 :integer);
{prosedur untuk mengurangkan matrik dengan input random}
var i,j : integer;
hsl : matrik;
begin
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
begin
writeln('Hasil pengurangan matrik adalah');
for i:=1 to baris1 do
begin
for j:=1 to kolom1 do
begin
hsl[i,j]:=matrik1[i,j]-matrik2[i,j];
end;
end;
end;
if (baris1=baris2) and (kolom1=kolom2) then {mengecek apakah matrik tersebut bujur sangkar}
for i:= 1 to baris1 do {mencetak hasil pengurangan}
begin
for j:= 1 to kolom1 do
write(hsl[i,j],' ':15);
writeln;
end
else writeln('Matrik tidak dapat dikurangkan karena dimensinya tidak cocok')
end;
Procedure perkalianmatrikm;
{prosedur untuk mengalikan matrik dengan input manual}
var i, j, k : byte;
hasil : matrik;
begin
writeln('Hasil perkalian matrik adalah');
if (koloma=barisb) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
for i := 1 to barisa do
begin
for j := 1 to kolomb do
begin
hasil[i,j]:=0;
for k := 1 to barisb do
begin
hasil[i,j] := hasil[i,j] + matrika[i,k] * matrikb[k,j];
end;
end;
end;
if (koloma=barisb) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
for i:= 1 to barisa do {mencetak hasil perkalian}
begin
for j:= 1 to kolomb do
write(hasil[i,j],' ':15);
writeln;
end
else writeln('Matrik tidak dapat dikalikan karena dimensinya tidak cocok');
end;
Procedure perkalianmatrikr;
{prosedur untuk mengalikan matrik dengan input random}
var i, j, k : byte;
hasil : matrik;
begin
writeln('Hasil perkalian matrik adalah');
if (kolom1=baris2) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
for i := 1 to baris1 do
begin
for j := 1 to kolom2 do
begin
hasil[i,j]:=0;
for k := 1 to baris2 do
begin
hasil[i,j] := hasil[i,j] + matrik1[i,k] * matrik2[k,j];
end;
end;
end;
if (kolom1=baris2) then {mengecek apakah kolom matrik pertama sama dengan baris matrik kedua }
for i:= 1 to baris1 do {mencetak hasil perkalian}
begin
for j:= 1 to kolom2 do
write(hasil[i,j],' ':15);
writeln;
end
else writeln('Matrik tidak dapat dikalikan karena dimensinya tidak cocok');
end;
Procedure transposem;
{prosedur untuk mentranspose matrik dengan input manual}
var i, j : integer;
trans : matrik;
begin
for i := 1 to koloma do
begin
for j := 1 to barisa do
begin
trans[i,j] := matrika [j,i];
end;
writeln;
end;
{mencetak matrik hasil transpose}
write('Hasil transpose matrik adalah'); writeln; writeln;
for i := 1 to koloma do
begin
writeln;
for j := 1 to barisa do
write(trans[i,j]:15);
writeln;
end;
end;
Procedure transposer;
{prosedur untuk mentranspose matrik dengan input random}
var i, j : integer;
trans : matrik;
begin
for i := 1 to kolom1 do
begin
for j := 1 to baris1 do
begin
trans[i,j] := matrik1 [j,i];
end;
writeln;
end;
{mencetak matrik hasil transpose}
clrscr;
write('Hasil transpose matrik adalah'); writeln; writeln;
for i := 1 to kolom1 do
begin
writeln;
for j := 1 to baris1 do
write(trans[i,j]:15);
writeln;
end;
end;
Function tracem : integer;
{fungsi trace dengan input manual}
var i, j : byte;
trace : integer;
begin
if (barisa= koloma) then
begin
trace := 0;
for i := 1 to barisa do
begin
for j := 1 to koloma do
if (i = j) then
trace := trace + matrika[i,j];
end;
writeln;
write('Hasil dari trace matrik adalah : ');
writeln(trace);
writeln;
end
else
begin
writeln('Matrik dengan ordo ini tidak dapat dieksekusi');
writeln('Baris dan kolom yang anda masukan tidak sama');
end;
end;
Function tracer : integer;
{fungsi trace dengan input random}
var i, j : byte;
trace : integer;
begin
if (baris1= kolom1) then
begin
trace := 0;
for i := 1 to baris1 do
begin
for j := 1 to kolom1 do
if (i = j) then
trace := trace + matrik1[i,j];
end;
writeln;
write('Hasil dari trace matrik adalah :');
writeln(trace);
writeln;
end
else
begin
writeln('Matrik dengan ordo ini tidak dapat dieksekusi');
writeln('Baris dan kolom yang anda masukan tidak sama');
end;
end;
{menu utama}
begin
identitas;
clrscr;
repeat
clrscr;
writeln('Pilihlah operasi yang Anda inginkan terhadap matrik yang akan Anda buat!');
writeln('1.Mencari trace matrik');
writeln('2.Menjumlahkan dua matrik');
writeln('3.Mengurangkan dua matrik');
writeln('4.Mentranspose matrik');
writeln('5.Mengalikan dua matrik');
writeln;
writeln('1 : input manual');
writeln('2 : input random');
writeln;
writeln('contoh pemilihan..');
writeln('21 : Menjumlahkan dua matrik secara manual');
writeln;
write('Masukkan pilihan anda : '); readln(pil);
clrscr;
case pil of
11 : begin
writeln('Anda memilih mencari trace matrik secara manual'); writeln;
bacadataa; writeln;
matrikmanuala; clrscr;
cetakmatrika; writeln;
tracem; writeln;
end;
12 : begin
writeln('Anda memilih mencari trace matrik secara random'); writeln;
buatdata1; writeln;
random1; clrscr;
cetakmatrik1; writeln;
tracer; writeln;
end;
21 : begin
writeln('Anda memilih menjumlahkan matrik matrik dengan input manual'); writeln;
bacadataa; writeln;
bacadatab; clrscr;
matrikmanuala; writeln;
matrikmanualb; clrscr;
cetakmatrika; writeln;
cetakmatrikb; writeln;
jumlahmatrikm(matrika,matrikb,barisa,koloma,barisb,kolomb);
writeln;
end;
22 : begin
writeln('Anda memilih menjumlahkan matrik matrik dengan input random'); writeln;
buatdata1; writeln;
buatdata2; writeln;
random1; writeln;
random2; clrscr;
cetakmatrik1; writeln;
cetakmatrik2; writeln;
jumlahmatrikr(matrik1,matrik2,baris1,kolom1,baris2,kolom2);
writeln;
end;
31 : begin
writeln('Anda memilih mengurangkan matrik matrik dengan input manual'); writeln;
bacadataa; writeln;
bacadatab; clrscr;
matrikmanuala; writeln;
matrikmanualb; clrscr;
cetakmatrika; writeln;
cetakmatrikb; writeln;
kurangmatrikm(matrika,matrikb,barisa,koloma,barisb,kolomb);
writeln;
end;
32 : begin
writeln('Anda memilih mengurangkan matrik dengan input random'); writeln;
buatdata1; writeln;
buatdata2; writeln;
random1; writeln;
random2; clrscr;
cetakmatrik1; writeln;
cetakmatrik2; writeln;
kurangmatrikr(matrik1,matrik2,baris1,kolom1,baris2,kolom2);
writeln;
end;
41 : begin
writeln('Anda memilih mentranspose matrik dengan input manual'); writeln;
bacadataa; writeln;
matrikmanuala; clrscr;
cetakmatrika; writeln;
transposem; writeln;
end;
42 : begin
writeln('Anda memilih mentranspose matrik dengan input random'); writeln;
buatdata1; writeln;
random1; clrscr;
cetakmatrik1; writeln;
transposer; writeln;
end;
51 : begin
writeln('Anda memilih mengalikan matrik dengan input manual'); writeln;
bacadataa; writeln;
bacadatab; clrscr;
matrikmanuala; writeln;
matrikmanualb; clrscr;
cetakmatrika; writeln;
cetakmatrikb; writeln;
perkalianmatrikm; writeln;
end;
52 : begin
writeln('Anda memilih mengalikan matrik dengan input random'); writeln;
buatdata1; writeln;
buatdata2; writeln;
random1; writeln;
random2; clrscr;
cetakmatrik1; writeln;
cetakmatrik2; writeln;
perkalianmatrikr; writeln;
end;
end;
write(' Kembali ke menu utama [Y/T]? '); readln(pilihan);
until upcase(pilihan) <> 'Y';
readln;
end .
Password
program password;uses wincrt;
const pass = 'admin';
var kata : string;
I : integer;
jawab :char;
begin
repeat
writeln('write password:');
readln(kata);
if kata <> pass then
writeln(' wrong password')
else
begin
for I:=1 to 100 do
writeln('',I,'. true password');
end;
write('ulang lagi: [Y/N]');
readln(jawab);
until not (jawab in ['Y','y']);
end.
RECORD
program contohrecord;uses wincrt;
type TAlamat = record
NamaJalan : string[20];
NoJalan : integer;
Kota : string[21];
KodePos : string[5];
end;
TSiswa = record
NIM : string[8];
Nama : string[25];
Alamat : TAlamat;
end;
var
N,i : integer;
A: array [1..100] of TSiswa;
S:TAlamat;
begin
write('masukan banyaknya siswa');readln(n);
for i:=1 to n do
begin
with A[I] do begin
writeln('NIM=');readln(NIM);
writeln('Nama=');readln(Nama);
end;
WRITELN('Alamat');
with S do BEGIN
writeln('Namajalan=');readln(NamaJalan);
writeln('NoJalan=');readln(NoJalan);
writeln('Kota=');readln(kota);
writeln('kodepos');readln;
end;
end;
for i:=1 to n do
begin
with A[I] DO BEGIN
writeln(NIM,' ',NAMA:25, ' ',S.NamaJALAN,' ',S.NoJalan,' ',S.Kota,' ',S.KodePos);
end;
end;
end.
Tak Luxurious House
program tak_luxurious_house;uses WINcrt;
var na : longint;
pjk : real;
begin
clrscr;
writeln('Input price of house asset ');
write('asset = $');read(na);
if na<30000 then pjk:=800;
if na<=50000 then pjk:=800+0.01*(na*10000-30000);
if na<=80000 then pjk:=800+0.012*(na*10000-30000);
if na<=120000 then pjk:=800+0.014*(na*10000-30000);
if na>120000 then pjk:=800+0.015*(na*10000-30000);
writeln;
writeln('price of house asset is: $ ',na);
writeln('tak of house asset is : $ ',pjk:0:2);
readln;
end.
if we run the statement,we are get output like this :
Value of Student Examination
This is statement to input fileProgram InputFile;
uses wincrt;
const Jumlah_MK = 5;
Type B_Nilai = 1..100;
Nilai = record
Nama_Mhs : string[25];
No_Mhs : string[5];
Angkatan : string[5];
Nilai_Ujian : array [1..Jumlah_MK] of B_Nilai;
Nilai_Rata : real;
end;
D_Nilai = file of Nilai;
Var Daf_Nilai : D_Nilai;
Nilai_MHs : Nilai;
I, J : integer;
Lagi : char;
Begin
assign (Daf_Nilai,'D:\NILAI.TXT');
rewrite(Daf_Nilai);
I := 0;
repeat
inc(I);
clrscr;
writeln('Input Data in file "Nilai.TXT"');
writeln('-----------------------------------'); writeln;
Writeln('Input record of : ', I:2);
writeln('----------------------');
With Nilai_Mhs Do
begin
Nilai_Rata := 0.0;
write('Name of student : '); readln(Nama_Mhs);
write('Number of student : '); readln(No_Mhs);
write('Angkatan : '); readln(Angkatan);
For J := 1 to Jumlah_Mk Do
Begin
write('Value of MK',J,' : '); readln(Nilai_Ujian[J]);
Nilai_Rata := Nilai_rata + Nilai_Ujian[J]
end;
Nilai_Rata := Nilai_rata/Jumlah_MK
end;
write(Daf_Nilai, Nilai_Mhs);
gotoxy(1,20); write('input again? Y/T : ');
readln(lagi);
until not(Lagi in ['Y','y']);
close(Daf_Nilai);
readln
end.
This is statement to read file :
Program ReadFile;
uses wincrt;
const Jumlah_MK = 5;
Garis = '-------------------------------------';
Type B_Nilai = 1..100;
Nilai = record
Nama_Mhs : string[25];
No_Mhs : string[5];
Angkatan : string[5];
Nilai_Ujian : array [1..Jumlah_MK] of B_Nilai;
Nilai_Rata : real;
end;
D_Nilai = file of Nilai;
Var Daf_Nilai : D_Nilai;
Nilai_MHs : Nilai;
I, J, N : integer;
Begin
Clrscr;
assign(Daf_Nilai,'d:\NILAI.txt');
reset(Daf_Nilai);
N := filesize(Daf_nilai);
writeln(' ':24,'List of student examination value');
writeln(' ':24,'---------------------------------');
writeln; writeln(Garis,Garis);
Writeln('| No | Name of student | No Mhs | N1 | N2 | N3 | N4 | N5 | Rata2 |');
writeln(Garis,Garis);
For I := 1 to N Do
Begin
Gotoxy(1,I+6); write('| ',I:2,' | ');
read(Daf_Nilai, Nilai_Mhs);
with Nilai_Mhs Do
Begin
Gotoxy(8,I+6); write(Nama_Mhs);
Gotoxy(34,I+6); write('| ',No_Mhs);
For J := 1 to jumlah_MK Do
Begin
Gotoxy(43+5*(j-1),I+6); write('| ',Nilai_Ujian[J]:2);
End;
Gotoxy(68,I+6); write('| ',Nilai_Rata:5:2,' |');
End
End;
writeln(Garis,Garis);
Close(Daf_Nilai);
readln
end.
And the output is like this
Euler Number
Program euler_number;uses wincrt;
var i : integer;
eul, deret : real;
function faktor(n:longint): longint;
var
j: integer; y : longint;
begin
y := 1;
if n = 0 then y :=1
else
for j:=1 to n do y := y*j;
faktor:= y;
end;
begin
eul := 0; i:=0;
Repeat
deret := 1/faktor(i);
eul := eul + deret;
i := i + 1;
Until deret <= 0.0000000000001;
Writeln('phenomenological of euler number is : ',eul);
end.
if we run the statement,we are get output like this :
Tidak ada komentar:
Posting Komentar