Cute Bow Tie Hearts Blinking Blue and Pink Pointer

This is default featured slide 1 title

Go to Blogger edit html and find these sentences.Now replace these sentences with your own descriptions.

This is default featured slide 2 title

Go to Blogger edit html and find these sentences.Now replace these sentences with your own descriptions.

This is default featured slide 3 title

Go to Blogger edit html and find these sentences.Now replace these sentences with your own descriptions.

This is default featured slide 4 title

Go to Blogger edit html and find these sentences.Now replace these sentences with your own descriptions.

This is default featured slide 5 title

Go to Blogger edit html and find these sentences.Now replace these sentences with your own descriptions.

Senin, 31 Oktober 2011

Program Record

Program hitung_kata;
uses wincrt;
var
kalimat : string;
s : integer;
begin
write(' Tuliskan Kalimat Anda : '); readln(kalimat);
s := length(kalimat);
writeln(' Jumlah Katanya Adalah ',s);
end.

Program Record


program permainan_huruf;
uses wincrt;
type
az = 'a'..'z';
kalimat = array[az] of byte;
var
huruf : char;
kata : string;
besar : az;
pernyataan : kalimat;
i : byte;

begin
clrscr;
for besar := 'a' to 'z' do
pernyataan[besar] := 0;
write(' tulis kalimat'); readln(kata);
for i :=1 to length(kata) do

begin
huruf := kata[i];
if( huruf>= 'a') and (huruf <='z')
then inc(pernyataan[huruf]);
end;

for besar := 'a' to 'z' do
if pernyataan [besar] <>0 then
writeln(' Jumlah Huruf', '':5,besar,'=':2, pernyataan[besar]);
repeat until keypressed;
end.

Program Record

program Permainan_huruf;
uses wincrt;
var
nama : string;
i : byte;
begin
clrscr;
write(' tulis nama anda dengan baik!'); readln(nama);
if (length(nama) >= 2 ) and ( length(nama) <4 ) then
writeln(' anda orangnya Royal');
if (length(nama) >= 4 ) and ( length(nama) <8 ) then
writeln(' anda orangnya praktis');
if (length(nama) >= 8 ) and ( length(nama) <20 ) then
writeln(' anda orangnya pelit');
repeat until keypressed;
end.

Selasa, 25 Oktober 2011

Program Kondisi

Program Latihan_psedocode;
uses wincrt;
var
i :integer;
begin
i:=0;
while i < 100 do
begin
writeln(i);
i:=i+1;
end;
end.

Program Kondisi

program repeatuntil;
uses wincrt;
var
i : integer;


begin

 i:=1;
 repeat
  writeln(' Ini yang ke', i,'. Aku bangga jadi Mahasiswa Fisika.');
  i:=i+1;
  until i>100;

end.

Program Kondisi

program fortodo;
uses wincrt;
var
i : integer;
begin
for i:= 1 to 5 do
begin
writeln('ini yang ke ',i,'. Aku bangga jadi Mahasiswa Fisika.');
end;
end.

Program Kondisi

program gerak_balok;
uses wincrt;
const
 G=10;
var
 F,us,m,perc,s,usaha:real;
begin
 clrscr;
 writeln('masukkan angka anda,kemudian enter!');
 gotoXY(5,11); write('gaya tarik: ');readln(F);
 gotoXY(5,12); write('massa benda: ');readln(m);
 gotoXY(5,13); write('koefisien gesekan: ');readln(us);
 write('perpindahan :');readln(s);
 perc :=(F-m*g*us);
 usaha:=(F-m*g*us)*s;
 writeln('percepatan :',perc:8:4);
 writeln('usaha oleh gaya F: ',usaha:8:4);
 readln;
 end.

Program Kondisi

program gerak_balok;
uses wincrt;
const
 G=10;
var
 F,us,m,perc,s,usaha:real;
begin
 clrscr;
 writeln('masukkan angka anda,kemudian enter!');
 write('gaya tarik: ');readln(F);
 write('massa benda: ');readln(m);
 write('koefisien gesekan: ');readln(us);
 write('perpindahan :');readln(s);
 perc :=(F-m*g*us);
 usaha:=(F-m*g*us)*s;
 writeln('percepatan :',perc:8:4);
 writeln('usaha oleh gaya F: ',usaha);
 readln;
 end.

Program Kondisi

Program Nilai_siswa;
uses wincrt;
var
nilai : real;
begin
write('Jumlah Nilai :'); readln(nilai);
if nilai>60 then
writeln('Lulus')
else
writeln('Tidak Lulus');
end.

Program Array

Program Fungsi_dan_prosedur;
uses wincrt;
type
indeks=1..5;
vektor=array[indeks] of real;

var
Rp, hasil :Real;
r : vektor;
pilih : char;
n : integer;

Function R_Paralel : real;
var
i : integer;
hasil : real;

begin
hasil :=0;
for i := 1 to n do
hasil :=hasil+1/r[i];
R_paralel :=1/hasil;
end;

procedure r_seri;
var
i : integer;
begin
hasil:=0;
for i := 1 to n do
hasil:=hasil +r[i];
end;

begin
clrscr;
n:=4;
r[1] :=100;
r[2]:=100;
r[3] :=100;
r[4]:=100;

writeln('pilih S : Rangkaian seri');
writeln('pilih P : Rangkaian paralel');
write('pilihan anda:'); readln(pilih);

case pilih of
'S','s' : begin
R_Seri;
Rp:=Hasil;
end;

'P','p' : begin
Rp:= R_Paralel;
end;

end;
writeln(Rp:10:3); readln;
end.

Program Array

Program urut;
uses wincrt;
type
indeks=1..30;
vektor=array[indeks] of real;
var
 a:vektor;
 cad:real;
 j,i,n:word;

procedure sort(var a:vektor);
 begin
 for i:=1 to n do
 begin
 for j:=i+1 to n do
 begin
 if a[i]>a[j] then
 begin
 cad:=a[i];
 a[i]:=a[j];
 a[j]:=cad;
 end;
 end;
 end;
 end;

Procedure input(var a:vektor);
 begin
 for i:=1 to n do
 begin
 write('a[',i,']');readln(a[i]);
 end;
 end;

procedure output(var a:vektor);
 begin
 for i:=1 to n do
 begin
 writeln (a[i]:6:3);
 end;
 end;

begin
clrscr;
 write('jumlah data');readln(n);
 input(a);
 writeln('data sebelum di urut :');
 output(a);
 sort(a);
 writeln('data setelah diurut adalah: ');
 output(a);
 end.

Program Array

Program jumlah_dua_matriks;
 uses wincrt;
 type
 matrik= array[1..50,1..50] of integer;

 var
 matrika, matrikb : matrik;
a,b : integer;


 procedure baca_matrik(var c :matrik);
 var
 i,j : integer;
 begin
 for i:=1 to a do;
 begin
 for j:=1 to b do;
 begin
 write(' elemen elemen [',i,',',j,']:');
 readln(c[i,j]);
 end;
 end;
 end;



 procedure tulis_matrik ( var c : matrik);
 var
 i,j : integer;
 begin
 for i:=1 to a do
 begin
 for j:=1 to b do
 begin
 write(c[i,j]:6);
 end;
 writeln;
 end;
 end;

 function jumlah( var c,d : matrik) : integer;
 var z : matrik;
 i, j : integer;
 begin
 for i :=1 to a do
 begin for j:=1 to b do
 begin
 z[i,j] :=c[i,j] + d[i,j];
 write(z[i,j]:4);
 end;
 writeln;
 end;
 end;

 begin
 write(' masukkan jumlah baris :'); readln(a);
 write(' masukkan jumlah kolom :'); readln(b);
 clrscr;

 writeln(' baca matrik a');
 baca_matrik(matrika);
 writeln(' baca matrik b');
 baca_matrik(matrikb);
 writeln;

 writeln(' penjumlahan matrik a dan b ');
 jumlah(matrika,matrikb);
 readln;
 end.

Program Array

Program Fungsi_dan_prosedur;
uses wincrt;
var Rp:Real;
r : array[1..5] of real;
pilih : char;
n : integer;
hasil : real;

Function R_Paralel : real;
var
i : integer;
hasil : real;

begin
hasil :=0;
for i := 1 to n do
hasil :=hasil+1/r[i];
R_paralel :=1/hasil;
end;

procedure r_seri;
var
i : integer;
begin
hasil:=0;
for i := 1 to n do
hasil:=hasil +r[i];
end;

begin
clrscr;
n:=4;
r[1] :=100;
r[2]:=100;
r[3] :=100;
r[4]:=100;

writeln('pilih S : Rangkaian seri');
writeln('pilih P : Rangkaian paralel');
write('pilihan anda:'); readln(pilih);

case pilih of
'S','s' : begin
R_Seri;
Rp:=Hasil;
end;

'P','p' : begin
Rp:= R_Paralel;
end;

end;
writeln(Rp:10:3); readln;
end.

Minggu, 23 Oktober 2011

Program Pembantu *Function*

Program Contoh;
uses wincrt;
var
total : integer;

function Hitung : integer;
var
i, jumlah : integer;

begin
jumlah :=0;
for i:=1 to 5 do
jumlah:= jumlah+i;
hitung:= jumlah;
end;

begin
total:= hitung;
writeln(total);
end.

Program Pembantu *Function*

Program Contoh_fungsi;
uses wincrt;
var
angka, jawaban : integer;

function Kubik(x : integer) : integer;
begin
Kubik:=x*x*x;
end;

begin
writeln(' Masukkan angka '); readln(angka);
jawaban:= Kubik(angka);
writeln('hasil pangkat tiga dari',angka,'adalah',jawaban);
end.

Program Pembantu *Function*

Program Faktorial3;
uses wincrt;
var
i, N, hsl : integer;

function Fakto(N : integer) : integer;
var
Fak : integer;
begin
if (N=0) or (N=1) then
fakto:=1
else
fakto:= N*Fakto(N-1);
end;

begin
clrscr;
write('faktorial berapa yang anda ingin hitung:'); readln(N);
writeln('hasil perhitungan:',fakto(N));
readln;
end.

Program Pembantu *Function*

Program Faktorial3;
uses wincrt;
var
i, N, hsl : integer;

function Fakto(N : integer) : integer;
var
Fak : integer;
begin
if (N=0) or (N=1) then
fakto:=1
else
fakto:= N*Fakto(N-1);
end;

begin
clrscr;
write('faktorial berapa yang anda ingin hitung:'); readln(N);
writeln('hasil perhitungan:',fakto(N));
readln;
end.

Program Pembantu *Prosedur*

Program TestNilai;
uses wincrt;
var
x,y : integer;

Procedure NoEffect (x,y : integer);

begin
x:= y;
y:= 0;
writeln(x,y);
end;

begin
x := 1;
y := 2;
writeln(x,y);
NoEffect(x,y);
end.

Program Pembantu *Prosedur*

Program Lokal_Variabel;
uses wincrt;
var
nomor1, nomor2 : integer;
Procedure tambah;
var
hasil : integer;
begin
hasil:=nomor1+nomor2;
writeln('hasil adalah',hasil);
end;
begin
writeln('masukkan dua angka bulat dengan spasi'); readln(nomor1,nomor2);
tambah;
end.

Program Pembantu *Prosedur*

Program Procedure_gerak;
uses wincrt;
var
waktu, jarak, kecepatan : real;

Procedure Tampilan_judul;
begin
writeln(' Menghitung jarak tempuh berdasarkan pada');
writeln('dua variabel yaitu: kecepatan dan waktu');
end;

Procedure Masukkan_data;
begin
write('Masukkan kecepatan dalam km/jam : '); readln(kecepatan);
write('Masukkan waktu dalam jam : '); readln(waktu);
end;

Procedure Hitung_jarak;
begin
jarak := kecepatan*waktu;
end;

Procedure Tampilkan_hasil;
begin
writeln(' Jarak yang ditempuh adalah ', jarak:5:2,'km.');
end;

begin
Tampilan_judul;
Masukkan_data;
Hitung_jarak;
Tampilkan_hasil;
end.

Program Pembantu *Prosedur*

Program Bilangan_GenapGanjil;
uses wincrt;
var
i , jml, pil : integer;
jwb,ya,tidak : char;


Procedure Bilangan_genap;
var
i, n, jml : integer;
begin
write(' SILAHKAN MASUKKAN NILAI ANDA -> '); readln(n);
jml:=0;
  for i:= 1 to n do
  jml:=jml+(2*i);
  write('JADI JUMLAH BILANGAN GENAP TERSEBUT ADALAH -> ',jml);
  end;

Procedure Bilangan_ganjil;
var
i,n, jml : integer;
begin
write(' SILAHKAN MASUKKAN NILAI ANDA -> '); readln(n);
jml:=0;
  for i:= 1 to n do
  jml:=jml+(2*i)-1;
  write('JADI JUMLAH BILANGAN GANJIL TERSEBUT ADALAH -> ',jml);
  end;

Begin

repeat
writeln(' PILIHAN');
writeln(' 1. GENAP ');
writeln(' 2. GANJIL ');
writeln(' PILIH SALAH SATU MENU DIBAWAH INI');readln(pil);
if pil=1 then
bilangan_genap
else
if pil=2 then
bilangan_ganjil
else
exit;
readln;
writeln(' ingin berhenti? y/t'); readln(jwb);

until jwb='y';
end.

Program Pembantu *Prosedur*

Program prosedure_sederhana;
uses wincrt;
var
i : integer;
Procedure display_menu;
begin
writeln('Pilihan Menu');
writeln(' 1 : Edit file teks');
writeln(' 2 : Buka file teks');
writeln(' 3 : Simpan file teks');
writeln(' 4 : Kopi file teks');
writeln(' 5 : Cetak file teks');
end;
begin
writeln('memanggil prosedur');
display_menu;
writeln('kembali dari prosedure');
end.

Selasa, 11 Oktober 2011

Program Pembantu *Prosedur*

Program ContohProsedur;
uses wincrt;
var
a,b : integer;
Procedure Cetak_bilangan;
begin
writeln(' Hasil Pertama = ',a);
writeln(' Hasil Kedua = ',b);
end;
begin
write(' Masukkan Bilangan Pertama :'); readln(a);
write(' Masukkan Bilangan Kedua :'); readln(b);
Cetak_bilangan;
a:=a+10;
b:=b+5;
writeln(' Hasil Setelah Penjumlahan ;');
cetak_bilangan;
end.

Program Pembantu *Prosedur*

Program Hitung_Jarakbenda;
uses wincrt;
var
v,t, x : integer;


Procedure Tampilan_judul;
begin
writeln(' PROGRAM MENGHITUNG JARAK BENDA');
writeln(' PADA GERAK LURUS BERATURAN ');
writeln(' ========================== ');
end;

Procedure Masukkan_data;
begin
write(' BERAPA KECEPATAN BENDA ?'); readln(v);
write(' WAKTU TEMPUH = '); readln(t);
end;

Procedure Hitung_jarak;
begin
x := v*t;
end;

Procedure Tampilkan_hasil;
begin
writeln(' JADI JARAK YANG DITEMPUH ADALAH SEPANJANG ',x);
end;

begin
Tampilan_judul;
Masukkan_data;
Hitung_jarak;
Tampilkan_hasil;
end.

Program Pembantu *Prosedur* #Rekursi

Program Menghitung_Faktorial;
uses wincrt;
var
N , ul : integer;
fak : real;

begin
repeat
writeln(' masukkan angka -> '); readln(N);

if N<0 then
writeln(' SILAHKAN CARI ANGKA LAIN');
until N>=0;
 fak :=1 ;
 if N=0 then
 fak :=1;
 for ul := 1 to n do
 begin
 fak := ul*fak;
 writeln(ul, '':3, fak:6:0);
 end;
 end.
Program Bilangan_GenapGanjil;
uses wincrt;
var
i , jml, pil : integer;
jwb,ya,tidak : char;


Procedure Bilangan_genap;
var
i, n, jml : integer;
begin
write(' SILAHKAN MASUKKAN NILAI ANDA -> '); readln(n);
jml:=0;
  for i:= 1 to n do
  jml:=jml+(2*i);
  write('JADI JUMLAH BILANGAN GENAP TERSEBUT ADALAH -> ',jml);
  end;

Procedure Bilangan_ganjil;
var
i,n, jml : integer;
begin
write(' SILAHKAN MASUKKAN NILAI ANDA -> '); readln(n);
jml:=0;
  for i:= 1 to n do
  jml:=jml+(2*i)-1;
  write('JADI JUMLAH BILANGAN GANJIL TERSEBUT ADALAH -> ',jml);
  end;

Begin

repeat
writeln(' PILIHAN');
writeln(' 1. GENAP ');
writeln(' 2. GANJIL ');
writeln(' PILIH SALAH SATU MENU DIBAWAH INI');readln(pil);
if pil=1 then
bilangan_genap
else
if pil=2 then
bilangan_ganjil
else
exit;
readln;
writeln(' ingin berhenti? y/t'); readln(jwb);

until jwb='y';
end.