Saturday, July 24, 2010

sourche code campur.exe tugas akhir pemrograman pascal universitas islam lamongan

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.

0 komentar:

Post a Comment