Program tabel_array_2d;
Uses wincrt;
Var
tabel: Array[1..100,1..100] of Integer;
i,j,a,b,c,d,e,f,g: Integer;
Begin
ClrScr;
write('berapa kolom =');read(a);
write('berapa baris =');read(b);
Writeln(' Elemen matrik satu');
For i := 1 to b Do
Begin
For j := 1 to a Do
Begin
Write('Elemen baris -',i,' Kolom -',j,'= ');
Readln(tabel[i,j]);
End;
end;
clrscr;
For i := 1 to b Do
Begin
f:=0;
For j := 1 to a Do
begin
c:=9*j;
d:=2*i;
gotoxy(c,d);write('+========+');
gotoxy(c,d+1);write(': ',tabel[i,j]);
f:=f+tabel[i,j];
end;
gotoxy(9*(j+1),d+1);write(': ',f);
end;
for j:=1 to a do
begin
g:=0;
c:=9*j;
d:=2*(i+1);
for i:=1 to b do
g:=g+tabel[i,j];
gotoxy(c,d);write('+========+');
gotoxy(c,d+1);write(' ',g);
end;
readln;
end.
Monday, June 28, 2010
Pohon Huruf
program pohon_huruf;
uses wincrt;
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. T-plus ');
writeln (' ------------------------------ ');
writeln ('');
write('Masukkan pnjng sisi : ');
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;
writeln ('');
writeln ('Terimakasih... ^_^');
end.
uses wincrt;
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. T-plus ');
writeln (' ------------------------------ ');
writeln ('');
write('Masukkan pnjng sisi : ');
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;
writeln ('');
writeln ('Terimakasih... ^_^');
end.
Quiz
Uses WinCrt;
Type H = Record
hh, mm: Longint;
End;
Var
n, pil: Byte;
again,nama34, alamat34, mail34, id, id2, pass, pass2, e, Lagi, t, u: String;
nim34, no_hp34, tot_m1, tot_m2, tot_m: Longint;
tahun, bulan, y, x, x2, x3, x4, g, i: Integer;
j1, j2:H;
a, b, c, d: Real;
Procedure Tebak (g,i:Integer);
Begin
If g<i Then
Writeln (g,'=Lebih Kecil')
Else If g>i Then
Writeln (g,'=lebih besar')
Else
Writeln (g,'=Selamat Anda benar');
End;
Procedure Tebak2 (t,u:String);
Begin
If t<>u Then
Writeln (t,'= Anda salah')
Else
Writeln (t,'=Selamat Anda benar');
End;
Function Tebak3 (g,i:Integer):Integer;
Var j, k, l : Integer;
begin
k:=1;
For i:=1 to i do
k:=k*g;
Begin
If i=0 Then
Writeln ('Jadi ',g,' pangkat ',i,' =1')
Else If i=1 Then
Writeln ('Jadi ',g,' pangkat ',i,' =',g)
Else If i>1 then
Writeln('Jadi ',g,' pangkat ',i,' =',k);
End;
End;
Begin
again:='y';
Repeat
Begin
Clrscr;
Writeln ('DAFTAR MENU');
Writeln ('1. Program Data Mahasiswa 7. Program Tebak Kata');
Writeln ('2. Program Login 8. Program Tebak Panjang Kata');
Writeln ('3. Program WarTel 9. Program Perpangkatan');
Writeln ('4. Program Jumlah Hari 10. Program Belah Ketupat');
Writeln ('5. Program Soal UTS Semester 2 11. Program Jumlah Baris & Kolom');
Writeln ('6. Program Tebak Angka');
Writeln;
Writeln ('Pilihlah angka 1 sampai 11 dari MENU di atas ');
Write ('Silahkan masukan Pilihan anda ? ');readln(n);
Clrscr;
Case n Of
1: Begin
Write ('Masukkan Nama : '); Readln(nama34);
Write ('Masukkan NIM : '); Readln(nim34);
Write ('Masukkan Alamat : '); Readln(alamat34);
Write ('Masukkan Nomer HP: 085'); Readln(no_hp34);
Write ('Masukkan E-Mail : '); Readln(mail34);
Clrscr;
Writeln ('>>> DATA MAHASISWA <<<');
Writeln (' Nama : ',nama34);
Writeln (' NIM : ',nim34);
Writeln (' Alamat : ',alamat34);
Writeln (' Nomer HP : 085',no_hp34);
Writeln (' E-Mail : ',mail34);
End;
2: Begin
Write ('User Name: '); Readln(id);
Write ('Password : '); Readln(pass);
Clrscr;
Repeat
Begin
Write ('Masukkan User Name: '); Readln(id2);
Write ('Masukkan Password : '); Readln(pass2);
Writeln;
Begin
If (id=id2) and (pass=pass2) Then
Writeln ('Selamat Anda Masuk')
Else
If (id=id2) and (pass<>pass2) Then
Writeln ('Maaf Password anda salah ')
Else
Writeln ('Anda Belum Terdaftar');
End;
Writeln;
End;
Until (id=id2) and (pass=pass2);
End;
3: Begin
Writeln('Rincian Percakapan');
Write ('Jam mulai = '); read (J1.hh);
Write ('Menit mulai= '); read (J1.mm);
Write ('Jam berakhir= '); read (J2.hh);
Write ('Menit berakhir= '); read (J2.mm);
tot_m1 := (J1.hh*60) + J1.mm;
tot_m2 := (J2.hh*60) + J2.mm;
tot_m:=tot_m2 - tot_m1;
Clrscr;
Writeln ('Silahkan Pilih Kota Tujuan Anda');
Writeln ('1. Lamongan Tarif Rp.100/menit');
Writeln ('2. Surabaya Tarif Rp.500/menit');
Writeln ('3. Bandung Tarif Rp.1000/menit');
Writeln ('4. Jakarta Tarif Rp.1500/menit');
Writeln;
Write('Silahkan Pilih Kota Tujuan anda [1/2/3/4] ? ');readln(pil);
Clrscr;
Case pil Of
1: begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Lamongan');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*100;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
2: Begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Surabaya');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*500;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
3: Begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Bandung');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*1000;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
4: Begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Jakarta');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*1500;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
End;
End;
4: Begin
Write (' Masukan Tahun='); readln(Tahun);
Write (' Masukan Bulan='); readln(Bulan);
Clrscr;
If (Bulan=1) Or (Bulan=3) Or (Bulan=5) Or (Bulan=7) Or (Bulan=8) Or (Bulan=10) Or (Bulan=12) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 31 hari')
Else
If (Bulan=4) Or (Bulan=6) Or (Bulan=9) Or (Bulan=11) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 30 hari')
Else
If (Bulan=2) And (Tahun Mod 4= 0) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 29 hari')
Else
If (Bulan=2) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 28 hari');
End;
5: Begin
Lagi:='y';
While (Lagi='y') Or (Lagi='Y') Do
Begin
Write ('Masukan nilai n?'); Readln (y);
Clrscr;
Writeln ('Tebel perpangkatan nilai x sebagai berikut:');
Writeln ('x':1, 'x^2':6, 'x^3':11, 'x^4':14);
Writeln ('------------------------------------');
Begin
For x:=1 To y Do
Begin
x2:=x*x;
x3:=x*x*x;
x4:=x*x*x*x;
If x=5 Then
Writeln ('Mahasiswa UNISLA Harus bisa, Tapi Inget g pake contoh :-)')
Else
Writeln (x:1, x2:6, x3:11, x4:16);
End;
Writeln ('------------------------------------');
Write ('Coba lagi (Tekan y untuk ulang)'); Readln (Lagi);
Writeln;
End;
End;
End;
6: Begin
Write ('Nilai =');readln(i);
While (g<>i) do
Begin
Write ('Masukan angka='); readln (g);
Tebak(g,i);
Writeln;
End;
End;
7: Begin
Write ('kata =');readln(u);
While (t<>u) do
Begin
Write ('Masukan kata='); readln (t);
Tebak2 (t,u);
Writeln;
End;
End;
8: Begin
Write ('Masukan kata='); readln(u);
i:=length(u);
While (g<>i) do
Begin
Write ('Berapa panjang kata='); readln(g);
Tebak(g,i);
Writeln;
End;
End;
9: Begin
Write('Angka = '); readln(g);
Write('Pangkat = '); readln(i);
Tebak3(g,i);
End;
End;
Writeln;
Write ('Tekan y untuk mengulang program= '); readln(again);
End;
Until not ((again='y') Or (again='Y'));
Write('Anda Keluar dari Program');
End.
Type H = Record
hh, mm: Longint;
End;
Var
n, pil: Byte;
again,nama34, alamat34, mail34, id, id2, pass, pass2, e, Lagi, t, u: String;
nim34, no_hp34, tot_m1, tot_m2, tot_m: Longint;
tahun, bulan, y, x, x2, x3, x4, g, i: Integer;
j1, j2:H;
a, b, c, d: Real;
Procedure Tebak (g,i:Integer);
Begin
If g<i Then
Writeln (g,'=Lebih Kecil')
Else If g>i Then
Writeln (g,'=lebih besar')
Else
Writeln (g,'=Selamat Anda benar');
End;
Procedure Tebak2 (t,u:String);
Begin
If t<>u Then
Writeln (t,'= Anda salah')
Else
Writeln (t,'=Selamat Anda benar');
End;
Function Tebak3 (g,i:Integer):Integer;
Var j, k, l : Integer;
begin
k:=1;
For i:=1 to i do
k:=k*g;
Begin
If i=0 Then
Writeln ('Jadi ',g,' pangkat ',i,' =1')
Else If i=1 Then
Writeln ('Jadi ',g,' pangkat ',i,' =',g)
Else If i>1 then
Writeln('Jadi ',g,' pangkat ',i,' =',k);
End;
End;
Begin
again:='y';
Repeat
Begin
Clrscr;
Writeln ('DAFTAR MENU');
Writeln ('1. Program Data Mahasiswa 7. Program Tebak Kata');
Writeln ('2. Program Login 8. Program Tebak Panjang Kata');
Writeln ('3. Program WarTel 9. Program Perpangkatan');
Writeln ('4. Program Jumlah Hari 10. Program Belah Ketupat');
Writeln ('5. Program Soal UTS Semester 2 11. Program Jumlah Baris & Kolom');
Writeln ('6. Program Tebak Angka');
Writeln;
Writeln ('Pilihlah angka 1 sampai 11 dari MENU di atas ');
Write ('Silahkan masukan Pilihan anda ? ');readln(n);
Clrscr;
Case n Of
1: Begin
Write ('Masukkan Nama : '); Readln(nama34);
Write ('Masukkan NIM : '); Readln(nim34);
Write ('Masukkan Alamat : '); Readln(alamat34);
Write ('Masukkan Nomer HP: 085'); Readln(no_hp34);
Write ('Masukkan E-Mail : '); Readln(mail34);
Clrscr;
Writeln ('>>> DATA MAHASISWA <<<');
Writeln (' Nama : ',nama34);
Writeln (' NIM : ',nim34);
Writeln (' Alamat : ',alamat34);
Writeln (' Nomer HP : 085',no_hp34);
Writeln (' E-Mail : ',mail34);
End;
2: Begin
Write ('User Name: '); Readln(id);
Write ('Password : '); Readln(pass);
Clrscr;
Repeat
Begin
Write ('Masukkan User Name: '); Readln(id2);
Write ('Masukkan Password : '); Readln(pass2);
Writeln;
Begin
If (id=id2) and (pass=pass2) Then
Writeln ('Selamat Anda Masuk')
Else
If (id=id2) and (pass<>pass2) Then
Writeln ('Maaf Password anda salah ')
Else
Writeln ('Anda Belum Terdaftar');
End;
Writeln;
End;
Until (id=id2) and (pass=pass2);
End;
3: Begin
Writeln('Rincian Percakapan');
Write ('Jam mulai = '); read (J1.hh);
Write ('Menit mulai= '); read (J1.mm);
Write ('Jam berakhir= '); read (J2.hh);
Write ('Menit berakhir= '); read (J2.mm);
tot_m1 := (J1.hh*60) + J1.mm;
tot_m2 := (J2.hh*60) + J2.mm;
tot_m:=tot_m2 - tot_m1;
Clrscr;
Writeln ('Silahkan Pilih Kota Tujuan Anda');
Writeln ('1. Lamongan Tarif Rp.100/menit');
Writeln ('2. Surabaya Tarif Rp.500/menit');
Writeln ('3. Bandung Tarif Rp.1000/menit');
Writeln ('4. Jakarta Tarif Rp.1500/menit');
Writeln;
Write('Silahkan Pilih Kota Tujuan anda [1/2/3/4] ? ');readln(pil);
Clrscr;
Case pil Of
1: begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Lamongan');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*100;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
2: Begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Surabaya');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*500;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
3: Begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Bandung');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*1000;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
4: Begin
c:=(b-a);
Writeln ('Lama pembicaraan = ',tot_m,' menit');
e:=('Jakarta');
Writeln ('Kota Tujuan = ',e);
d:=tot_m*1500;
Writeln ('Biaya Yang Harus Anda Bayar adalah = Rp. ',d:0:0);
End;
End;
End;
4: Begin
Write (' Masukan Tahun='); readln(Tahun);
Write (' Masukan Bulan='); readln(Bulan);
Clrscr;
If (Bulan=1) Or (Bulan=3) Or (Bulan=5) Or (Bulan=7) Or (Bulan=8) Or (Bulan=10) Or (Bulan=12) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 31 hari')
Else
If (Bulan=4) Or (Bulan=6) Or (Bulan=9) Or (Bulan=11) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 30 hari')
Else
If (Bulan=2) And (Tahun Mod 4= 0) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 29 hari')
Else
If (Bulan=2) Then
Writeln ('Pada tahun ',tahun,' bulan ',bulan,' ada 28 hari');
End;
5: Begin
Lagi:='y';
While (Lagi='y') Or (Lagi='Y') Do
Begin
Write ('Masukan nilai n?'); Readln (y);
Clrscr;
Writeln ('Tebel perpangkatan nilai x sebagai berikut:');
Writeln ('x':1, 'x^2':6, 'x^3':11, 'x^4':14);
Writeln ('------------------------------------');
Begin
For x:=1 To y Do
Begin
x2:=x*x;
x3:=x*x*x;
x4:=x*x*x*x;
If x=5 Then
Writeln ('Mahasiswa UNISLA Harus bisa, Tapi Inget g pake contoh :-)')
Else
Writeln (x:1, x2:6, x3:11, x4:16);
End;
Writeln ('------------------------------------');
Write ('Coba lagi (Tekan y untuk ulang)'); Readln (Lagi);
Writeln;
End;
End;
End;
6: Begin
Write ('Nilai =');readln(i);
While (g<>i) do
Begin
Write ('Masukan angka='); readln (g);
Tebak(g,i);
Writeln;
End;
End;
7: Begin
Write ('kata =');readln(u);
While (t<>u) do
Begin
Write ('Masukan kata='); readln (t);
Tebak2 (t,u);
Writeln;
End;
End;
8: Begin
Write ('Masukan kata='); readln(u);
i:=length(u);
While (g<>i) do
Begin
Write ('Berapa panjang kata='); readln(g);
Tebak(g,i);
Writeln;
End;
End;
9: Begin
Write('Angka = '); readln(g);
Write('Pangkat = '); readln(i);
Tebak3(g,i);
End;
End;
Writeln;
Write ('Tekan y untuk mengulang program= '); readln(again);
End;
Until not ((again='y') Or (again='Y'));
Write('Anda Keluar dari Program');
End.
Saturday, June 26, 2010
Tampilan Data Mahasiswa
program tampilan_data_mahasiswa;
uses wincrt;
var
nama123,alamat,ttl,email,status,hobi,citacita,nohp:string;
nim,tinggi:longint;
begin
writeIn;write('masukkan nama anda');readIn(nama123);
write('masukkan alamat anda');readIn(alamat);
write('masukkan ttl anda');readIn(ttl);
write('masukkan email anda');readIn(email);
write('masukkan status anda');readIn(status);
write('masukkan hobi anda');readIn(hobi);
write('masukkan citacita anda');readIn(citacita);
write('masukkan nim anda');readIn(nim);
write('masukkan nohp anda');readIn(nohp);
write('masukkan tinggi anda');readIn(tinggi);
clrscr;
write('hasil yang ditampilkan');readIn;
write('nama saya adalah',nama123);readIn;
write('alamat saya adalah',alamat);readIn;
write('ttl saya adalah',ttl);readIn;
write('email saya adalah',email);readIn;
write('status saya adalah',status);readIn;
write('hobi saya adalah',hobi);readIn;
write('cita-cita saya adalah',cita-cita);readIn;
write('nim saya adalah',nim);readIn;
write('nohp saya adalah',nohp);readIn;
write('tinggi saya adalah',tinggi);readIn;
end.
uses wincrt;
var
nama123,alamat,ttl,email,status,hobi,citacita,nohp:string;
nim,tinggi:longint;
begin
writeIn;write('masukkan nama anda');readIn(nama123);
write('masukkan alamat anda');readIn(alamat);
write('masukkan ttl anda');readIn(ttl);
write('masukkan email anda');readIn(email);
write('masukkan status anda');readIn(status);
write('masukkan hobi anda');readIn(hobi);
write('masukkan citacita anda');readIn(citacita);
write('masukkan nim anda');readIn(nim);
write('masukkan nohp anda');readIn(nohp);
write('masukkan tinggi anda');readIn(tinggi);
clrscr;
write('hasil yang ditampilkan');readIn;
write('nama saya adalah',nama123);readIn;
write('alamat saya adalah',alamat);readIn;
write('ttl saya adalah',ttl);readIn;
write('email saya adalah',email);readIn;
write('status saya adalah',status);readIn;
write('hobi saya adalah',hobi);readIn;
write('cita-cita saya adalah',cita-cita);readIn;
write('nim saya adalah',nim);readIn;
write('nohp saya adalah',nohp);readIn;
write('tinggi saya adalah',tinggi);readIn;
end.
Baca dan Cetak Matriks
program baca_dan_cetak_matriks;
uses wincrt;
var
i,j,baris,kolom:integer;
x:array [1..10,1..10] of integer;
begin
clrscr;
write ('banyak baris (maks = 10) : ');
readln (baris);
write ('banyak kolom (maks = 10) : ');
readln (kolom);
writeln;
for i:= 1 to baris do
begin
for j:= 1 to kolom do
begin
write ('elemen(',i,',',j,') : ');
readln (x[i,j]);
end;
writeln;
end;
writeln;
writeln ('matriks : ');writeln;
for i:= 1 to baris do
begin
for j:= 1 to kolom do
write (x[i,j]:8);
writeln;
end;
readln;
end.
uses wincrt;
var
i,j,baris,kolom:integer;
x:array [1..10,1..10] of integer;
begin
clrscr;
write ('banyak baris (maks = 10) : ');
readln (baris);
write ('banyak kolom (maks = 10) : ');
readln (kolom);
writeln;
for i:= 1 to baris do
begin
for j:= 1 to kolom do
begin
write ('elemen(',i,',',j,') : ');
readln (x[i,j]);
end;
writeln;
end;
writeln;
writeln ('matriks : ');writeln;
for i:= 1 to baris do
begin
for j:= 1 to kolom do
write (x[i,j]:8);
writeln;
end;
readln;
end.
Perkalian
program perkalian;
uses wincrt;
var
x,y,yx:integer;
begin
clrscr;
write('masukkan x : ');readln(x);
for y:= 1 to 10 do
xy:=x*y;
writeln(x:2,y:5,yx:6);
end.
uses wincrt;
var
x,y,yx:integer;
begin
clrscr;
write('masukkan x : ');readln(x);
for y:= 1 to 10 do
xy:=x*y;
writeln(x:2,y:5,yx:6);
end.
Angka(2)
program angka;
uses wincrt;
var
i,n,j:integer;
begin
clrscr;
write('masukkan angka : ');readln(n);
j:=0;
for i:= 1 to n do
begin
writeln(i*3);
j:=j+i*3;
end;
writeln('hasil',n,'adalah',j);
end.
uses wincrt;
var
i,n,j:integer;
begin
clrscr;
write('masukkan angka : ');readln(n);
j:=0;
for i:= 1 to n do
begin
writeln(i*3);
j:=j+i*3;
end;
writeln('hasil',n,'adalah',j);
end.
Angka(1)
program angka;
uses wincrt;
var
i,n,j:integer;
begin
clrscr;
writeln('masukkan angka : ');readln(n);
j:=0;
for i:=0 to n do
begin
writeln(i);
j:=j+i;
end;
writeln('hsl',n,'adalah',j);
end.
uses wincrt;
var
i,n,j:integer;
begin
clrscr;
writeln('masukkan angka : ');readln(n);
j:=0;
for i:=0 to n do
begin
writeln(i);
j:=j+i;
end;
writeln('hsl',n,'adalah',j);
end.
Biaya Telpon
program biaya_telpon;
uses wincrt;
var
j1,j2,m1,m2,tj,tm,tsj,b:real;
tujuan,lamongan,surabaya,bandung,jakarta:string;
begin
clrscr;
gotoxy (30,8);writeln('Program biaya telpon');writeln;
write('Tujuan telpon : ');readln(tujuan);writeln;
write('Jam awal telpon : ');readln(j1);
write('Jam akhir telpon : ');readln(j2);
write('Menit awal telpon : ');readln(m1);
write('Menit akhir telpon : ');readln(m2);
if(j2=j1)then tm:=m2-m1
else if(j2>j1)then tj:=j2-j1;
tm:=tj*60;
tsj:=tm+m2-m1;
readln;
if(tujuan='lamongan')then b:=tsj*100
else if(tujuan='surabaya')then b:=tsj*500
else if(tujuan='bandung')then b:=tsj*1000
else if(tujuan='jakarta')then b:=tsj*1200;
writeln('lama pembicaraan : ',tsj:2:0,'menit');
writeln('tujuan telpon : ',tujuan);
writeln('biaya yang harus dibayar adalah : ' ,b:2:0, 'rupiah');
readln;
end.
uses wincrt;
var
j1,j2,m1,m2,tj,tm,tsj,b:real;
tujuan,lamongan,surabaya,bandung,jakarta:string;
begin
clrscr;
gotoxy (30,8);writeln('Program biaya telpon');writeln;
write('Tujuan telpon : ');readln(tujuan);writeln;
write('Jam awal telpon : ');readln(j1);
write('Jam akhir telpon : ');readln(j2);
write('Menit awal telpon : ');readln(m1);
write('Menit akhir telpon : ');readln(m2);
if(j2=j1)then tm:=m2-m1
else if(j2>j1)then tj:=j2-j1;
tm:=tj*60;
tsj:=tm+m2-m1;
readln;
if(tujuan='lamongan')then b:=tsj*100
else if(tujuan='surabaya')then b:=tsj*500
else if(tujuan='bandung')then b:=tsj*1000
else if(tujuan='jakarta')then b:=tsj*1200;
writeln('lama pembicaraan : ',tsj:2:0,'menit');
writeln('tujuan telpon : ',tujuan);
writeln('biaya yang harus dibayar adalah : ' ,b:2:0, 'rupiah');
readln;
end.
Pertukaran Tempat Zat
program pertukaran_tempat_zat;
uses wincrt;
var
a,b,c,d,e:string;
air,solar,gas,bensin:integer;
begin
write('isi tabung sebelum ditukar tempat');readln;
a:='air';
b:='solar';
c:='gas';
d:='bensin';
write('tabung A berisi');readln(a);
write('tabung B berisi');readln(b);
write('tabung C berisi');readln(c);
write('tabung D berisi');readln(d);
write('isi tabungsesudah ditukar tempat');readln;
E:=A;
A:=B;
B:=D;
D:=C;
C:=E;
writeln('jadi tabung A berisi',A);
writeln('jadi tabung B berisi',B);
writeln('jadi tabung C berisi',C);
writeln('jadi tabung D berisi',D);
end.
uses wincrt;
var
a,b,c,d,e:string;
air,solar,gas,bensin:integer;
begin
write('isi tabung sebelum ditukar tempat');readln;
a:='air';
b:='solar';
c:='gas';
d:='bensin';
write('tabung A berisi');readln(a);
write('tabung B berisi');readln(b);
write('tabung C berisi');readln(c);
write('tabung D berisi');readln(d);
write('isi tabungsesudah ditukar tempat');readln;
E:=A;
A:=B;
B:=D;
D:=C;
C:=E;
writeln('jadi tabung A berisi',A);
writeln('jadi tabung B berisi',B);
writeln('jadi tabung C berisi',C);
writeln('jadi tabung D berisi',D);
end.
Jumlah Hari Dalam Bulan
program jumlah_hari_dalam_bulan;
uses wincrt;
var
th,bln,hr,a:integer;
Begin
writeIn;
gotoxy(24,8);writeln('MENENTUKAN JUMLAH HARI DALAM BULAN');
writeln;
write('Masukkan tahun: ');readln(th);
write('Masukkan bulan: ');readln(bln);
clrscr;
case bln of
1:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Januari: 31 hari')
end;
2:begin
clrscr;
a:=th mod 4;
if (a>0) or (a<=1) then hr:=28;
if a=0 then hr:=29;
writeln('Tahun : ',th);
writeln('Jumlah hari pada bulan Februari: ',hr,' hari');
end;
3:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Maret: 31 hari');
end;
4:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan April: 30 hari');
end;
5:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Mei: 31 hari');
end;
6:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Juni: 30 hari');
end;
7:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Juli: 31 hari');
end;
8:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Agustus: 31 hari');
end;
9:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan September: 30 hari');
end;
10:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Oktober: 31 hari');
end;
11:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Nopember: 30 hari');
end;
12:begin
clrscr;
writeln('Tahun:',th);
writeln('Jumlah hari pada bulan Desember: 31 hari');
end;
13:end
End.
uses wincrt;
var
th,bln,hr,a:integer;
Begin
writeIn;
gotoxy(24,8);writeln('MENENTUKAN JUMLAH HARI DALAM BULAN');
writeln;
write('Masukkan tahun: ');readln(th);
write('Masukkan bulan: ');readln(bln);
clrscr;
case bln of
1:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Januari: 31 hari')
end;
2:begin
clrscr;
a:=th mod 4;
if (a>0) or (a<=1) then hr:=28;
if a=0 then hr:=29;
writeln('Tahun : ',th);
writeln('Jumlah hari pada bulan Februari: ',hr,' hari');
end;
3:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Maret: 31 hari');
end;
4:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan April: 30 hari');
end;
5:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Mei: 31 hari');
end;
6:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Juni: 30 hari');
end;
7:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Juli: 31 hari');
end;
8:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Agustus: 31 hari');
end;
9:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan September: 30 hari');
end;
10:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Oktober: 31 hari');
end;
11:begin
clrscr;
writeln('Tahun: ',th);
writeln('Jumlah hari pada bulan Nopember: 30 hari');
end;
12:begin
clrscr;
writeln('Tahun:',th);
writeln('Jumlah hari pada bulan Desember: 31 hari');
end;
13:end
End.
Login
program login;
uses wincrt;
var
na,pa,nb,pb:string;
ul:char;
begin
writeIn;
gotoxy (35,8);writeln('Registration');
write('Masukkan nama : ');readln(na);
write('Masukkan password : ');readln(pa);
clrscr;
writeln('*****************************************');
writeln('* Selamat bergabung dengan kami *');
writeln('* Selalu ingat nama dan password anda ! *');
writeln('*****************************************');
writeln;
writeln('***********************************');
writeln('* Ingin langsung login ? *');
writeln('***********************************');
writeln;
write('Nama anda :');readln(nb);
write('Password anda :');readln(pb);
if(nb=na)and(pb=pa)then
begin
writeln('************************************');
writeln('* Welcome !! Selamat datang !! *');
writeln('************************************');
end
else if(nb=na)and(pb<>pa)then
begin
writeln('***********************************************');
writeln('* Maaf, password yang anda masukkan salah *');
writeln('***********************************************');
end
else if(nb<>na)and(pb=pa)then
begin
writeln('******************************************');
writeln('* Nama atau password anda salah *');
writeln('******************************************');
end
else
begin
writeln('" Error "');
end;
end.
uses wincrt;
var
na,pa,nb,pb:string;
ul:char;
begin
writeIn;
gotoxy (35,8);writeln('Registration');
write('Masukkan nama : ');readln(na);
write('Masukkan password : ');readln(pa);
clrscr;
writeln('*****************************************');
writeln('* Selamat bergabung dengan kami *');
writeln('* Selalu ingat nama dan password anda ! *');
writeln('*****************************************');
writeln;
writeln('***********************************');
writeln('* Ingin langsung login ? *');
writeln('***********************************');
writeln;
write('Nama anda :');readln(nb);
write('Password anda :');readln(pb);
if(nb=na)and(pb=pa)then
begin
writeln('************************************');
writeln('* Welcome !! Selamat datang !! *');
writeln('************************************');
end
else if(nb=na)and(pb<>pa)then
begin
writeln('***********************************************');
writeln('* Maaf, password yang anda masukkan salah *');
writeln('***********************************************');
end
else if(nb<>na)and(pb=pa)then
begin
writeln('******************************************');
writeln('* Nama atau password anda salah *');
writeln('******************************************');
end
else
begin
writeln('" Error "');
end;
end.
Bintang-Bintang
Program bintang_bintang;
Uses Wincrt;
Var
n, i, j : integer;
Begin
Clrscr;
Writeln;
Write (‘ Masukkan jumlah bintang : ‘ ); Readln (n);
For i:= 1 To n Do
Begin
For j:= 1 To I Do
Write ( ‘*’ );
Readln;
End;
End.
Uses Wincrt;
Var
n, i, j : integer;
Begin
Clrscr;
Writeln;
Write (‘ Masukkan jumlah bintang : ‘ ); Readln (n);
For i:= 1 To n Do
Begin
For j:= 1 To I Do
Write ( ‘*’ );
Readln;
End;
End.
Perpangkatan
Program perpangkatan;
Uses wincrt;
Var
A,B,C,D,P:integer;
Begin
Clrscr;
Writeln;
Write ('bilangan yang di gunakan sebagai pangkat : '); readln (P);
For a:= 1 To P Do
Begin
A:= a;
B:= a*a;
C:= a*a*a;
D:= a*a*a*a;
End;
writeln;
Writeln ('Nilai 1 pangkat ',P,' adalah : ',A);
Writeln ('Nilai 2 pangkat ',P,' adalah : ',B);
Writeln ('Nilai 3 pangkat ',P,' adalah : ',C);
Writeln ('Nilai 4 pangkat ',P,' adalah : ',D);
Readln;
End.
Uses wincrt;
Var
A,B,C,D,P:integer;
Begin
Clrscr;
Writeln;
Write ('bilangan yang di gunakan sebagai pangkat : '); readln (P);
For a:= 1 To P Do
Begin
A:= a;
B:= a*a;
C:= a*a*a;
D:= a*a*a*a;
End;
writeln;
Writeln ('Nilai 1 pangkat ',P,' adalah : ',A);
Writeln ('Nilai 2 pangkat ',P,' adalah : ',B);
Writeln ('Nilai 3 pangkat ',P,' adalah : ',C);
Writeln ('Nilai 4 pangkat ',P,' adalah : ',D);
Readln;
End.
Angka Ke Bulan
Program angka_ke_bulan;
uses wincrt;
var
A:integer;
Begin
Writeln;
Write (‘masukkan angka bulan : ‘);readln(A);
Case A of
1 : writeln (‘Bulan Januari’);
2 : writeln (‘Bulan Februari’);
3 : writeln (‘Bulan Maret’);
4 : writeln (‘Bulan April’);
5 : writeln (‘Bulan Mei’);
6 : writeln (‘Bulan Juni’);
7 : writeln (‘Bulan Juli’);
8 : writeln (‘Bulan Agustus’);
9 : writeln (‘Bulan September’);
10 : writeln (‘Bulan Oktober’);
11 : writeln (‘Bulan Nopember’);
12 : writeln (‘Bulan Desember’);
Else
End;
End.
uses wincrt;
var
A:integer;
Begin
Writeln;
Write (‘masukkan angka bulan : ‘);readln(A);
Case A of
1 : writeln (‘Bulan Januari’);
2 : writeln (‘Bulan Februari’);
3 : writeln (‘Bulan Maret’);
4 : writeln (‘Bulan April’);
5 : writeln (‘Bulan Mei’);
6 : writeln (‘Bulan Juni’);
7 : writeln (‘Bulan Juli’);
8 : writeln (‘Bulan Agustus’);
9 : writeln (‘Bulan September’);
10 : writeln (‘Bulan Oktober’);
11 : writeln (‘Bulan Nopember’);
12 : writeln (‘Bulan Desember’);
Else
End;
End.
Angka Ke Huruf
Program angka_ke_huruf;
uses wincrt;
var
nilai:integer;
begin
clrscr;
write (masukkan nilai : ‘);readln(nilai);
if (nilai >= 85) and (nilai<= 100) then
write (‘nilai anda A’)
else if (nilai >= 75) and (nilai<= 84) then
write (‘nilai anda B’);
else if (nilai >= 65) and (nilai <= 74) then
write (‘nilai anda C’)
else if (nilai >= 50) and (nilai <= 64) then
write (‘nilai anda D’)
else if (nilai >= 0) and (nilai <= 49) then
write (‘nilai anda E’)
else
write (‘Maaf nilai yang anda masukkan harus diantara 0-100’)
readln;
end.
uses wincrt;
var
nilai:integer;
begin
clrscr;
write (masukkan nilai : ‘);readln(nilai);
if (nilai >= 85) and (nilai<= 100) then
write (‘nilai anda A’)
else if (nilai >= 75) and (nilai<= 84) then
write (‘nilai anda B’);
else if (nilai >= 65) and (nilai <= 74) then
write (‘nilai anda C’)
else if (nilai >= 50) and (nilai <= 64) then
write (‘nilai anda D’)
else if (nilai >= 0) and (nilai <= 49) then
write (‘nilai anda E’)
else
write (‘Maaf nilai yang anda masukkan harus diantara 0-100’)
readln;
end.
Luas Segitiga
Program luas_segitiga;
Uses Crt;
Var
Alas,tinggi,luas:real;
Begin
Clrscr;
writeIn;
Write(‘masukkan alas ? ’);readln(alas);
Write(‘masukkan tinggi ? ’);readln(tinggi);
Luas:=0.5*(alas*tinggi);
Writeln(‘luas segitiga adalah’,luas:2:0,’cm’);
Readln;
End.
Uses Crt;
Var
Alas,tinggi,luas:real;
Begin
Clrscr;
writeIn;
Write(‘masukkan alas ? ’);readln(alas);
Write(‘masukkan tinggi ? ’);readln(tinggi);
Luas:=0.5*(alas*tinggi);
Writeln(‘luas segitiga adalah’,luas:2:0,’cm’);
Readln;
End.
Luas Lingkaran
Program luas_lingkaran;
Uses Crt;
Var
Jari,luas:real;
Const pi=3.14;
Begin
Clrscr;
Gotoxy (20,2);writeln (‘*** Nur Rohma Fadila ***’);
Write(‘masukkan jari ?’);readln(jari);
Luas:=pi*(jari*jari);
Writeln(‘luas lingkaran adalah’,luas,’cm’);
Readln;
End.
Uses Crt;
Var
Jari,luas:real;
Const pi=3.14;
Begin
Clrscr;
Gotoxy (20,2);writeln (‘*** Nur Rohma Fadila ***’);
Write(‘masukkan jari ?’);readln(jari);
Luas:=pi*(jari*jari);
Writeln(‘luas lingkaran adalah’,luas,’cm’);
Readln;
End.
Luas Persegi Panjang
Program luas_persegi_panjang;
Uses Crt;
Var
Panjang,lebar,luas:integer;
Begin
Clrscr;
Write(‘masukkan panjang ?’);readln(panjang);
Write(‘masukkan lebar ?’);readln(lebar);
Luas:=panjang*lebar;
Writeln(‘luas persegi panjang adalah’,luas,’cm’);
Readln;
End.
Uses Crt;
Var
Panjang,lebar,luas:integer;
Begin
Clrscr;
Write(‘masukkan panjang ?’);readln(panjang);
Write(‘masukkan lebar ?’);readln(lebar);
Luas:=panjang*lebar;
Writeln(‘luas persegi panjang adalah’,luas,’cm’);
Readln;
End.
Program Jarak
program jarak;
uses wincrt;
var x,y:real;
procedure masukan_data;
begin
writeln;
write('Masukkan bilangan dalam kilometer : ');
readln(x);
end;
procedure hitung_jarak;
begin
y:=x*1000
end;
procedure tampilan_hasil;
begin
writeln('Maka bilangan tersebut dalam meter adalah : ',y:2:0);
end;
begin
masukan_data;
hitung_jarak;
tampilan_hasil;
end.
uses wincrt;
var x,y:real;
procedure masukan_data;
begin
writeln;
write('Masukkan bilangan dalam kilometer : ');
readln(x);
end;
procedure hitung_jarak;
begin
y:=x*1000
end;
procedure tampilan_hasil;
begin
writeln('Maka bilangan tersebut dalam meter adalah : ',y:2:0);
end;
begin
masukan_data;
hitung_jarak;
tampilan_hasil;
end.
Kalkulator Sederhana
program Kalkulator_Sederhana;
uses wincrt;
var
operator: char;
angka_1,angka_2,hasil:real;
procedure PERKALIAN;
begin
hasil:=angka_1*angka_2
end;
procedure PEMBAGIAN;
begin
hasil:=angka_1/angka_2
end;
procedure PENJUMLAHAN;
begin
hasil:=angka_1+angka_2
end;
procedure PENGURANGAN;
begin
hasil:=angka_1-angka_2
end;
procedure MASUKAN;
begin
writeIn;
write('Masukkan angka_1 : ');readln(angka_1);
write('Masukkan operator (*,/,+,-) : ');readln(operator);
write('Masukkan angka_1 : ');readln(angka_2);writeln;
end;
begin
MASUKAN;
case operator of
'*': PERKALIAN;
'/': PEMBAGIAN;
'+': PENJUMLAHAN;
'-': PENGURANGAN;
end;
writeln('Maka hasilnya adalah : ',hasil:2:2);
begin
end;
end.
uses wincrt;
var
operator: char;
angka_1,angka_2,hasil:real;
procedure PERKALIAN;
begin
hasil:=angka_1*angka_2
end;
procedure PEMBAGIAN;
begin
hasil:=angka_1/angka_2
end;
procedure PENJUMLAHAN;
begin
hasil:=angka_1+angka_2
end;
procedure PENGURANGAN;
begin
hasil:=angka_1-angka_2
end;
procedure MASUKAN;
begin
writeIn;
write('Masukkan angka_1 : ');readln(angka_1);
write('Masukkan operator (*,/,+,-) : ');readln(operator);
write('Masukkan angka_1 : ');readln(angka_2);writeln;
end;
begin
MASUKAN;
case operator of
'*': PERKALIAN;
'/': PEMBAGIAN;
'+': PENJUMLAHAN;
'-': PENGURANGAN;
end;
writeln('Maka hasilnya adalah : ',hasil:2:2);
begin
end;
end.
