Contoh Koding Turbo Pascal

Menghitung nilai Sin dengan sudut radian

program sin(x);
uses crt;
const pi = 3.14;
var
x,rad,p1,tot : real;
n,i,faktor,p2,j : integer;
tanda : byte;

begin
clrscr;
writeln(‘ Menentukan nilai sin(x)’);
write(‘Nilai x = ‘); readln(x);
write(‘Masukkan pangkat = ‘); readln(n);
rad := pi*x/180;
i := 1;
tanda := 1;
while i <= n do
begin
p1 := exp(i*ln(rad));
faktor := 1;
for j := 1 to i do
faktor := faktor *j;
p2 := faktor;
tot := tot + (tanda*p1/p2);
tanda := (-1)*tanda;
i := i+2;
end;
writeln(‘Sin(‘,x:5:2,’) = ‘,tot:5:2);
readln;
end.

Klo ada pertanyaan langsung di komen…
🙂

Menghitung Luas dan keliling lingkaran

Program Luas_dan_Keliling_Lingkaran;
uses crt;
const pi = 3.14;
var
r,K,L : real;
begin
clrscr;
writeln(‘=============================’);
writeln(‘Menghitung Luas dan Keliling’);
writeln(‘—————————-‘);
write(‘Jari – jari = ‘); readln(r);
K := pi*2*r;
L := pi*r*r;
writeln(‘Keliling Lingkaran = ‘,K:5:2);
writeln(‘Luas Lingkaran = ‘,L:5:2);
writeln(‘=============================’);
readln;
end.

Klo ada yg belum dimengerti langsung j kasi komen…
🙂

Program Cek kelulusan dalam bahasa Pascal

program cek_kelulusan_siswa;
uses crt;
var
nama : string[25];
kelas : string[5];
no_absen : string[3];
n_tugas : byte;
n_u_hari : byte;
n_u_umum : byte;
rerata : real;
lulus : boolean;
predikat : string[20];
begin
clrscr;
writeln(‘====================================================’);
writeln(‘| Program Mengecek Kelulusan Siswa |’);
writeln(‘====================================================’);
writeln;
writeln(‘Input Data Siswa’);
writeln(‘—————-‘);
write(‘Nama : ‘); readln(nama);
write(‘Kelas : ‘); readln(kelas);
write(‘No Absen : ‘); readln(no_absen);
write(‘Nilai Tugas : ‘); readln(n_tugas);
write(‘Nilai Ulangan Harian : ‘); readln(n_u_hari);
write(‘Nilai Ulangan Umum : ‘); readln(n_u_umum);
rerata:=(n_tugas + 2 * n_u_hari + 3 * n_u_umum)/6;
if rerata >=70 then lulus:=true
else lulus:= false;
clrscr;
writeln(‘====================================================’);
writeln(‘| Program Mengecek Kelulusan Siswa |’);
writeln(‘====================================================’);
writeln;
writeln(‘ Siswa dengan’);
writeln(‘—————-‘);
writeln(‘Nama : ‘,nama);
writeln(‘Kelas : ‘,kelas);
writeln(‘No Absen : ‘,no_absen);
writeln(‘Nilai Tugas : ‘,n_tugas);
writeln(‘Nilai Ulangan Harian : ‘,n_u_hari);
writeln(‘Nilai Ulangan Umum : ‘,n_u_umum);
writeln(‘Rata – rata : ‘,rerata:0:2);
if lulus then
begin
if rerata < 80 then predikat:=’memuaskan’
else if rerata <90 then predikat:=’sangat memuaskan’
else predikat:=’dengan pujian’;
writeln(‘Dinyatakan Lulus dengan ‘,predikat);
end
else
writeln(‘Dinyatakan Tidak Lulus’);
readln;
end.

Penggunaan Record pada Turbo Pascal

uses crt;
type nilai = record
hari,tugas,umum,na : real;
end;
type mapel = record
kimia,basindo : nilai;
end;
type siswa = record
nama : string[25];
nis : string[3];
mp : mapel;
end;
var
i,n,a : byte;
student : array [1..100] of siswa;
stop : boolean;
b : string[4];
begin
stop := false;
Repeat
clrscr;
write(‘Banyak siswa : ‘); readln(n);
clrscr;
writeln(‘=======================================================================’);
writeln(‘NIS Nama Siswa Mata Pelajaran N.Hr N.Tgs N.Umum N.Akhir’);
writeln(‘———————————————————————–‘);
a:=4;
for i := 1 to n do
begin
with student[i] do
begin
readln(nis);
gotoxy(6,a);
readln(nama);
with mp do
begin
gotoxy(26,a);
writeln(‘Bahasa Indonesia’);
with basindo do
begin
gotoxy(44,a);
readln(hari);
gotoxy(50,a);
readln(tugas);
gotoxy(57,a);
readln(umum);
na:=(2*hari+tugas+3*umum)/6;
gotoxy(65,a);
writeln(na:3:2);
end;
with kimia do

Download source code lengkapnya di sini

Penggunaan If pada Turbo Pascal

Program Toserba;
uses crt;
var
pelanggan : char;
dis : string[3];
tot,blnja : real;
begin
clrscr;
writeln(‘ Dedix Toserba’);
writeln(‘=================================’);
write(‘Berbelanja sebesar = ‘); readln(blnja);
write(‘Pelanggan (y/t) ? : ‘); readln(pelanggan);
if pelanggan=’y’ then
begin
if blnja<=100.000 then
begin
tot := blnja -(10/100*blnja);
dis :=’20%’;
end
else

Download source lengkapnya di sini

Mencari nilai Sin(x) dengan x dalam radian

program sin(x);
uses crt;
const pi = 3.14;
var
x,rad,p1,tot : real;
n,i,faktor,p2,j : integer;
tanda : byte;

begin
clrscr;
writeln(‘ Menentukan nilai sin(x)’);
write(‘Nilai x = ‘); readln(x);
write(‘Masukkan pangkat = ‘); readln(n);
rad := pi*x/180;
i := 1;
tanda := 1;
while i <= n do

Download program lengkap ny di sini..

Contoh penggunaan procedure pada Turbo Pascal

program Menu_Program;
uses crt;
var
a:byte;
i,n,x : integer;
sigmay,sigmax,ratax,ratay,sigma,sigma1,sigma2,cov,varian : real;
rerata,hsl : real;
procedure hapus_layar;
begin
clrscr;
end;
procedure mean;
begin
writeln(‘Menghitung Mean dari beberapa Data’);
writeln(‘———————————-‘);
write(‘Masukkan banyak data yang akan di input :’);
readln(n);
sigma:=0;
for i:=1 to n do
begin
write(‘Input x’,i,’ :’);
readln(x);
sigma:=sigma + x;
end;
rerata := sigma/n;
writeln(‘Mean dari data – data terebut adalah ‘,rerata:5:2);
readln;

end;
procedure varians;
begin
writeln(‘Menentukan Varians’);
writeln(‘——————‘);
write(‘Masukan banyak data : ‘);
readln(n);
while n<2 do
begin
writeln(‘Banyak data harus lebih dari 2’);
write(‘Masukkan banyak data : ‘);
readln(n);
end;
sigma1 := 0;
sigma2 := 0;
for i := 1 to n do
begin
write(‘Masukkan data’,i,’ : ‘);
readln(x);
sigma1:=sigma1 + x;
sigma2:=sigma2 + (x*x);
end;
hsl :=(n*sigma2 – (sigma1*sigma1))/(n*(n-1));
writeln(‘Varians = ‘,hsl:5:2);
readln;
end;
procedure covar;
var
x,y,px,py,k : array [1..100] of real;
begin
write(‘n = ‘); readln(n);
sigmax := 0;
sigmay := 0;
for i := 1 to n do
begin
write(‘x = ‘); readln(x[i]);
write(‘y = ‘); readln(y[i]);
sigmax := sigmax + x[i];
sigmay := sigmay + y[i];
end;
ratax := sigmax/n;
ratay := sigmay/n;
sigma := 0;
for i := 1 to n do
begin
px[i] := x[i] – ratax;
py[i] := y[i] – ratay;
k[i] := px[i]*py[i];
sigma := sigma + k[i];
end;

Download source code lengkapnya di sini..

Ini contoh prosedur program statistik..Keren kan..

Perkalian matrix

uses crt;
var
a,b,c : array [1..50,1..50] of integer;
i,j,k,x,y,z : integer;
begin
clrscr;
writeln(‘Ukuran matrix A’);
write(‘Baris : ‘); readln(x);
write(‘Kolom : ‘); readln(y);
writeln;
writeln(‘Ukuran matrix B’);
writeln(‘Baris : ‘,y);
write(‘Kolom : ‘); readln(z);
for i:=1 to x do
for j:=1 to y do
begin
write(‘Elemen A[‘,i,’,’,j,’] : ‘);
readln(a[i,j]);
end;
writeln;
for i:=1 to y do
for j:=1 to z do
begin

Download source code lengkapnya di sini

Unit Adjoin

unit adjoin;

interface
type matrix = array [1..10,1..10] of integer;
mi=record
e : matrix;
end;
min = array [1..10,1..10] of mi;
var
i,j,row,col,x,y,k,l : byte;
A : matrix;
function pangkat(var x,n : integer):integer;
procedure tukar(var a,b : integer);
procedure transpose(var A:matrix);

implementation
function pangkat(var x,n : integer):integer;
var
p,i : integer;
begin
p := 1;
for i := 1 to n do
p := p * x;
pangkat:=p;
end;
procedure tukar(var a,b : integer);
var
temp : integer;
begin
temp := a;
a := b;
b := temp;
end;

procedure transpose(var A : matrix);
begin
for i := 2 to row do
for j := 1 to (i-1) do
tukar(A[i,j],A[j,i]);
end;

procedure minor(var m : min; A : matrix);
begin
for i := 1 to (row-1) do
for j := 1 to (col-1) do
begin
x:= 0;
for k :=1 to row do
begin
x:=x+1;
y := 0;
for l := 1 to col do
begin
y:=y+1;

Download source code unit lengkapnya di sini

Pada unit ini juga terdapat prosedur pencarian determinan dan invers matrik..
Keren kan…

Komen yaw..

Mencari Covarian

USES CRT;
var
n,i : integer;

x,sigma,sigmax,sigmay,ratax,ratay,cov : real;
procedure covar;
var
x,y,px,py,k : array [1..100] of real;
begin
write(‘n = ‘); readln(n);
sigmax := 0;
sigmay := 0;
for i := 1 to n do

Download program lengkapnya di sini ..

Administrasi mahasiswa

Program Administrasi_Mahasiswa;
uses crt;
const
pkkspp = 400000;
infospp = 600000;
elekspp = 500000;
bogaspp = 450000;
ptikspp = 500000;
pkkprak = 100000;
infoprak = 500000;
elekprak = 450000;
bogaprak = 600000;
ptikprak = 350000;
sehat : real = 10000;
var
nm,jur : string;
nojur : byte;
tahun :integer;
spp,prak : real;
tot : real;
begin
clrscr;
writeln(‘Administrasi Mahasiswa Fakultas Teknik dan Kejuruan’);
writeln(‘===================================================’);
write(‘Nama : ‘); readln(nm);
writeln(‘Keterangan Jurusan : ‘);
writeln(‘1. PKK’);
writeln(‘2. D3 Informatika’);
writeln(‘3. D3 Elektro’);
writeln(‘4. D3 Boga Perhotelan’);
writeln(‘5. PTIK’);
write(‘Jurusan (tulis no saja) : ‘); readln(nojur);
write(‘Tahun Masuk : ‘); readln(tahun);
if tahun<2004 then
begin
if nojur = 1 then
begin
spp := pkkspp;
jur := ‘PKK’
end
else if nojur = 2 then
begin
spp :=infospp;
jur := ‘D3 Informatika’;
end
else if nojur = 3 then
begin
spp :=elekspp;
jur := ‘D3 Elektro’
end
else if nojur = 4 then
begin
spp :=bogaspp;
jur := ‘D3 Boga Perhotelan’;
end
else if nojur= 5 then
begin
spp :=ptikspp;
jur := ‘PTIK’
end
else
writeln(‘Jurusan salah, tolong ulangi !!’);

end
else
begin
if nojur = 1 then
begin
spp := pkkspp;
prak:= pkkprak;
jur := ‘PKK’
end
else if nojur= 2 then
begin
spp :=infospp;
prak:= infoprak;
jur := ‘D3 Informatika’;
end
else if nojur = 3 then
begin
spp :=elekspp;
prak:=elekprak;
jur := ‘D3 Elektro’;
end
else if nojur = 4 then
begin
spp :=bogaspp;
prak:=bogaprak;
jur := ‘D3 Boga Perhotelan’;
end
else if nojur= 5 then
begin
spp :=ptikspp;
prak:=ptikprak;
jur := ‘PTIK’;
end
else
writeln(‘Jurusan salah, tolong ulangi !!’);
end;
tot := spp+prak+sehat;
writeln(‘Nama : ‘,nm);
writeln(‘Jurusan : ‘,jur);
writeln(‘Tahun Masuk : ‘,tahun);
writeln(‘Uang SPP : Rp. ‘,spp:7:2);
writeln(‘Uang Praktikum : Rp. ‘,prak:7:2);
writeln(‘Uang Kesehatan : Rp. ‘,sehat:7:2);
writeln(‘———————————‘);
writeln(‘Total Pembayaran : Rp. ‘,tot:7:2);
writeln(‘=================================================’);
readln;
end.

Mengetahui tahun kabisat

Program kabisat;
uses crt;
var
tahun : longint;
begin
clrscr;
writeln(‘=================================’);
writeln(‘Mengecek Tahun Kabisat atau Bukan’);
write(‘Masukan tahun : ‘); readln(tahun);
if tahun mod 400 = 0 then
writeln (‘Tahun ‘,tahun,’ merupakan kabisat’)
else if tahun mod 100 = 0 then
writeln (‘Tahun ‘,tahun,’ bukan merupakan kabisat’)
else if tahun mod 4 = 0 then

Download source cide lengkap nya di sini.

Unit Sorting

unit sort;
interface
uses crt;
type
larik = array [1..100] of integer;
var
i,j,n,y:byte;
copyL,l : larik;
procedure tukar(var a,b:integer);
procedure bubble_asc(var l:larik; n:byte);
procedure bubble_dsc(var l:larik; n:byte);
procedure select_min_asc(var l:larik; n:byte);
procedure select_min_dsc(var l:larik; n:byte);
procedure select_max_asc(var l:larik; n:byte);
procedure select_max_dsc(var l:larik; n:byte);
procedure insert_asc(var l:larik; n:byte);
procedure insert_dsc(var l:larik; n:byte);
procedure anim(var jml:byte);

implementation
procedure tukar(var a,b:integer);
var temp: integer;
begin
temp:=a;
a:=b;
b:=temp;
end;
procedure bubble_asc(var l:larik; n:byte);
begin
for i:=1 to n do
for j:=n downto i+1 do
if l[j] < l[j-1] then
begin
tukar(l[j],l[j-1])
end;
end;
procedure bubble_dsc(var l:larik; n:byte);
begin
for i:=1 to n do
for j:=n downto i+1 do
if l[j] > l[j-1] then
begin
tukar(l[j],l[j-1])
end;
end;

Pada unit ini akan terdapat prosedur – prosedur pengurutan data (sorting) dari ASC dan DESC. Juga terdapat prosedur untuk membuat animasi menu pada pascal. Keren kan….

Download source code dan *.TPU nya di sini.

Pengguaan case

Program tokoPD;
uses crt;
const dancowb = 10000;
dancows = 4250;
dancowk = 2100;
indob = 8500;
indos = 4000;
indok = 2025;
milob = 7750;
milos = 4000;
milok = 2200;
suprib = 9600;
supris = 5100;
suprik = 2600;
sustab = 17000;
sustas = 14500;
sustak = 8300;
ovalb = 11250;
ovals = 6500;
ovalk = 3200;
var
no : byte;
ukuran : char;
banyak : longint;
bayar : real;
begin
clrscr;
writeln(‘===============================================’);
writeln(‘ P & D Toserba’);
writeln(‘Susu yang tersedia di P & D Toserba : ‘);
writeln(‘1. Dancow’);
writeln(‘2. Indomilk’);
writeln(‘3. Milo’);
writeln(‘4. Suprima’);
writeln(‘5. Sustagen’);
writeln(‘6. Ovaltime’);
writeln(‘————————————–‘);
write(‘No susu : ‘); readln(no);
write(‘Ukuran (b:besar,s:sedang,k:kecil) : ‘); readln(ukuran);
write(‘Banyak barang : ‘); readln(banyak);
case no of
1 : begin
case ukuran of
‘b’ : bayar:=dancowb*banyak;
‘s’ : bayar:=dancows*banyak;
‘k’ : bayar:=dancowk*banyak;
else writeln(‘Ukuran salah !!’);
end;

Download source code lengkap nya di sini.

Menghitung Jumlah huruf pada sebuah kata / kalimat

uses crt;
var
kata : string;
h : array [‘A’..’Z’] of byte;
j : char;
i : byte;
begin
clrscr;
write(‘Input kata : ‘);readln(kata);
for i := 1 to length(kata) do
begin
for j := ‘A’ to ‘Z’ do
begin
if kata[i]= j then
begin

Download program lengkapnya di sini

Gaji Pegawai

Program Gaji;
uses crt;
var
nama,alamat : string;
gaji_pkok,tunjangan,pajak,bersih : real;
begin
clrscr;
write(‘Nama Pegawai : ‘); readln(nama);
write(‘Alamat : ‘); readln(alamat);
write(‘Gaji Pokok : ‘);readln(gaji_pkok);
tunjangan := 15/100*gaji_pkok;
pajak := 7.5/100*gaji_pkok;
bersih :=

Download source code lengkap nya di sini.

Metode Bagi dua

uses crt;
const epsilon=0.00001;
var
a,b,c,fa,fb,fc : real;

begin
writeln(‘Mencari akar dari persamaan f(x)=(x^3 + 1)/3’);
writeln(‘ Dengan Metode Bagi Dua’);
writeln(‘============================================’);
write(‘Masukkan batas awal(a) : ‘); readln(a);
fa:=(a*a + 1)/3;
writeln(‘f(a) = ‘,fa:0:5);
repeat
write(‘Masukkan batas akhir(b) : ‘); readln(b);
fb:=(b*b +1)/3;
writeln(‘f(b) = ‘,fb:0:5);
if fa*fb < 0 then
begin
writeln(‘Syarat OK (f(a)*f(b)<0)’);
writeln(‘f(a)*f(b) = ‘,(fa*fb):0:5);
end
else

Download di sini untuk source code lengkap nya..

Komen yaw..

Regula Falsi

program regula_falsi;
uses crt;
label ulang;
var
x1,x2,x3,y1,y2,y3 : real;
i : integer;
Ab :char;
data1 : real;
begin
ulang:
clrscr;
writeln(‘Tentukan nilai akar dari persamaan f(x)=x^3+x^2-3x-3=0 dengan Regula Falsi’);
write(‘Masukan nilai x1 = ‘);readln(x1);
y1 := x1 * x1 * x1 + x1 * x1 – 3 * x1 – 3;
writeln(‘ Nilai f(x1)= ‘,y1:0:4);
repeat
begin
write( ‘Masukan nilai x2 = ‘ ); readln(x2);
y2 := x2 * x2 * x2 + x2 * x2 – 3 * x2 – 3;
write(‘ Nilai f(x2)= ‘,y2:0:4);
end;
if (y1*y2)<0 then
Writeln(‘ Syarat Nilai Ok’)
else
Writeln(‘ Nilai X2 Belum Sesuai’);
until ( y1 * y2 ) <0;
writeln;
writeln(‘Penyelesaian persamaan karekteristik dengan metoda regula falsi’);
writeln(‘———————————————————————-‘);
writeln(‘ n x f(x) error ‘);
writeln(‘———————————————————————-‘);
repeat
begin
i:= i + 1; x3 := ( x2-( y2 / ( y2 – y1))*(x2-x1));
y3 := x3 * x3 * x3 + x3 * x3 – 3 * x3 – 3;
if i<10 then
writeln(‘ ‘,i,’ : ‘,x3,’ : ‘,y3,’ : ‘,abs(y3),’ : ‘)
else
writeln(i,’ : ‘,x3,’ : ‘,y3,’ : ‘,abs(y3),’ : ‘);
if ( y1 * y3 ) <0 then
begin
x2 := x3 ; y2 := y3 ;
end
else
begin
x1 := x3 ; y1 := y3;
end;
end;
until abs( y3 ) < 1E-08;
writeln(‘———————————————————————-‘);
writeln(‘Akar persamaannya= ‘,x3);
writeln(‘Errornya=’ ,abs( y3 ));
writeln(‘———————————————————————-‘);
writeln(‘Apakah anda ingin mengulangi (y/t): ‘);
readln(ab);
if (ab=’y’) or (ab=’Y’) then
goto ulang;
end.

Faktorial

Program FAKTORIAL;

uses crt;

var Faktor : real;
Cacah,
Bil_Awal,
Bil_Akhir,
Konter,
Baris : integer;

begin
clrscr;
writeln(‘MEMBUAT TABEL FAKTORIAL’);
write(‘BILANGAN AWAL : ‘);readln(Bil_Awal);
write(‘BILANGAN AKHIR : ‘);readln(Bil_Akhir);writeln;

writeln(‘ TABEL FAKTORIAL’);
writeln;
writeln(‘——————————–‘);
writeln(‘ BILANGAN HARGA FAKTORIAL’);
writeln(‘——————————–‘);writeln;
Baris := 11;
for Cacah := Bil_Awal to Bil_Akhir do

Mau tau lanjutannya download aj y..Di sini..

Selasa, 23 September 2008

Unit Search

unit search;

interface

uses crt;
type larik = array [1..100] of integer;
var
i,n, y : byte;
x : integer;
l : larik;
found: boolean;

procedure sequential (var l : larik; x : integer; n:byte);
procedure binary (var l : larik;x: integer; n:byte);

implementation

procedure sequential (var l : larik; x : integer; n:byte);
begin
i:=1;
found := false;
while (not found) and (i<=n) do
begin
if x=l[i] then
found := true
else
i := i +1;
end;
clrscr;
if found then
writeln(‘Elemen yang bernilai ‘,x,’ berada pada index ke ‘,i)
else
writeln(‘Elemen yang bernilai ‘,x,’ tidak ada pada semua index’);
writeln(‘===========================’);
writeln(‘ Index ke- Nilai Data’);
writeln(‘—————————‘);
y := 5;
for i := 1 to n do
begin
gotoxy(6,y);
writeln(i);
gotoxy(21,y);
writeln(l[i]);
inc(y);
end;
writeln(‘===========================’);
end;

procedure binary (var l : larik; x :integer; n:byte);

var
a,iA,iAk,iT : byte;
kondisi : char;
temp : integer;
j : byte;
begin
{prosedur mengurutkan data}
{—————————————}
for i := 1 to (n-1) do
for j := n downto (i+1) do
if l[j] < l[(j-1)] then
begin
temp := l[j];
l[j] := l[(j-1)];
l[(j-1)] := temp;
end;
{—————————————}
a:=0;
iA :=1;
iAk :=n;
found :=false;
while ( not found) and (iA<=iAk) do
begin
iT:=(iA+iAk) div 2;
inc(a);
writeln(‘Iterasi ke ‘,a);
writeln(‘iA = ‘,iA);

Unit di atas adalah unit yang berisi prosedur – prosedur searching data. Yaitu prosedur binary dan sequential. Download di sini untuk source code dan file *.TPU nya.

Untuk memanggil Unit tersebut maka diperlukan sebuah program.

Program searching;
uses crt,search;
var
option : char;

begin
clrscr;
write(‘Masukkan banyak data : ‘);
readln(n);

Download source code nya di sini.

Iklan

Tinggalkan komentar

Belum ada komentar.

Comments RSS TrackBack Identifier URI

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

Logo WordPress.com

You are commenting using your WordPress.com account. Logout / Ubah )

Gambar Twitter

You are commenting using your Twitter account. Logout / Ubah )

Foto Facebook

You are commenting using your Facebook account. Logout / Ubah )

Foto Google+

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

  • Kalender

    • Oktober 2017
      S S R K J S M
           
       1
      2345678
      9101112131415
      16171819202122
      23242526272829
      3031  
  • Cari