Coding Sederhan Pascal

Prosedur dan Fungsi

Di sub judul ini, ada 4 source code yang mengandung fungsi dan prosedur. Fokus yang ada disini adalah bukan mengenai bagaimana isi prosedur itu, tapi lebih ke bagaimana penggunaan fungsi dan prosedur itu. Tentang bagaimana deklarasinya, penerapan parameter, pemanggilannya dan sebagainya… Contoh disini dimulai dari yang paling sederhana hingga yang lebih ribet sedikit…..

Dilatasi

Fungsi : Mengalikan dua buah angka yang dimasukan dengan angka tertentu.

Hint : -

Screenshot Output:

uses crt;

var absis,ordinat,pengali:integer;

procedure dilat(a,b,peng:integer);

   var c,d:integer;

   begin

    c:=a*peng;

    d:=b*peng;

    writeln('(',c,',',d,')');

   end;

begin

  writeln('Kordinat Awal');

  write('Absis : ');readln(absis);

  write('Ordinat : ');readln(ordinat);

  writeln;

  write('masukan faktor pengali ');readln(pengali);

  write('Kordinat (',absis,',',ordinat,') setelah didilatasikan terhadap faktor ',pengali,' menjadi ');

  dilat(absis,ordinat,pengali);

  readln;

end.

Mencari Penyelesaian Fungsi Kuadrat

Fungsi : Mengitung nilai persamaan kuadrat bila nilai x diketahui

Hint: Masukan  nilai a,b,c  dan nilai x.

Screen Shot :

uses crt;

var x,y,z,s:integer;

function fungsi(a,b,c,x:integer):integer;

    begin

       fungsi:=a*(x*x)-b*x+c;

    end;

begin

   write('masukan a : ');readln(x);

   write('masukan b : ');readln(y);

   write('masukan c : ');readln(z);

   write('masukan x : ');readln(s);

   writeln('f(x)=',x,'(x^',x,'2)-',y,'x+',z);

   writeln('f(',s,') =',fungsi(x,y,z,s));

   readln;

end.

Menghitung Waktu Gerhana

Fungsi : Menghitung tanggal gerhana pada bulan tertentu dengan rumus yang sudah ada.

Hint: Sebenarnya intinya hanya membuat prosedur yang menampilkan jumlah hari dalam bulan tertentu..waktu gerhana ini sebagai tambahan saja.

Screen Shot :

uses crt;

var b,ha,ger:integer;

      bul:string;

procedure maks(s:integer);

    var y,k:integer;

    begin

      case s of

        1,3,5,7,8,10,12:ha:=31;

        4,6,9,11:ha:=30;

        2:begin

            write('masukan tahun ');readln(y);

            k:=y mod 4;

            if k=0 then

              ha:=28

           else ha:=29;

           end;

      else writeln('Bulan salah!!!');readln;exit;

    end;

end;

procedure hitung(bee:integer);

   begin

     ger:=bee-(2*b);

   end;

begin

   write('masukan bulan ke- :');readln(b);

   maks(b);

   hitung(ha);

   write('Gerhana bulan ');

   case b of

       1 : WRITE('Januari');

       2:WRITE('Februari');

       3:WRITE('Maret');

       4:WRITE('April');

       5:WRITE('Mei');

       6:WRITE('Juni');

       7:write('Juli');

       8:WRITE('Agustus');

       9:write('September');

       10:write('Oktober');

       11:WRITE('November');

       12:WRITE('desemberrrr');

   end;

   writeln(' terjadi pada hari ke-',ger);

readln;

end.

Penjumlah Pecahan

Fungsi : Menjumlahkan 2 buah pecahan.

Hint:  Tinggal masukan saja penyebut dan pembilang.

Screenshot :

uses crt;

var pemi,pemII,penyi,penyII:integer;

      j,k:integer;

function pemb(a,c:integer):integer;

    begin

       j:=penyii;

       k:=penyi;

       pemb:=a*j+k*c;

    end;

function peny(b,d:integer):integer;

   begin

     peny:=b*d;

   end;

begin

    writeln('Pecahan 1 ');

    write('Pembilang i :');readln(pemi);

    write('Penyebut i :');readln(penyI);

    writeln;

    write('Pecahan 2 ');

    write('Pembilang ii :');readln(pemII);

    write('Penyebut II: ');readln(penyII);

    writeln;

    writeln('maka hasil dari pertambahan ',pemi,'/',penyI,'+',pemii,'/',penyII,' adalah ',pemb(pemi,pemii),'/',peny(penyi,penyii));

readln;

end.

ARRAY

Setelah prosedur dan fungsi, beralih ke Array. Karena sudah masuk ke array, kode-kode yang sini mungkin terlihat lebih rumit dari sebelumnya…

Mencari angka kelipatan 3

Fungsi :Mencari angka kelipatan 3 dari sekumpulan angka yang diinputkan.

Hint: Masukan angka dan masukan -1 untuk berhenti, otomatis hasil akan ditampilkan.

Screen Shot :

uses crt;

 var a,b:array[1..10] of integer;

        i,j,k,l:integer;

begin

       {memasukan angka}

   j:=1;

   repeat

     write('angka ke-',j,': ');readln(a[j]);

      j:=j+1;

   until a[j-1]=-1;

   {menentukan mana yang kelipatan 3}

   for k:=1 to j do

     begin

        if a[k] mod 3=0 then

           b[k]:=a[k];

      end;

{Menampilkan mana yang kelipatan tiga}

  write('angka kelipatan 3 adalah : ');

  for i:=1 to (j-1) do

    begin

       if b[i]<>0 then

         write(b[i],', ');

     end;

  readln;

end.

Penjumlah Matrix

Fungsi : Menjumlahkan dua matriks 3x3 yang diinputkan

Hint: Masukan nilai matriks di tiap-tiap baris dan kolom.

Screen Shot :

uses crt;

 var m1,m2,mp:array[1..10,1..10] of integer;

       i,j,k,l:integer;

begin

{Menginput nilai matriks}

  writeln('Matriks ke 1');

  for i:=1 to 3 do

    for j:=1 to 3 do

       begin

          write('m1[',i,',',j,'] : ');readln(m1[i,j]);

       end;

  writeln;

  writeln('Matriks ke 2');

  for i:=1 to 3 do

       for j:=1 to 3 do

         begin

           write('m2[',i,',',j,'] : ');readln(m2[i,j]);

         end;

  writeln;

{jumlahkan}

 begin

  for i:=1 to 3 do

    for j:=1 to 3 do

       begin

          mp[i,j]:=m1[i,j]+m2[i,j];

       end;

 {lukis hasil penjumlahan}

 writeln('Hasil Penambahan = ');

 writeln;

    for i:=1 to 3 do

      begin

       writeln;

       for j:=1 to 3 do

         write(mp[i,j],' ');

      end;

readln;

end;

end.

Pendata Mahasiswa

Fungsi: Mendata data mahasiswa, atau apalah dengan array dan menampilkannya.

Hint: Intinya adalah membuat array di record.

Screen shot :

program mhsw;

uses crt;

type mahasiswa=record

               nama,nim,kelas:string;

               end;

var m:array[1..41] of mahasiswa;

       j,i:integer;

begin

write('Jumlah mahasiswa yang mendaftar : ');readln(j);

clrscr;

for i:=1 to j do

begin

writeln('Mahasiswa ',i,':');

write('Nama       : ');readln(m[i].nama);

write('Nim        : ');readln(m[i].nim);

write('Kelas      : ');readln(m[i].kelas);

  writeln;

  writeln;

  end;

clrscr;

writeln('==================================');

writeln;

writeln('DATA MAHASISWA KOMPUTOK');

writeln;

writeln('==================================');

for i:=1 to j do

begin

writeln('Mahasiswa ',i,':');

writeln('Nama       : ',m[i].nama);

writeln('Nim        : ',m[i].nim);

writeln('Kelas      : ',m[i].kelas);

writeln;

writeln;

end;

readln;

end.

Tabel Ajaib

Fungsi : Membuat tabel angka yang apabila nilai tabel dalam satu baris, kolom, dan diagonal di jumlahkan hasilnya akan sama.

Hint: jangan terlalu heran, semua sudah ada rumusnya. Tinggal masukan angka-angka saja.

Screen Shot :

uses crt;

var a,b,c,d,w,x,y,z,i,j:integer;

tab:array[1..4,1..4] of integer;

procedure lukistabel;

{Prosedur untuk menampilkan tabel}

var c:string;

begin

for i:=1 to 4 do

begin

writeln;

writeln;

for j:=1 to 4 do

begin

begin

  if (tab[i,j]>9) or ((tab[i,j]<0) and (tab[i,j]>-10))  then

 c:='    '

else if (tab[i,j]<10) and (tab[i,j]>-1) then

 c:='      '

  else c:='  ';

  end;

if j=1 then

write(tab[i,j],c)

  else if j=2 then write(tab[i,j])

else write(c,tab[i,j]);

end;

end;

end;

{program utama}

Begin

{memasukan nilai}

write('a = ');readln(a);

write('b = ');readln(b);

write('c = ');readln(c);

write('d = ');readln(d);

write('w = ');readln(w);

write('x = ');readln(x);

write('y = ');readln(y);

write('z = ');readln(z);

writeln('memproses.......');

delay(500);

{rumusnya ini}

tab[1,1]:=a-w;

tab[1,2]:=c+w+y;

tab[1,3]:=b+x-y;

tab[1,4]:=d-x;

tab[2,1]:=d+w-z;

tab[2,2]:=b;

tab[2,3]:=c;

tab[2,4]:=a-w+z;

tab[3,1]:=c-x+z;

tab[3,2]:=a;

tab[3,3]:=d;

tab[3,4]:=b+x-z;

tab[4,1]:=b+x;

tab[4,2]:=d-w-y;

tab[4,3]:=a-x+y;

tab[4,4]:=c+w;

{pemanggilan prosedur lukis tabel}

lukistabel;

readln;

end.

Fibbonaci Generator

Fungsi: Kode untuk Menghasilkan deret fibbonaci

Hint : Fibbonaci adalah deret yang angka selanjutnya adalah penjumlahan 2 angka sebelumnya.

Misal : 1 1 2 3 5 8 13 21 ….dst

Screen Shot

uses crt;

var a:array[1..1000] of longint;

i,k:integer;

begin

clrscr;

write('Input banyaknya fibbonaci: ');readln(i);

{fibbonacigenerator}

a[1]:=1;

a[2]:=1;

for k:=2 to i do

begin

a[k+1]:=a[k]+a[k-1];

end;

writeln;

writeln;

{menulis fibbonaci}

for k:=1 to i do

begin

write(a[k],' ');

end;

writeln;

readln;

end.

Iterasi

Nah, ini bagian perulangan. Tidak lebih rumit dari array, namun tidak sesederhana di sub bab fungsi dan prosedur.

Angka

Fungsi: Tak ada fungsi khusus, hanya menampilkan pola-pola angka saja…

Hint : Begitu jalan, langsung masukan angka saja, Jangan masukan angka terlalu kecil atau besar.

Screen Shot

uses crt;

var inp,i,a,t,r:integer;

begin

readln(inp);

t:=inp;

for i:=1 to inp do

  begin

for a:=1 to inp do

  write(a-t);

  writeln;

t:=t-1;

end;

readln;

end.

Jumlah Pangkat

Fungsi:  untuk menghasilkan deret pangkat, misal : 1, 4, 9, 16, 25 dst dan menjumlahkannya

Hint : Masukan jumlah deret pangkat yang akan ditampilkan untuk di jumlah…

Screen Shot

uses crt;

var k,jum:double;

i,n:longint;

begin

clrscr;

readln(n);

jum:=0;

for i:=1 to n do

begin

k:=sqr(i);

write(k:0:0);

  if i<>n then

write('+');

jum:=jum+k;

end;

write('=',jum:0:0);

readln;

end.

Tebak Angka

Fungsi:  Permainan Tebak angka, masukan angka rahasia dan suruh teman untuk menebaknya

Hint :  Permainan ini tidak akan asik bila dilakukan sendirian.

Screen Shot

uses crt;

var a,teb,c,d,rhs:integer;

begin

Write('Bilangan Rahasia : ');readln(rhs);

clrscr;

repeat

write('masukan Tebakan anda : ');readln(teb);

if (teb<>rhs) and (teb>rhs) then

writeln('Bilangan terlalu besar!')

else if (teb<>rhs) and (teb

writeln('bilangan terlalu kecil');

until (teb=rhs);

writeln('Tebakan Anda Benar!!!!, selamat!!!!');

readln;

end.

Z

Fungsi:  Melukis huruf Z dengan karakter ‘*’ sebesar jumlah perulangan yang di inputkan

Hint : Masukan angka untuk menentukan besar huruf Z

Screen Shot

uses crt;

var n,i,a:integer;

begin

readln(n);

for i:=1 to n do

begin

for a:=1 to n do

begin

  if (i=1) or (i=n) then

   write('#')

  else if (i<>1) and (i<>n) then

   begin

   if a+i=n then

     write('#')

     else

   write(' ');

   end;

     end;

     writeln;

     end;

readln;

end.

Program Pencari Pembagi

Program yang mungkin terlihat paling ribet, tapi sebenarnya alurnya sederhana. Berungsi untuk menampilkan pembagi dan hasil bagi bilangan bulat yang di masukan. Selain itu, disini juga bisa digunakan untuk menentukan bilangan mana yang prima atau bukan. Sebelumnya program ini sudah pernah di publish di artikel ini, namun saya tidak tampilkan source kodenya. Silahkan bila ingin langsung mencoba bisa langsung kesana.

Sebenarnya ada cacat di program ini, yaitu ada 2 perulangan disini. Yang satu untuk menentukan bilangan prima,  satunya lagi untuk menentukan pembagi. Sebenarnya 2 perulangan itu dapat dipangkas menjadi satu saja. Sehingga 2 perulangan menjadi tidak efisien. Kenapa harus 2?

Sejarahnya begini, awalnya saya menulis program ini iseng-iseng hanya untuk mencari yang mana bilangan prima. Lalu saya kembangkan lagi menjadi bisa menuliskan daftar bilangan pembagi, waktu itu, daripada repot mengedit perulangan untuk menentukan bilangan prima yang sudah mapan, saya membuat perulangan baru. Dan akhirnya program ini punya 2 perulangan yang strukturnya hampir mirip.

Tapi nampaknya tidak masalah, toh selisih waktu kalkulasinya hanya beberapa milidetik, bahkan untuk bilangan yang mencapai ratusan juta sekalipun. Mau edit lagi, rasanya malas……Berikut kodenya…….:

Hint: Sebelum di compile, buat dulu file bernama output.txt di folder yang sama dengan source code pembagi.

program pembagi;

uses crt;

var x,y,q,w,z,e,f,g:longint;

    l,a:string;

    out:text;

label k;

{prosedur untuk sekedar  merapikan hasil output}

procedure rapikan(s:longint;var t:string);

begin

if s<10 then

 t:='          '

 else if (s>9) and (s<100) then

 t:='         '

 else if (s>99) and (s<1000) then

 t:='        '

 else if (s>999) and (s<10000) then

 t:='       '

 else if (s>9999) and (s<100000) then

 t:='      '

 else if (s>99999) and (s<1000000) then

 t:='     '

 else if (s>999999) and (s<10000000) then

 t:='    '

 else if (s>9999999) and (s<100000000) then

 t:='   '

 else if (s>99999999) and (s<1000000000) then

 t:='  '

 else if (s>999999999) and (s<1000000000) then

 t:=' '

 else t:=' ';

end;

{program utama}

begin

textbackground(blue);

textcolor(Yellow);

clrscr;

assign(out,'output.txt');

append(out);

 gotoxy(3,1);writeln('+______________________________________________________+');

 gotoxy(3,2);writeln('|Copyright@2009, Xenovon, http://komputok.blogspot.com |');

 gotoxy(3,3);Writeln('+------------------------------------------------------+');

 writeln;

 writeln;

 gotoxy(3,5);writeln('Hint: Masukan angka 2 untuk keluar');

 gotoxy(3,6);writeln('      hasil juga dioutputkan ke output.txt');

 writeln;

 writeln;

 gotoxy(15,9);writeln('----[MENENTUKAN PEMBAGI SUATU BILANGAN BULAT]------');

 writeln;

 writeln;

{menuliskan ke output.txt}

 writeln(out);

 writeln(out);

 writeln(out);

 writeln(out,'+______________________________________________________+');

 writeln(out,'|Copyright@2009, Xenovon, http://komputok.blogspot.com |');

 Writeln(out,'+------------------------------------------------------+');

 writeln(out);

 writeln(out);

 writeln(out);

 writeln(out,'----[MENENTUKAN PEMBAGI SUATU BILANGAN BULAT]------');

 writeln(out);

 begin

{input bilangan yang akan di cari}

 k:

 write('masukan bilangan yang akan di cek : ');readln(x);writeln;

{error handling}

 if x<2 then goto k else

{pemeriksaan kondisi untuk keluar program, yaitu dengan menginput angka 2}

 if x=2 then

   begin

    writeln('2 adalah bilangan prima');

    writeln;

    write('Mau keluar?(y/x)');readln(l);

    writeln;

      if l='y' then exit else goto k;

   end;

{Menentukan apakah bilangan prima atau bukan}

 begin

  y:=1;

  repeat

   y:=y+1;

   q:=x mod y;

  until  (q=0);

 end;

if y=x then

 begin

  writeln(x,' adalah bilangan prima');writeln;

 writeln(out,x,' adalah bilangan prima');writeln(out);

 end

else

begin

     {apabila bukan prima, maka program menentukan pembagi yang mungkin}

 writeln('Pembagi dari ',x,': ');

 writeln('--------------------');

 writeln(out,'Pembagi dari ',x,': ');

 writeln(out,'--------------------');

 writeln(out);

 w:=1;

 repeat

  w:=w+1;

  e:=x mod w;

  if e=0 then

   begin

           {menuliskan pembagi & hasil bagi ke konsole dan ke output.txt}

   g:=x div w;

   rapikan(w,a);

   writeln(w,a,'--> ',x,'/',w,'= ',g);

   writeln(out,w,a,'--> ',x,'/',w,'= ',g);

   end;

 until  (w=x);

 writeln;

 writeln(out);

end;

goto k;

end;

close(out);

end.