Widget by Restana Corporation

Thursday, October 9, 2014

Kumpulan Sintak Program Array di Pascal Sederhana

Menentukan Banyaknya muncul angka di array
--------------------------------------------------------
program BanyakMuncul;

var i,n,muncul,x: integer;
angka : array[1..100] of integer;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//menentukan nilai x
write('Nilai x : ');readln(x);

//algortima banyaknya kemunculan
muncul := 0;
for i:=1 to n do
begin
if (x=angka[i]) then
inc(muncul); //muncul:=muncul + 1;
end;

//menampilkan hasil
write('Banyaknya kemunculan nilai ',x,' : ',muncul);
        readln()
end.

Menentukan Jumlah Array
--------------------------------
program JumlahArray;

var i,n,jumlah : integer;
angka : array[1..100] of integer;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//algoritma penjumlahan array
jumlah:=0;
for i:=1 to n do
begin
jumlah:=jumlah+angka[i];
end;

//menampilkan jumlah yang diperoleh
writeln('Jumlahnya ', jumlah);
        readln;
end.

Mencari Posisi
-------------------
Program Mencari_Posisi;

uses crt;

var
   t : array[1..100] of integer;
   x,i,posisi,n : integer;

begin
     write('Banyaknya Bilangan : '); readln(n);

     for i := 1 to n do
         begin
              write('Posisi ke ',i, ': '); readln(t[i]);
         end;
              write('Nilai X  '); readln(x);

         posisi:=0;
         for i := 1 to n do
             begin
                  if x = t[i] then
                     posisi:=i;
             end;
         writeln('Posisi : ', posisi);
end.

Mentukan Besar 
--------------------
program nilaiTerbesar;

var i,n,besar : integer;
angka : array[1..100] of integer;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//algoritma nilai terbesar
besar := angka[1];
for i:=2 to n do
begin
if (besar<angka[i]) then
besar := angka[i];
end;

//menampilkan nilai terbesar
writeln('Nilai terbesar adalah ', besar);
end.


Menentukan Apakah semua negatif atau tidak
-----------------------------------------------------------
program semuaNegatif;

var i,n : integer;
angka : array[1..100] of integer;
jawab : string;

begin
//menentukan banyaknya angka yang akan dimasukkan
write('Banyaknya angka : ');readln(n);

//melakukan perulangan untuk mengisi data di array
for i:=1 to n do
begin
write('Angka ke-',i,' : ');readln(angka[i]);
end;

//algoritma penjumlahan array
jawab := 'Semua Negatif'; i:=1;
while i<=n do
begin
if angka[i]>0 then
begin
jawab := 'Tidak Semua Negatif';
end;
i:= i +1;
end;

//menampilkan jumlah yang diperoleh
writeln(jawab);
        readln;
end.

Sintak Algoritma Queue Non Circular & Circular di Pascal Struktur Data

evans-blog-praktikum-struktur-data-bahasa-java-queue copy
Queue Non Circular
--------------------------
Program UASQueueNonCircular;
uses crt;

const Nmax = 5;

type Queue = record
           isi  : array[1..Nmax] of integer;
           head : integer;
           tail : integer;
     end;

function QueueKosong (Q : Queue) : boolean;
     var
        kosong : boolean;
     begin
        if (Q.head = 0) AND (Q.tail = 0) then
           kosong := true
        else
           kosong := false;

        QueueKosong := kosong;
     end;

function QueuePenuh (Q : Queue) : boolean;
     var
        penuh : boolean;
     begin
        if (Q.head = 1) AND (Q.tail = Nmax) then
           penuh := true
        else
           penuh := false;

        QueuePenuh := penuh;
     end;

procedure ADD (var Q : Queue; angka : integer);
     begin
        if not QueuePenuh(Q) then
           if QueueKosong(Q) then
              begin
                   Q.head := 1;
                   Q.tail := 1;
                   Q.isi[Q.tail] := angka;
              end
           else
              begin
                   Q.tail := Q.tail+1;
                   Q.isi[Q.tail] := angka;
              end;
     end;

procedure REMOVE (var Q : Queue; var x : integer);
     var
        i : integer;
     begin
         if not QueueKosong(Q) then
            if (Q.head = 1) AND (Q.tail = 1) then
               begin
                  Q.head := 0;
                  Q.tail := 0;
               end
            else
               begin
                  x := Q.isi[Q.head];
                  for i := 1 to Q.tail do
                      begin
                           Q.isi[i-1] := Q.isi[i];
                      end;

                      Q.tail := Q.tail - 1;
               end;


     end;

procedure tampil(Q : Queue);
   var
      i : integer;
   begin
      for i := 1 to 5 do
          begin
               write(Q.isi[i], ' ');
          end;
          writeln;
   end;

// Contoh Program Utama
var
   Q : Queue;
   x,i : integer;
begin
   tampil(Q);
            ADD(Q,2);
   tampil(Q);
            ADD(Q,3);
   tampil(Q);
            ADD(Q,5);
   tampil(Q);
            ADD(Q,6);
   tampil(Q);
            ADD(Q,1);
   tampil(Q);
            REMOVE(Q,x);


   writeln('Nilai X : ', x);
   writeln('Tail : ', Q.tail);
   writeln('Head : ', Q.head);
   readln;

end.


Queue Circular
--------------------
Program QueueAntrian;
uses crt;

const Nmax = 100;

type Queue = record
           isi : array[1..Nmax] of integer;
           head : integer;
           tail : integer;
     end;

function QueueKosong(Q : Queue) : boolean;
     var
        kosong : boolean;
     begin
        if (Q.head = 0) and (Q.tail = 0) then
           kosong := true
        else
           kosong := false;
        QueueKosong := kosong;
     end;

function QueuePenuh(Q : Queue) : boolean;
     var
        penuh : boolean;
     begin
        if Q.tail = Nmax then
           penuh := true
        else
           penuh := false;
        QueuePenuh := penuh;
     end;

function QueueSatu(var Q :Queue) : boolean;
     var
        isisatu : boolean;
     begin
          if (Q.head=1) and (Q.tail=1) then
             isisatu := true
          else
              isisatu := false;
          QueueSatu:=isisatu;

     end;

procedure ADD(var Q : Queue; x : integer);
     begin
          if not QueuePenuh(Q) then
             if QueueKosong(Q) then
                begin
                     Q.head := 1;
                     Q.tail := 1;
                     Q.isi[Q.tail] := x;
                end
             else
                 begin
                     Q.tail := Q.tail + 1;
                     Q.isi[Q.tail] := x;
                 end;
     end;

Procedure REMOVE(var Q : Queue; var x : integer);
     var
          i:integer;
     begin
          if not QueueKosong(Q) then
             if QueueSatu(q) then
                begin
                     Q.head :=0;
                     Q.tail :=0;
                end
             else
                 begin
                 x := Q.isi[Q.head];
                 {alogoritma geser kiri}

                 for i:= 2 to Q.tail do
                     begin
                          Q.isi[i-1] := Q.isi[i];
                     end;
                 Q.tail:=Q.tail-1;
                 end;
     end;

var
   Q : Queue;
   x,i : integer;
begin
   add(Q,2);
   add(Q,3);
   add(Q,5);
   add(Q,1);
   add(Q,9);
   remove(Q,x);

   for i:=1 to Q.tail do
       begin
            writeln(Q.isi[i]);
       end;
       begin;
            writeln('Nilai x adalah : ',x);
            writeln('Nilai tail adalah : ', Q.tail);
            writeln('Nilai head adalah : ', Q.head);
       end;
readln;

end.

Sintak Algoritma Stack (TUMPUKAN) di Pascal

Pengertian Stack atau Tumpukan adalah suatu stuktur data yang penting dalam pemrograman yang mempunyai sifat LIFO (Last In First Out), Benda yang terakhir masuk ke dalam stack akan menjadi benda pertama yang dikeluarkan dari stack.  Stack (Tumpukan) adalah list linier yang dikenali elemen puncaknya (TOP) dan Aturan penyisipan dan penghapusan elemennya tertentu. Penyisipan selalu dilakukan “di atas“  TOP dan Penghapusan selalu dilakukan pada TOP.

Ilustrasi stack pada saat inisialisasi


Fungsi IsFull
Untuk memeriksa apakah stack sudah penuh?
Dengan cara memeriksa top of stack, jika sudah sama dengan MAX_STACK-1 maka full, jika belum (masih lebih kecil dari MAX_STACK-1) maka belum full

Ilustrasi

Sintak Stack :
----------------------
Program StackTumpukan;
uses crt;

const Nmax = 100;

type Stack = record
           isi : array[1..Nmax] of integer;
           top : integer;
     end;

function IsEmpty(S : Stack) : boolean; {mengecek stack kosong}
     var
        empty : boolean;
     begin
        if S.top = 0 then
           empty := true
        else
            empty := false;
        IsEmpty := empty;
     end;

function IsFull(S : Stack) : boolean; {mengecek stack penuh}
     var
        full : boolean;
     begin
        if S.top = Nmax then
           full:=true
        else
            full:=false;
        IsFull := full;
     end;

Procedure PUSH (var S:Stack; x : integer); {fungsing push/ memasukkan}
     begin
       if IsFull(S) = false then
        begin
             S.top := S.Top + 1;
             S.isi[S.top] :=x;
        end;
     end;
Procedure POP (var S : Stack; var  x : integer); {fungsi pop / mengambil/dilayani}
     begin
          if IsEmpty(S) = false then
          begin
               x:=S.isi[S.top];
               S.top := S.top-1;
          end;
          writeln('Hasil POP ', x);
     end;

// contoh program utama
var
   a,b,c,x,i : integer;
   S : Stack;
begin
   a := 5;
   b := 3;
   c := 7;
   s.top:=0;
   PUSH(S,a);
   PUSH(S,c*c);
   POP(S,x);
   b:=x;
   PUSH(S,a+b);
   POP(S,x);
   a:=x;
   POP(S,x);
   b:=x;

   for i:=1 to s.top do
       writeln(S.isi[i]);

   writeln(s.top);
      readln;

end.



Free Download KMPlayer v3.9.1.129 New Full Version



KMPlayer itself has many users and between them have been using this software so default play audio and video files, and most people also this software Mumunya to play video and a movie which also supports movie subtitle. 
KMPlayer is very suitable for those of you used to play video as well as audio for almost all kinds of audio and video files can be played back with this one so the software is not in use and KMPlayer ragunkan 3.9.1.129 is the latest version that has been released on this week.



Screen Shoot
Link Download



Free Download K-Lite Mega Codec Pack 10.8.0 Full Version



K-Lite Mega Code Pack is a file in which the existing application function Media Player Classic which is used as a media player or to play sound or video files, Where are among users also liked because light is used when running Media Player Classic and not only was in the K-Lite Code Pack also Meda already some codecs to add a file that supports the default Windows Media Player. 
K-Lite Mega Codec Pack released the latest version is 10.8.0, which certainly brought change and also codecs in it.


Screen Shoot

Link Download



Monday, October 6, 2014

Contoh Program Pascal

Mahasiswa irit atau boros
---------------------------------
program Mahasiswa_Irit_Boros;
uses crt;
var
         saku, peng, hasil : integer;

begin
         write('JUmlah Uang saku anda perminggu : '); readln(saku);
         write('Pengeluaran anda perminggu : '); readln(peng);

   hasil:=saku-peng;
   if hasil>=peng then
          writeln('sisa uang saku anda perminggu adalah : ',hasil,' maka anda adalah orang yang irit')
   else
           writeln('sisa uang saku anda perminggu adalah : ',hasil,' maka anda adalah orang yang boros');
end.
---------------------------------------------------------------------------------------------------------

Program Menghitung Gaji
---------------------------------
program menghitung_gaji;
uses crt;

var
     nama_pegawai:string;
     alamat:string;
     gaji_pokok,tunjangan,pajak,gaji_bersih:comp;


begin
     writeln('menghitung gaji bersih pegawai');
     write ('nama pegawai:');readln(nama_pegawai);
     write ('alamat:');readln(alamat);
     write ('gaji pokok:');readln(gaji_pokok);



     tunjangan:=0.15 * gaji_pokok;
     pajak:=0.075 * gaji_pokok;
     gaji_bersih:=gaji_pokok+tunjangan-pajak;

     writeln(nama_pegawai);
     writeln('gaji pokok anda adalah',gaji_pokok);
     writeln('tunjangan anda sebesar',tunjangan);
     writeln('pajak anda sebesar',pajak);
     writeln('gaji bersih anda adalah',gaji_bersih);

end.
---------------------------------------------------------------------------------------

Program If_Kombinasi
--------------------------------

program IfKombinasi;

uses crt;

var
angka1,angka2 : integer;

begin

writeln('Masukkan angka pertama : '); readln(angka1);

writeln('Masukkan angka kedua : '); readln(angka2);


if {not} (angka1>3) and {or} (angka2>4) then

begin

writeln('Anda memasukkan nilai angka pertama > 3 dan kedua > 4');
         end

end.
----------------------------------------------------------------------------------------------

Program Tebakan_Angka
-------------------------------
program Tebakan_Angka;

uses crt;

var
angka,tebakan : integer;


begin

clrscr;

angka:= 2;

writeln('Tebak angka antara 1 dan 10'); readln(tebakan);


if angka = tebakan then

writeln('Selamat!, Tebakan anda benar.')

else

writeln('Maaf, Tebakan anda salah.')

end.
--------------------------------------------------------------------------------

Program Menghitung Detik Menit
-----------------------------------------
program PenghitungJamKeMenit;

uses crt;

var
   jam, menit,i,hasil,dtk,hasildtk : integer;

begin
     clrscr;
     write('Masukkan NIlai Waktu/Jam : '); readln(jam);
     i:=60;
     dtk:=3600;
     if jam =1 then
        begin
        hasil:=jam*i;
        hasildtk:=jam*dtk;
        writeln(jam, ' jam sama dengan ',hasil,' menit dan ', hasildtk, ' detik');
        end
        else
        begin
             hasil:=jam*60;
             hasildtk:=jam*dtk;
             writeln(jam,' jam sama dengan ',hasil, ' menit dan ', hasildtk, ' detik');
        end;
end.
-----------------------------------------------------------------------------

Program Kalkulator
-------------------------
Program Kalkulator;
uses    crt;

var     angka1,angka2,hasil:real,2;
        operasi:char;

begin
clrscr;
        writeln('APLIKASI KALKULATOR');
        writeln('===================');
        write('MASUKKAN ANGKA PERTAMA : '); readln(angka1);
        write('LAKUKKAN OPERASI (+,-,/,*) : '); readln(operasi);
        write('MASUUKKAN ANGKA KEDUA : '); readln(angka2);
        case operasi of
            '+': hasil :=angka1+angka2;
            '-': hasil :=angka1-angka2;
            '*': hasil :=angka1*angka2;
            '/': hasil :=angka1/angka2;
        end;
        writeln('HASIL DARI ',angka1,' ', operasi,' ', angka2, ' = ',' ', hasil);
end.
-----------------------------------------------------------------------

Program Pangkat_Kuadrat
----------------------------------
program pangkat_kuadrat;
uses crt;

var
   bil : integer;


function pangkat2(b: integer) : integer;
var
   hasil : integer;  {hasil sebagai variabel lokal}
begin
   hasil := b *b;
   pangkat2 := hasil;

end;

{bagian prog.utama}
begin
   clrscr;
   write('silakan masukan bilangan bulat : '); readln(bil);
   write('hasil pangakt adalah ', pangkat2(bil));

   readkey;
end.
----------------------------------------------------------------------------

Program Luas Persegi Panjang
-------------------------------------
Program Luas_Persegi_Panjang;

uses crt;

var
   panjang : real;
   lebar : real;
   luas : real;

begin
     clrscr;
     writeln('===================================');
     writeln('| ','MENGHITUNG LUAS PERSEGI PANJANG',' |');
     WRITELN('');
     writeln('| ','RUMUS : PANJANG X LEBAR (p x l)',' |');
     writeln('===================================');
     writeln('');
     write('Nilai Panjang Persegi Panjang : '); readln(panjang);
     write('Nilai Lebar Persegi Panjang : '); readln(lebar);
     Writeln('Rumus Luas Persegi Panjang : Panjang x Lebar (p x l)');
     luas :=panjang*lebar;
     writeln('');
     writeln('=============================');
     writeln('| ','Jadi p x l = ',panjang:0:1,' x ',lebar :0:1);
     writeln('==============================');
     writeln(luas:0:1);


end.
-------------------------------------------------------------------------

program NeastedIf;

uses crt;

var 
A,B,C : integer;


begin
clrscr;

writeln ('Masukkan tiga angka dengan spasi'); readln(A, B, C);


if A >= B then
begin

if A >= C then

writeln (A, ' adalah nilai terbesar')

else

writeln (C, ' adalah nilai terbesar')

end

else if B >= C then
begin

if B >= C then

writeln (B, ' adalah nilai terbesar')
else
writeln (C, ' adalah nilai terbesar')
end


else if C >= A or B then

writeln(C, ' adalah nilai terbesar');
end.
-----------------------------------------------------------------------------------

Program Pegawai
---------------------
program pegawai;
uses crt;
var
        gajipokok, gajibersih, tunjangan1, tunjangan2, tunjangan3, tunjangan4 :real;
        status :char;
        nama, alamat :string[30];
        jumlah :integer;
begin
        clrscr;
        write('Nama                  : '); readln(nama);
        write('Alamat                : '); readln(nama);
        write('Gaji pokok            : Rp '); readln(gajipokok);
        write('Status D:menikah, S:belum menikah : '); readln(status);
        write('Jumlah anak           : '); readln(jumlah);
        if (status = 'D') then
                if(jumlah <= 3) then begin
                        tunjangan1 :=(5 * gajipokok) / 100;
                        tunjangan2 :=(2 * gajipokok * jumlah) / 100;
                        gajibersih := gajipokok + tunjangan1 + tunjangan2;
                        writeln('tunjangan suami/istri : Rp ',tunjangan1:0:0);
                        writeln('tunjangan anak        : Rp ',tunjangan2:0:0);
                        writeln('gaji bersih           : Rp ',gajibersih:0:0);
                end
                else
                begin
                        tunjangan1 :=(5 * gajipokok) / 100;
                        tunjangan2 :=(2 * gajipokok * 3) / 100;
                        tunjangan3 :=(3 * gajipokok * (jumlah - 3)) / 100;
                        tunjangan4 :=tunjangan2 + tunjangan3;
                        gajibersih :=gajipokok + tunjangan1 + tunjangan4;
                        writeln('tunjangan suami/istri : Rp ',tunjangan1:0:0);
                        writeln('tunjangan anak        : Rp ',tunjangan4:0:0);
                        writeln('Gaji bersih           : Rp ',gajibersih:0:0);
                        writeln('Terima Kasih');
                end
        else
                writeln('gajibersih            : Rp ',gajipokok:0:0);
        readkey;
end.
-----------------------------------------------------------------------------------

Program Status Bilangan Ganjil/Genap
-----------------------------------------------
program StatusBilangan;

uses crt;


var
 angka :integer;


begin

clrscr;

writeln('STATUS BILANGAN');

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


write('Masukkan Bilangan : '); readln(angka);


if angka < 0 then

begin

   if angka mod 2 = 0 then

writeln('Status Bilangan : GENAP/NEGATIF')

   else

writeln('Status Bilangan : GANJIL/NEGATIF')

end
   else

begin

if angka mod 2 = 0 then

writeln('Status Bilangan : GENAP/POSITIF')

else

writeln('Status Bilangan : GANJIL/POSITIF')
end;

end.
-------------------------------------------------------------------------------------------

Program Game Tebak
---------------------------
program Game_Tebak;

uses crt;

var
pilih : integer;
        tebak1, tebak2, tebak3  : string ;
begin
clrscr;
writeln('=======================================');
writeln('|',' SELAMAT DATANG DI GAME TEBAK-TEBAKKAN ','|');
writeln('=======================================');
writeln('');

writeln('*','PILIH KATAGORI GAME ','*');
writeln('1. Mudah');
writeln('2. Sedang');
writeln('3. Sulit');
writeln('-----------------------');
writeln('');

write('Masukkan Pilihan Katagori Anda 1,2,3 : '); readln(pilih);

case pilih of
    1 :
             begin
                writeln('===========================');
                writeln('| ','Game Tebakan Katagori Mudah','|');
                writeln('===========================');
                write('Soal Tebak : Siapakah grup band yang berwarna : '); readln(tebak1);
                if tebak1='ungu' then
                   writeln('Tebakan Anda Benar')
                else
                   writeln('Tebakan Anda Salah, Jawaban Yang Benar Adalah Ungu');
             end;

             2 :
             begin
                writeln('===========================');
                writeln('| ','Game Tebakan Katagori Sedang',' |');
                writeln('===========================');
                write('Soal Tebak : Bidadari bidadari tanpa dada maka akan menjadi : '); readln(tebak2);
                if tebak2='biri biri' then
                   writeln('Tebakan Anda Benar')
                else
                    writeln('Tebakan Anda Salah, Tebakan Yang Benar Adalah biri biri');
             end;


             3 :
             begin
                  writeln('============================');
                  writeln('| ','Game Tebakan Katagori Sulit', ' |');
                  writeln('============================');
                  write('Soal Tebak : Siapakah Penemu Dan Perancang Windowsm 8: '); readln(tebak3);
                  if tebak3='Steven Jay Sinofsky' then
                     writeln('Tebakan Anda Benar')
                  else
                      writeln('Tebakan Anda Salah, Tebakan Yang Benar adalah Steven Jay Sinofsky');

             end;
end;
end.
-------------------------------------------------------------------------------------------

Program USia
--------------------
program menghitung_umur;
uses wincrt;

var
     nama : string;
     umur,TL:integer;

begin
     writeln('masukan nama:');readln(nama);
     writeln('masukan tahun lahir:');readln(TL);

     umur:=2014-TL;
     writeln(umur);
     readkey;
end.


Older Posts