Nich.......program buatan kelompok 2C yang masih acak - acakan dalam bentuk Pascal
sebenernya saya sudah buat yang dalam format VB nya..., tapi belum smpurna., jadi ni aja yang diposting..
yang berniat download program VB nya silahkan klik disini
nich tak kasih juga sourche programnya klik disini
program campur;
uses wincrt;
var
pil:char;
Procedure Login;
Var
nd,pd,nl,pl:string;
Begin
Writeln(' REGISTRATION ');
Writeln('==============');
Write('Masukkan nama : ');Readln(nd);
Write('Masukkan password : ');Readln(pd);
Clrscr;
Writeln('################################################');
Writeln('# Selamat bergabung dengan Institut 2C IT!!! #');
Writeln('# Selalu ingat nama dan password kamu!! #');
Writeln('################################################');
Writeln;
Writeln('@@@@@@@@@@@@@@@@@@@@@@@@@@@@');
Writeln('@ Ingin langsung Login?? @');
Writeln('@@@@@@@@@@@@@@@@@@@@@@@@@@@@');
Writeln;
repeat
Writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^');
Write('Nama kamu : ');Readln(nl);
Write('Password kamu : ');Readln(pl);
IF (nl=nd) and (pl=pd) then
begin
Clrscr;
Writeln('************************************************');
Writeln('* Kamu telah memasuki wilayah Institut 2C IT *');
Writeln('* *');
Writeln('* You can enjoy the facilities. *');
Writeln('************************************************');
end
ELSE IF (nl=nd) and (pl<>pd) then
begin
Clrscr;
Writeln('************************************************');
Writeln('* Anda memasukkan password yang salah *');
Writeln('* *');
Writeln('* Mohon ingat-ingat kembali password Anda *');
Writeln('************************************************');
end
ELSE IF (nl<>nd) and (pl=pd) then
begin
Clrscr;
Writeln('***********************************');
Writeln('* Nama atau password kamu salah *');
Writeln('* atau *');
Writeln('* kamu memang belum terdaftar *');
Writeln('***********************************');
end
ELSE
begin
Clrscr;
Writeln('************');
Writeln('* Error!!! *');
Writeln('************');
end;
until (nl=nd) and (pl=pd);
End;
Procedure wartel;
var
j1,m1,j2,m2,j3,m3,bayar,tujuan:integer;
begin
Writeln(' PROGRAM WARTEL ');
Writeln('==================');
write('Masukkan jam mulai telphon : ');readln(j1);
write('Masukkan menit mulai telphon : ');readln(m1);
write('Masukkan jam akhir telphon : ');readln(j2);
write('Masukkan menit akhir telphon : ');readln(m2);
Writeln;
If (j2>=j1) or (m2>=m1) then
begin
j3:=j2-j1;
m3:=(m2+(j3*60))-m1;
end;
Writeln('Daftar tujuan telphon');
Writeln('1. Lamongan');
Writeln('2. Surabaya');
Writeln('3. Bandung');
Writeln('4. Jakarta');
Writeln;
Write('Masukkan tujuan telphon : ');readln(tujuan);
Clrscr;
case tujuan of
1 : begin
bayar:=m3*100;
writeln('Biaya telphon anda adalah : ',bayar,' rupiah');
end;
2 : begin
bayar:=m3*500;
writeln('Biaya telphon anda adalah : ',bayar,' rupiah');
end;
3 : begin
bayar:=m3*1000;
writeln('Biaya telphon anda adalah : ',bayar,' rupiah');
end;
4 : begin
bayar:=m3*1200;
writeln('Biaya telphon anda adalah : ',bayar,' rupiah');
end;
end;
end;
Procedure Menghitung_Hari_Dalam_Bulan;
Var
bln,thn,hr,s:integer;
Begin
Writeln('Pilih salah satu bulan untuk mengetahui jumlah hari!');
Writeln('1. Januari');
Writeln('2. Februari');
Writeln('3. Maret');
Writeln('4. April');
Writeln('5. Mei');
Writeln('6. Juni');
Writeln('7. Juli');
Writeln('8. Agustus');
Writeln('9. September');
Writeln('10. Oktober');
Writeln('11. November');
Writeln('12. Desember');
Writeln;
Write('Masukkan bulan ke : ');readln(bln);
Writeln;
Write('Masukkan tahun : ');readln(thn);
Writeln;
Case bln of
1,3,5,7,8,10,12 :
begin
hr:=31;
Writeln('============================');
Writeln('= Bulan ke ',bln,' ada ',hr, ' hari =');
Writeln('============================');
end;
2 :
begin
s:=thn mod 4;
if (s=0) then
begin
hr:=29;
end
else
begin
hr:=28;
end;
Writeln('============================');
Writeln('= Bulan ke ',bln,' ada ',hr, ' hari =');
Writeln('============================');
end;
4,6,9,11 :
begin
hr:=30;
Writeln('============================');
Writeln('= Bulan ke ',bln,' ada ',hr, ' hari =');
Writeln('============================');
end;
end;
end;
Procedure tebak_angka;
var
a,b:integer;
pil:char;
begin
Writeln(' Program Tebak Angka ');
Writeln('=====================');
Writeln('Masukkan angkanya : ');
Clrscr;
repeat
write('Tebaklah angkanya: ');readln(b);
Writeln;
if b
writeln('Lebih KECIL')
else if b>a then
writeln('Lebih BESAR')
else
begin
writeln('CONGRATULATION!!!');
Writeln;
end;
until b=a;
end;
procedure tebak_kata;
var
kt,tkt:string;
a,b,c:integer;
begin
kt:=('unisla');
Writeln;
Writeln(' Program Tebak Kata ');
Writeln('====================');
Writeln;
write('Tebaklah katanya: ');readln(tkt);
writeln;
a:=length(kt);
b:=length(tkt);
If tkt=kt then
begin
Writeln('CONGRATULATION!!!');
end
Else if (tkt<>kt) and (b=a)then
begin
writeln('SALAH.');
end
Else if (tkt<>kt) and (b>a) then
begin
c:=b-a;
Writeln('Kata yang kamu masukkan terlalu panjang ',c,' huruf')
end
else
begin
c:=a-b;
Writeln('Kata yang kamu masukkan terlalu pendek ',c,' huruf');
end;
end;
function pangkat(a,b:integer):integer;
var
i,x:integer;
begin;
x:=1;
for i:=1 to b do
begin
x:=x*a;
end;
pangkat:=x;
end;
Procedure panggil_pangkat;
var
bil,pang:integer;
begin
Writeln(' Program Hitung Perpangkatan Bulat ');
Writeln('===================================');
Writeln;
Write('Masukkan jumlah bilangan yang dipangkat:');readln(bil);
writeln;
Write('Masukkan jumlah pangkat :');readln(pang);
Writeln;
writeln('Nilai dari ',bil,' pangkat ',pang,' adalah: ', pangkat (bil,pang));
writeln;
end;
Procedure rata_rata;
Var x: array [1..100] of integer;
n,i,tot:integer;
rt:real;
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: ');
tot:=0;
For i:= 1 to n do
Begin
Write(x[i],' ');
tot:=tot+x[i];
End;
rt:=tot/n;
Writeln;
Writeln('Nilai Rata-Rata : ',rt:4:2);
End;
Procedure urut_bilangan;
var
angka:array[1..100] of integer;
i,j,k,max,temp:integer;
begin
Write('Masukkan jumlah data : ');readln(i);
for j:= 1 to i do
readln(angka[j]);
for j:=1 to i-1 do
begin
max:=j;
for k:= j+1 to i do
if angka[k] < angka[j] then
max:=k;
temp:=angka[j];
angka[j]:=angka[max];
angka[max]:=temp;
end;
Clrscr;
Writeln('Hasilnya : ');
for j:=1 to i do
Writeln(angka[j])
end;
Procedure Faktorial;
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;
procedure suhu;
var
c,f:integer;
begin
writeln('Celcius Fahrenheit');
for c:=0 to 5 do
begin
if c=4 then
writeln('Maaf tidak bisa dijalankan')
else
writeln(c:4,(c*1.8)+32:12:2);
end;
end;
Procedure Menyusun_Bintang;
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;
Procedure Menyusun_Kali;
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;
Procedure UTS;
var
x:integer;
begin
Writeln(' X X^2 X^3 X^4 ');
Writeln('====================');
for x:=1 to 10 do
begin
if x=5 then
writeln('Mahasiswa TI harus bisa, tapi gag boleh nyontek')
else
writeln(x:3,x*x:7,x*x*x:7,x*x*x*x:7);
end;
end;
procedure pohon_huruf;
var
n : integer;
procedure Bagian_Atas;
var k, y, z : integer;
begin
for k:= 1 to n do
begin
writeln('');
for z:=1 to n-k do
begin
write(' ');
end;
for y:=1 to k do
begin
if y=n then
write(' ')
else
write ('*');
end;
for y:= k-1 downto 1 do
begin
write ('*');
end;
end;
end;
procedure Bagian_Bawah;
var k, y, z : integer;
begin
for k:= n-1 downto 1 do
begin
writeln('');
for z:=1 to n-k do
begin
write(' ');
end;
for y:=1 to k do
begin
write ('*');
end;
for y:= k-1 downto 1 do
begin
write ('*');
end;
end;
end;
var
lagi :char;
Label A,B,C;
begin
A : clrscr;
writeln (' Program Tampil Bintang' );
writeln (' by. MAinstream ');
writeln (' ------------------------------ ');
writeln ('');
write('Masukkan Jumlah n : ');
readln(n);
writeln ('');
writeln ('Hasilnya :');
Bagian_Atas;
Bagian_Bawah;
writeln ('');
writeln ('');
C : writeln ('Inputkan lagi ? (y/t)');
readln(lagi);
case (lagi) of
'y','y' :goto A;
't','t' :goto b;
else
writeln;
writeln ('Pilihan hanya y/t !');
goto c;
readln;
B : end;
clrscr;
End;
Procedure tabel;
var
isi:array[1..30,1..30] of integer;
b,k,bar,kol,h,v,x,y:integer;
begin
clrscr;
write('Masukkan jumlah baris = ');readln(bar);
write('Masukkan jumlah kolom = ');readln(kol);
for b:=1 to bar do
for k:=1 to kol do
begin
write('[',b,',',k,'] = ');read(isi[b,k]);
end;
clrscr;
write('hasil');
for b:= 1 to bar do
begin
H:=0;
for k:=1 to kol do
begin
x:=9*k;
y:=2*b;
gotoxy(x,y);write('_______________');
gotoxy(x,y+1);write(':',isi[b,k]);
h:=h + isi[b,k];
end;
gotoxy(9*(k+1),y);write(':');
gotoxy(9*(k+1),y+1);write(':',h);
end;
for k:=1 to kol do
begin
x:=9*k;
y:=2*(b+1);
v:=0;
for b:= 1 to bar do
v:=v+isi[b,k];
gotoxy(x,y);write('________________');
gotoxy(x,y+1);write('',v);
end;
end;
Procedure menu;
begin
Writeln;
writeln(' Menu pilihan ');
Writeln('================');
writeln('1. LogIn');
Writeln('2. Wartel');
Writeln('3. Menghitung hari dalam bulan');
Writeln('4. Tebak Angka');
Writeln('5. Tebak kata');
Writeln('6. Perpangkatan');
Writeln('7. Rata-rata');
Writeln('8. Urut Bilangan');
Writeln('9. Faktorial');
Writeln('0. Suhu');
Writeln('A. Menyusun bintang');
wRITELN('B. Menyusun kali');
Writeln('C. UTS');
Writeln('D. Bintang bolong tengahnya');
Writeln('E. Perhitungan tabel');
write('Pilihan: ');pil:=readkey;
clrscr;
end;
var
bil,pang:integer;
begin
nama;
repeat
menu;
case pil of
'1': login;
'2': wartel;
'3': menghitung_hari_dalam_bulan;
'4': tebak_angka;
'5': tebak_kata;
'6': panggil_pangkat;
'7': rata_rata;
'8': urut_bilangan;
'9': faktorial;
'0': suhu;
'A': menyusun_bintang;
'B': menyusun_kali;
'C': uts;
'D': pohon_huruf;
'E': tabel;
end;
until (pil='0');
end.
Subscribe to:
Post Comments (Atom)
0 komentar:
Post a Comment