Kamis, 07 Januari 2010

Kumpulan Source code Sederhana Dalam Bahasa Pascal

Hampir senada dengan postingan yang linked list, Kali ini saya juga akan menshare kumpulan source code program-program kecil dalam bahasa pascal. Meskipun masih sederhana dan mungkin tidak cocok untuk programmer yang sudah mapan, tulisan ini saya harap bisa berguna untuk mereka yang masih atau mau belajar memprogram. Karena sebelum memahami hal yang rumit, harus paham yang sederhana dulu kan?  Dengan membaca kode-kode pascal yang ada disini, semoga bisa menambah pemahaman tentang pemprograman.
Bila dasar source code yang Linked List bukan saya yang membuat,  semua yang ada disini adalah kode yang saya tulis sendiri. Sebagian di kerjakan sebagai jurnal praktikum di kampus, sebagian tugas dari dosen, dan sisanya adalah hasil iseng-iseng. Jadi, saya jamin code disini tidak akan di temui di website atau blog lain, kecuali mereka memplagiat artikel ini. Jadi merasa beruntunglah sudah kesini, hwahwahwahah (tertawa setan)
Silahkan cermati, hayati, lalu komentari. Kalau ada yang kurang jelas, Tanyakanlah…..

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.


Nah, sekian dulu….semoga bisa berguna.(AHP  07 Januari 2010, 16:10)

24 komentar:

  1. sekali-sekali kasih tutorial inDesign, Nan. Aku Lagi pengin belajar iitu

    BalasHapus
  2. @Muji: Waah, saya gak bisa malah mas....kalo photoshop bisa.

    BalasHapus
  3. Nan, bs minta software pascalny gak ?

    BalasHapus
  4. Thanks Nan buat source codenya. Kebetulan saya sekarang lagi mau belajar Pascal..

    BalasHapus
  5. @Fadly : Maksudnya compilernya fad? kalau aku pake Free Pascal, silahkan tanyakan ke mbah Google, pasti nemu

    BalasHapus
  6. ehm adnan, kenalan yah.. sekalian tukeran link.. hihihi..
    http://nevpetzone.co.cc
    aku dah masukin link mu ke blogroll mu..

    kamu kuliah di ITT kan? 2009?

    BalasHapus
  7. @Peter: Yuk, salama kenal juga, OK..ok
    Iya, angkatan tahun 2009.....kamu juga?

    BalasHapus
  8. THANK'S BANG ATAS SOURCE CODENYA..AKU MAU NANYA NEH BANG,GIMANA MEMBUAT TABEL DAN KOLOM DALAM PASCAL..!!!TRIM'S....

    BalasHapus
  9. Kalau membuat tabel di pascal agak sulit, soalnya berbasis teks.
    Bukan berarti ngga bisa sih, tinggal main-mainin fungsi gotoxy dan karakter | dan _

    BalasHapus
  10. terima kasih banyak yach bang atas source codenya....
    source codenya sangat membantu, coz skarang nie aku lg belajar pascal...he..he

    Oiya bang, aku mau tanya, klo source code utk bikin program kalkulator pada pascal itu kyak gmana yach?????

    BalasHapus
  11. ya, sama-sama
    gampang kok, pertama bikin variabel dulu buat nampung angka yang ma di operasikan, lalu di operasikan pake kali, tambah atau yang lain, langkah terakhir, outputkan...

    BalasHapus
  12. Pa', ada contoh program grafik LIngkaran, Ellipse, Unsur Rotasi & Unsur Skala Gak, klo ada tlong krim ke email sy di : ghalankpeace@ymail.com
    soalnya besok sy udh harus kumpl.....

    atas bantuannya sy ucapkan trima ksih.....

    BalasHapus
  13. bapak da contoh listing program yang 500 baris gak?
    terserah mw program apa?
    klo ada tolong kirim ke email saya di : giokqu@gmail.com

    atas bantuannya saya ucapkan terima kasih banyak yah...

    BalasHapus
  14. thanks bang atas codingnya..
    saya baru belajar pascal nihh

    moga dapat pahala disisinya ya..

    BalasHapus
  15. boleh tau ga source codenya bilangan faktorial?

    BalasHapus
  16. wahhh hebat yaa.. :)boleh minta bantuan ga?? saya ada tugas besar untuk membuat program bebas yang 500 baris. kalau ada kirim saja k n_tayoe@yahoo.com terima kasih pak sebelumnya :)

    BalasHapus
  17. ajariin buat tabel dong gan :(
    trus, gmna caranya biar ntar di outputnya nama yang diinputin berurutan berdasarkan abjad?

    BalasHapus
  18. Kok Yang tebak angka kok kagak bisa.....


    kalo bisa tolong pakai Freeware aja kayak TPW 1,5 (turbo pascal for windows) cuma kode "uses crt" diganti "uses wincrt" karena berada di sistem operasi WINDOWS.... TPW 1,5 juga Sering di pakai anak - anak SMK jurusan RPL (Rekayasa Perangkat Lunak)

    BalasHapus
  19. terima kasih ka atas kode nya . sangat membantu sekali buat saya yang pemula....!!!!! :)

    BalasHapus
  20. keren mas..
    terimakasih banyak..
    izin ngopy buat tugas dari dosen..

    BalasHapus
  21. makasih source codenya gan mantapp

    BalasHapus

Kirim Komentar