Program Linked List

Disini saya akan memberikan listing program penghapusan linked list yang diketahui lokasinya jika ruang bebas (avail) tersebut terurut dengan menggunakkan bahasa pemrograman pascal. Perogram ini dibuat terkait dengan mata kuliah struktur data.

LISTING PROGRAM

program link_list;
uses crt;
const
MAX = 1000;
var
simpul,i,j,chk,counter,avail,avail2,start,pil,ruang,x,t,nos,temp : integer;
hapus : char;
info:array [0..MAX] of integer;
next:array [0..MAX] of integer;
procedure check;
begin
x:=0;
counter:=0;
avail:=0;
while counter <= ruang do
begin
counter:=counter+1;
if info[counter] <> 0 then
begin
x:=x+1;
end
else
begin
avail:=avail+1;
end;
end;
avail2:=1;
while info[avail2] <> 0 do
begin
avail2:=avail2+1;
end;
end;
procedure insert;
label 10,20;
begin
clrscr;
for i:= 1 to simpul do
begin
20:
write(‘Masukkan Nomor Simpul yang akan diisi : ‘);
readln(x);
if info[x] <> 0 then
begin
writeln(‘Simpul Sudah Terisi !’);
goto 20;
end
else if x > ruang then
begin
writeln(‘Simpul Tidak Tersedia !’);
goto 20;
end;
write(‘Masukkan Info Simpul ke ‘,x,’ : ‘);
readln(info[x]);
10:
write(‘Masukkan next ‘,x,’ : ‘);
readln(chk);
if (next[chk] = x) or (chk=x) then
begin
writeln(‘Input Salah !’);
goto 10;
end
else
begin
next[x]:=chk;
end;
end;
end;
procedure tampil;
begin
writeln(‘Linked List ‘);
writeln;
check;
if x = 0 then
begin
writeln(‘Linked List Hampa !’);
end
else
begin
i := start;
write(‘|’,start,’|');
while info[i] <> 0 do
begin
write(‘->|’,info[i],’|',next[i],’|');
i:=next[i];
end;
end;
writeln;
end;
procedure bebas;
begin
writeln(‘Avail List ‘);
writeln;
if avail2 > ruang then
begin
writeln(‘Ruang Penuh !’);
end
else
begin
write(‘|’,avail2,’|');
for i := 1 to ruang do
begin
if info[i] = 0 then
begin
t:=i+1;
while info[t] <> 0 do
begin
t:=t+1;
end;
if t <= ruang then
begin
next[i]:=t;
end
else
begin
next[i]:=0;
end;
write(‘->|’,info[i],’|',next[i],’|');
end;
end;
end;
end;
procedure tabel;
begin
clrscr;
writeln(‘ | info | next |’);
for i := 1 to ruang do
begin
if info[i] = 0 then
begin
t:=i+1;
while info[t] <> 0 do
begin
t:=t+1;
end;
if t <= ruang then
begin
next[i]:=t;
end
else
begin
next[i]:=0;
end;
end;
writeln(i,’|',info[i],’ |’,next[i],’ |’);
end;
end;
procedure delete;
label ulangi;
var
loc:integer;
begin
check;
if x = 0 then
begin
gotoxy(33,21); writeln(‘Linked List Hampa !’);
readkey;
end
else
begin
ulangi:
gotoxy(22,21); write(‘Masukkan Lokasi Yang Akan Dihapus : ‘);readln(loc);
if info[loc] = 0 then
begin
gotoxy(33,23);writeln(‘Lokasi Salah !’);
goto ulangi;
end;
counter:=1;
while next[counter] <> loc do
begin
counter:=counter+1;
end;
if start = loc then start:=next[loc];
next[counter]:=next[loc];
next[loc]:=0;
info[loc]:=0;
end;
end;
begin
clrscr;
gotoxy(36,6); writeln(‘KELOMPOK 6 ‘);
gotoxy(20,8); writeln(‘PENGHAPUSAN SIMPUL YANG DIKETAHUI LOKASINYA’);
gotoxy(34,10); writeln(‘ FAHMY NUGRAHA ‘);
gotoxy(34,11); writeln(‘ HERI SANTOSO’);
gotoxy(33,12); writeln(‘YUSTI FITRIYANI NAMPIRA ‘);
gotoxy(25,17); write(‘Masukkan Banyak Ruang Linklist : ‘);readln(ruang);
clrscr;
while pil <> 5 do
begin
clrscr;
gotoxy(20,5); writeln(‘=========================================’);
gotoxy(33,6); writeln(‘MENU LINKLIST’);
gotoxy(20,7); writeln(‘=========================================’);
gotoxy(28,9); writeln(’1. Input ‘);
gotoxy(28,10); writeln(’2. Cetak ‘);
gotoxy(28,11); writeln(’3. Hapus Simpul’);
gotoxy(28,12); writeln(’4. Hapus Semua Isi Simpul ‘);
gotoxy(28,13); writeln(’5. Exit ‘);
gotoxy(20,15); writeln(‘=========================================’);
gotoxy(28,19); write(‘Masukkan Pilihan Anda : ‘); readln(pil);
case pil of
1 : begin
clrscr;
gotoxy(18,8); write(‘Masukkan Banyak Simpul yang akan di Input : ‘);readln(simpul);
check;
if simpul > ruang then
begin
gotoxy(18,10); writeln(‘Error ! Melebihi batas ruang !’);
readkey;
end
else if simpul > avail then
begin
gotoxy(18,10); writeln(‘Error ! Avail Tidak Cukup !’);
readkey;
end
else
begin
insert;
end;
end;
2: begin
gotoxy(33,21);write(‘Masukkan START : ‘);
readln(start);
tabel;
writeln;
tampil;
writeln;
bebas;
readkey;
end;
3: begin
delete;
clrscr;
writeln(‘Setelah Penghapusan !’);
writeln;
writeln;
tampil;
writeln;
bebas;
readkey;
end;
4: begin
gotoxy(26,21);write(‘Hapus semua simpul ? (Y/N) : ‘);
readln(hapus);
if ( hapus=’y') or (hapus=’Y') then
begin
for i:= 1 to ruang do
begin
info[i] := 0;
next[i] := 0;
end;
gotoxy(29,23);writeln(‘Semua simpul TERHAPUS ‘);
readkey;
end;
end;
end;
end;
end.
Berikut ini adalah output dari program penghapusan linked list yang diketahui lokasinya jika ruang bebas (avail) terurut.

Output program

Pada Awal program, saya akan menampilkan judul dan nama pembuat program. Kemudian kita di haruskan memasukan banyaknya ruang link list tersebut, dan pada contoh ini kita akan memasukan banyak ruang tersebut adalah 7.

Lalu jika kita telah menginput banyaknya ruang, maka program akan menampilkan menu linked list tersebut. Kita dapat memilih salah satu menu yang terdapat pada linked list tersebut. Tapi terlebih dahulu kita harus memasukkan datanya ke dalam linked list, karena data defalut yang ada pada linked list tersebut masih 0. Jika kita ingin memasukkan data, maka kita bisa memilih menu linked nomor 1.

Setelah kita memasuki menu input, maka program berlanjut untuk menanyakan banyaknya simpul yang akan di input. Disini akan menentukan banyaknya linked list yang akan terisi. Pada contoh ini saya mengisikan banyaknya simpul adalah 4.

Selanjutnya kita akan masukan nomor simpul yang akan diisi dan memasukan informasi dari simpul tersebut. Kita juga aka memasukan next dari simpul tersebut yang digunakan untuk menunjukan arah simpul berikutnya. Disini kita akan melakukan pengisian data sebanyak 4 kali sesuai banyaknya simpul yang td telah kita tentukan.

Kemudian program akan kembali ke menu utama setelah kita memasukan data-data tersebut. Kita akan memilih menu 2 untuk mencetak data yang telah kita input sebelumnya, dan setelah kita memilih menu cetak maka sebelum itu kita di haruskan mengiput dulu start dari linked list tersebut. Start digunakan untuk menentukan simpul pertama yang ada pada linked list tersebut.

Kemudian program akan menampilkan data-data yang telah kita masukan sebelumnya. Data akan tersusun sesuai linked list yang telah kita tentukan, tapi pada ruang bebas (avail) tersebut akan tercetak terurut dari angka terkecil.

Kemudian setelah program menampilkan data yang telah kita input, maka program akan kembal i ke menu utama. Langkah selanjutnya adalah menghapus simpul yang ada pada linked list dengan memilih menu 3. Lalu setelah memilih menu 3, program akan menanyakan lokasi simpul mana yang akan dihapus. Pada contoh program ini kita menghapus lokasi simpul 3.

Kemudian program ini akan menampilkan linked list setelah proses penghapusan lokasi tersebut. Simpul yang terhapus tersebut akan masuk ke ruang bebas (avail) dan avail tersebut akan tersusun secara terurut.

Kemudian jika kita ingin menghapus semua isi simpul yang ada pada linked list tersebut kita dapat memilih menu 4 yang berarti akan menghapus semua data yang telah kita masukkan. Lalu kita dapat memasukkan kembali data baru yang kita inginkan dengan mengulang langkah-langkah diatas.

Selanjutnya untuk exit dan keluar dari program ini, kita dapat memilih menu 5.

Bentuk Perulangan & Penyeleksian Kondisi

1. Bentuk – bentuk Perulangan

Dalam hampir setiap program yang kompleks mutlak memerlukan suatu perulangan dan percabangan. Tujuan perulangan disini adalah untuk mengulang statement atau blok statement berulang kali sesuai
sejumlah yang ditentukan pemakai. Dalam materi ini akan memberikan gambaran konsep dasar dari pengertian diatas.

a) Perulangan For.
Perulangan dengan statemen For digunakan untuk mengulang statemen atau suatu blok statemen berulang kali. Perulangan dengan statemen For dapat berupa perunlangan positif dan perulangan negatif.

• Perulangan For positif
contoh : perulangan positif untuk satu statement :
Uses Crt;
Var
i : Integer;
Begin
For i := 1 To 5 Do Writeln ('I Love Dinda’);
END.
Maka bila program diatas dicompile
hasilnya :
I Love Dinda
I Love Dinda
I Love Dinda
I Love Dinda
I Love Dinda
Penjelasan : Berati statemen I Love Dinda akan diulang sebanyak 5 kali yaitu dengan menghitung nilai i dari i ke 1 sampai nilai i terakhir yaitu i ke 5.

# Contoh dengan menggunakan blok statement: cara penulisannya dengan pada awal blok diawali dengan Begin dan pada akhir blok diakhiri dengan End;
Uses Crt;
Var
i : Integer;
Begin
For i:= 1 To 10 Do
Begin
Writeln ('I Love Dinda'); { blok statement }
End;
End.
Hasil yang akan didapat akan sama dengan contoh yang pertama, tapi yang harus diingat disini untuk penggunaan blok pada perulangan For biasanya mempunyai banyak statement [lebih dari 1 statement]


# Contoh 3 : Penggunaan perulangan For dalam blok statement untuk membuat tabel

Uses Crt;
Var
a,b,c : Integer;
bagi : Real;
Begin
Writeln('----------------------------------------------');
Writeln(' a a*a a*a*a 1/a ');
Writeln('----------------------------------------------');
For a := 1 To 10 Do
Begin
b:= a*a;
c:=a*a*a;
bagi := 1/a;
Writeln(a:4,c:10,d:10,bagi:12:3);
End;
Writeln ('----------------------------------------------');
End.
maka hasilnya :
----------------------------------------------
a a*a a*a*a 1/a
----------------------------------------------
1 1 1 1.000
2 4 8 0.500
3 9 27 0.333
4 16 64 0.250
5 25 125 0.200
6 36 216 0.167
7 49 343 0.143
8 64 512 0.125
9 81 729 0.111
10 100 1000 0.100
----------------------------------------------
• Perulangan For negatif : Perulangan negatif adalah perulangan dengan menghitung (counter) dari besar ke kecil.

Statement yang digunakan adalah For-DownTo-Do
contoh :
Uses Crt;
Var
i : Integer;
Begin
For i := 10 DownTo 1 Do Write (i:3);
End.
Hasil :
10 9 8 7 6 5 4 3 2 1

• Perulangan For tersarang
Perulangan For tersarang adalah perulangan For yang berada pada perulangan yang lainnya. Perulangan yang lebih dalam akan diproses terlebih dahulu sampai habis, kemudian perulangan yang lebih luar baru akan bertambah, mengerjakan perulangan yang lebih dalam lagi mulai dari nilai awalnya dan seterusnya.
Contoh :
Var
a,b : Integer;
Begin
For a := 1 To 3 Do
Begin
For b := 1 To 2 Do Write (a :4,b:2);
Writeln;
End;
End.
Hasil :
1 1 1 2
2 1 2 2
3 1 3 2

• Perulangan While - Do
Penyeleksian kondisi digunakan untuk agar program dapat menyeleksi kondisi, sehingga program dapat menentukan tindakan apa yang harus dikerjakan, tergantung dari kondisi yang diseleksi tersebut. Perulangan While – Do tidak dilakukan jika kondisi tidak terpenuhi.
Contoh :
Uses Crt;
Var i : Integer;
Begin
i := 0;
While < 5 do
Begin
Write (i:3);
Inc (i); { sama dengan i:=i+1 }
End;
End.
Hasilnya :
0 1 2 3 4

• Perulangan While – Do tersarang
Perulangan While – Do tersarang (nested While - Do) merupakan perulangan While – Do yang satu di dalam perulangan While – Do yang lainnya.
Contoh :
Uses Crt;
Var
a, b : Integer;
Begin
ClrScr;
a:=1;
b:=1;
While a < 4 Do{ loop selama a masih lebih kecil dari 4 }
Begin
a := a+1;
While b < 3 Do{ loop selama b masih lebih kecil dari 3 }
Begin
Write (a:3,b:2);
b:=b+1;
End;
End;
Readln;
End.

• Perulangan Repeat - Until.
Repeat – Until digunakan untuk mengulang statement-statemen atau blok statement sampai (Until) kondisi yang diseleksi di Until tidak terpenuhi.
Sintak dari statement ini adalah :
Contoh :
Var
i : Integer;
Begin
i:=0;
Repeat
i:= i+1;
Writeln (i);
Until i=5;
End.
hasil :
1
2
3
4
5

• Repeat – Until tersarang
Repeat – Until tersarang adalah suatu perulangan Repeat - Until yang satu berada didalam perulangan Repeat – Until yang lainnya.
Contoh :
Var
a,b,c : Real;
Begin
Writeln('========================================');
Writeln(' sisi A sisi B Sisi C ');
Writeln (' =======================================');
a:= 1;
Repeat { perulangan luar }
b := 0;
Repeat{ perulangan dalam }
c:=Sqrt (a*a+b*b);
Writeln (a:6:2, b:9:2, c:9:2);
b:=b+5;
Until b>25; { berhenti jika b lebih besar dari 5 untuk
perulangan dalam }
a:=a+1;
Until a>3; { berhenti jika a lebih besar dari 3 untuk
perulangan luar }
Writeln(' =======================================');
End.

• Percabangan

 If - Then
Bentuk struktur If – Then adalah sebagai berikut :
If Kondisi Then Statement
Ungkapan adalah kondisi yang diseleksi oleh statement If. Bila kondisi yang diseleksi terpenuhi, maka statement yang mengikuti Then akan diproses, sebaliknya bila kondisi tidak terpenuhi, maka yang akan diproses statement berikutnya.
Misalnya :
If Pilihan = 2 Then
Begin{ jika kondisi terpenuhi, Yaitu jika pilihan = 2 }
......
......
End
Else{ jika kondisi tidak terpenuhi, yaitu jika pilhan tidak sama dengan 2}
Begin
.......
.......
End;
Contoh Program :
Uses Crt;
Var
Nilai : Real;
Begin
Write ('Jumlah Nilai :');
Readln (nilai); { Pemasukan data }
If nilai > 60 Then { seleksi kondisi variabel nilai }
Writeln('Lulus') { Dilaksanakan jika nilai lebih besar dari 60 }
Else
Writeln('Tidak lulus'); { Dilaksanakan jika variabel nilai lebih kecil dari 60 }
End.
Hasil :
Jika kita Memasukan 40 pada varibel nilai, Maka program diatas akan mencetak Tidak lulus.

 If tersarang (nested If)
Struktur If tersarang merupakan bentuk dari suatu statement If berada di dalam lingkungan statemen If yang lainya. Bentuk statement If tersarang sebagai berikut :

If kodisi1 Then atau If Kondisi1 Then
If kondisi2 Then Begin
statemen1 IF kondisi2 Then
Else statemen1
statemen2; Else
statemen2
End;

 Case - Of
Struktur Case – Of mempunyai suatu ungkapan logika yang disebut dengan selector dan sejumlah statemen yang diawali dengan suatu label permasalahan (case label) yang mempunyai tipe sama dengan selector.
Statement yang mempunyai case label yang bernilai sama dengan case label yang bernilai sama dengan nilai selector akan diproses sedang statemen yang lainya tidak.

Bentuk struktur dari Case - Of:

Case Variabel Kondisi Of
Case – Label 1; Statement 1;
Case – Label 2; Statement 2;
Case – Label 3; Statement 3;
Case – Label 4; Statement 4;
........
........
Case – Label n ; Statement n ;
End ; { end dari case }

Daftar Case label dapat berupa konstanta, range dari konstanta yang bukan bertipe real.
Contoh program ;
Program nilai;
Var
nil : Char ;
Begin
Write ('Nilai Numerik yang didapat :');
Readln (nil);
Case nil Of
'A': Writeln ('Sangat Baik’);
'B': Writeln('Baik’);
'C': Writeln('Cukup');
'D': Writeln('Kurang');
'E': Writeln('Sangat Kurang');
End;
End.
hasil : Nilai Numerik yang didapat : B Input Baik
Contoh Listing Program untuk Dicoba

1. Program input data dengan array.
Program Pemakaian_Array_Untuk_10_data_dengan_menggunakan_For;

Uses Crt;
Const
garis='------------------------------------------------------';
Var
nil1,nil2 : Array [1..10] Of 0..100; {Array dgn Type subjangkauan}
npm : Array [1..10] Of String [8];
nama : Array [1..10] Of String [15];
n,i,bar : Integer;
jum : Real;
tl : Char;
Begin
ClrScr;
{ pemasukan data dalam array }
Write ('Mau Isi Berapa Data:');
Readln (n);
For i:= 1 To n Do
Begin
ClrScr;
GotoXY(30,4+1); Write('Data Ke-:',i:2);
GotoXY(10,5+i); Write('NPM :'); Readln (npm[i]);
GotoXY(10,6+i); Write('Nama :'); Readln (nama[i]);
GotoXY(10,7+i); Write('Nilai 1 :'); Realdn(nil 1[i]);
GotoXY(10,8+i); Write('Nilai 2 :'); Readln(nil 2[i]);
End;
{ proses data dalam array }
ClrScr;
GotoXY(5,4); Write(Garis);
GotoXY(5,5); Write ('No');
GotoXY(9,5); Write ('NPM');
GotoXY(18,5); Write ('Nama');
GotoXY(34,5); Write ('Nilai 1');
GotoXY(41,5); Write ('Nilai 2');
GotoXY(47,5); Write ('Rata');
GotoXY(54,5); Write ('Abjad’);
GotoXY(5,6); Write (Garis);
{ proses Cetak isi array dan seleksi kondisi }
bar := 7;
For i:= 1 To n Do
Begin
jum:=(nil1[i]+nil2[i])/2;
If jum>= 90 Then tl:='A'
Else
If jum>80 Then tl:='B'
Else
If jum>60 then tl:='C'
Else
If jum 50 Then tl:='D'
Else
tl:='E';
{ cetak hasil yang disimpan di array dan hasil }
{ penyeleksian kondisi }
GotoYX(5,bar); Writeln(i:2);
GotoYX(9,bar); Writeln (NPM[i]);
GotoYX(18,bar); Writeln (NAMA[i]);
GotoYX(34,bar); Writeln (NIL1[i]:4);
GotoYX(41,bar); Writeln (NIL2[i]:4);
GotoYX(47,bar); Writeln (jum:5:1);
GotoYX(54,bar); Writeln (tl);
bar:=bar+1;
End;
GotoXY(5,bar+1);Writeln(garis);
Readln;
End.

2. Program jendela bergerak.
Program Window_Bergerak_dgn_delay;
Uses Crt;
Var i : Integer;
Begin
For i:=1 To 15 Do
Begin
Sound (i*100);
Delay (100);
NoSound;
End;
TextBackGround(black);
ClrScr;
For i := 1 To 9 Do
Begin
TextBackGround(white);
Window (42-i*4,10-i,38+i*4,15+i);
ClrScr;
Delay(100);
End;
TextColor(15);
GotoXY(28,2);Writeln('c');
GotoXY (8,3); Writeln ('3');
GotoXY (28,4); Writeln ('A');
TextColor(black);
GotoXY (44,3); Writeln ('3');
GotoXY (44,2); Writeln ('&');
TextColor (29,4); Writeln ('U');
TextColor (red*25);
GotoXY (30,3); Writeln ('B E L A J A R');
TextColor (black);
GotoXY (5,5); Write('c');
For i := 6 To 64 Do
Begin
GotoXY (i,5); Writeln ('');
End;
For i := 6 To 20 Do
Begin
GotoXY(5,i); Writeln('3 ');
End;
GotoXY (5,21); Writeln (' ');
TextColor(white);
GotoXY(65,5); Write('U');
For i := 6 To 65 Do
Begin
GotoXY (i,21); Writeln(' `);
End;
For i := 6 To 20 Do
Begin
GotoXY(65,i); Writeln('3');
End;
GotoXY (65,21); Writeln ('c');
TextColor(yellow);
Readln;
End.

FUNGSI-FUNGSI STRING PADA PASCAL

PENDAHULUAN
Pascal adalah sebuah bahasa pemograman tempo dulu. Mungkin itu saja yang dapat
saya definiskan, karena saya yakin pembaca lebih tahu mengenai definisi lengkap dari
Pascal. Saya ingin berbagi ilmu walaupun cuma sedikit tentang pemograman dengan
Pascal.
Melalui tulisan ini, saya mencoba untuk mengulas program, prosedur dan fungsi
menarik yang bisa Anda coba dan terapkan dalam pemograman Pascal.
Beberapa yang dapat saya sampaikan, diantaranya:
1. Fungsi-fungsi String
2. Fungsi-fungsi Date
3. Fungsi-fungsi Konversi
4. Program Permainan
Semoga bahasan ini menjadi menarik dan bermanfaat untuk Anda semua.
FUNGSI-FUNGSI STRING
Berikut ini adalah fungsi-fungsi untuk memanipulasi data String. Jalankan aplikasi
Pascal Anda, ketikkan kode berikut:
PROGRAM MANIPULASISTRING;
USES CRT;
a. Lower Case
Fungsi ini akan mengubah string yang diinputkan menjadi Lower Case (huruf kecil).
Ketikkan fungsi berikut ini:
b. Upper Case
Fungsi ini akan mengubah string yang diinputkan menjadi Upper Case (huruf besar).
Ketikkan fungsi berikut ini:
c. Proper Case
Fungsi ini akan mengubah string yang diinputkan menjadi Proper Case (huruf besar
untuk huruf awal setiap kata). Ketikkan fungsi berikut ini:

FUNCTION LCASE(S:STRING):STRING;
VAR I:INTEGER;
BEGIN
FOR I:= 1 TO LENGTH(S) DO
IF (S[I] >= 'A') AND (S[I] <= 'Z') THEN
INC(S[I], 32);
LCASE := S;
END;
FUNCTION UCASE(S:STRING):STRING;
VAR I:INTEGER;
BEGIN
FOR I:= 1 TO LENGTH(S) DO
IF (S[I] >= 'a') AND (S[I] <= 'z') THEN
DEC(S[I], 32);
UCASE := S;
END;

Untuk mencoba fungsi-fungsi di atas, ketikkan program utama sebagai berikut:
{program utama}
BEGIN
CLRSCR;
WRITE(LCASE('Created By vian sastra '));
WRITE(UCASE('Created By vian sastra '));
WRITE(PCASE('Created By vian sastra '));
READLN;
END.

Lihatlah tampilan pada layar monitor Anda!
Baris pertama, tiap kata ditulis dengan huruf kecil, baris ke-2 tiap kata ditulis dengan
huruf besar, dan baris ke-3, tiap kata hanya huruf awal saja yang ditulis dengan huruf
besar.
FUNCTION PCASE(S:STRING):STRING;
VAR I, J:INTEGER;
BEGIN
IF (S[1] >= 'a') AND
(S[1] <= 'z') THEN
DEC(S[1], 32);
FOR I:= 2 TO LENGTH(S) DO
IF (S[I] >= 'A') AND
(S[I] <= 'Z') THEN
INC(S[I], 32);
FOR I:= 2 TO (LENGTH(S)-1) DO
IF (S[I] = ' ') THEN
BEGIN
J := I;
IF (S[J + 1] >= 'a') AND
(S[J + 1] <= 'z') THEN
DEC(S[J + 1], 32);
END;
PCASE := S;
END;

FUNGSI-FUNGSI DATE
Berikut ini adalah fungsi-fungsi untuk memanfaat sistem date dari unit Dos, untuk
menampilkan tanggal atau hari sesuai data pada sistem komputer. Jalankan aplikasi
Pascal Anda, ketikkan kode berikut:

PROGRAM TAMPILTANGGAL;
USES CRT, DOS;
(* FUNGSI UNTUK MENGKONVERSI
NILAI INTEGER MENJADI STRING *)
FUNCTION INTTOSTR(I: LONGINT): STRING;
VAR
S: STRING[12];
BEGIN
STR(I, S);
INTTOSTR := S;
END;

a. Menampilkan Tanggal Sistem
Fungsi ini akan menampilkan tanggal dari sistem komputer Anda.
b. Menampilkan Nama Hari
Fungsi ini akan menampilkan tanggal dari sistem komputer Anda.

FUNCTION TANGGAL:STRING;
VAR
Y, M, D, DOW : Word;
BEGIN
GETDATE(Y,M,D,DOW);
TANGGAL := INTTOSTR(D) + '-'
+ INTTOSTR(M) + '-' + INTTOSTR(Y);
END;
FUNCTION HARI_INI:STRING;
CONST
DAYS : ARRAY [0..6] OF STRING[9] =
('MINGGU','SENIN','SELASA',
'RABU','KAMIS','JUMAT',
'SABTU');
VAR
Y, M, D, DOW : Word;
BEGIN
GETDATE(Y,M,D,DOW);
HARI_INI := 'HARI INI : ' + DAYS[DOW] + ', ';
END;

Untuk mencoba fungsi-fungsi di atas, ketikkan program utama sebagai berikut:
(* program utama *)
BEGIN
CLRSCR;
WRITELN(HARI_INI, TANGGAL);
READLN;
END.
Lihatlah tampilan pada layar monitor Anda!

FUNGSI-FUNGSI KONVERSI
Berikut ini adalah fungsi-fungsi untuk mengkonversi suatu nilai ke nilai lain. Jalankan
aplikasi Pascal Anda, ketikkan kode berikut:

PROGRAM KONVERSI;
USES CRT, STRINGS;
VAR MASUKAN : INTEGER;
(* FUNGSI UNTUK MENGKONVERSI
NILAI {INTEGER} MENJADI STRING *)
FUNCTION INTTOSTR(I: LONGINT): STRING;
VAR
S: STRING;
BEGIN
STR(I, S);
INTTOSTR := S;
END;

a. Konversi Desimal ke Angka Romawi
Fungsi ini akan mengkonversi suatu nilai bilangan (decimal) ke angka Romawi. Contoh:
1234 menjadi: MCCXXXIV.
(* FUNGSI UNTUK MENGKONVERSI
BILANGAN DESIMAL MENJADI ANGKA ROMAWI*)
FUNCTION CONVROMAN(INTANGKA : INTEGER): STRING;
VAR
I: INTEGER;
INTSERIBU, INTLIMARATUS : INTEGER;
INTSERATUS, INTLIMAPULUH : INTEGER;
INTSEPULUH, INTLIMA, INTSATU : INTEGER;
STRSERIBU, STRLIMARATUS :STRING;
STRSERATUS, STRLIMAPULUH : STRING;
STRSEPULUH, STRLIMA, STRSATU : STRING;
STRROMAWI : STRING;
BEGIN
I := 0;
STRROMAWI :='';INTSERIBU := 0;
INTLIMARATUS := 0;INTSERATUS := 0;
INTLIMAPULUH := 0;INTSEPULUH := 0;
INTLIMA := 0;INTSATU := 0;
STRSERIBU :='';STRLIMARATUS :='';
STRSERATUS :='';STRLIMAPULUH :='';
STRSEPULUH :='';STRLIMA :='';
STRSATU :='';
(*===============================*)
INTSATU := INTANGKA;
INTSERIBU := INTANGKA DIV 1000;
INTSATU := INTSATU - (INTSERIBU * 1000);
INTLIMARATUS := INTSATU DIV 500;
INTSATU := INTSATU - (INTLIMARATUS * 500);
INTSERATUS := INTSATU DIV 100;
INTSATU := INTSATU - (INTSERATUS * 100);
INTLIMAPULUH := INTSATU DIV 50;
INTSATU := INTSATU - (INTLIMAPULUH * 50);
INTSEPULUH := INTSATU DIV 10;
INTSATU := INTSATU - (INTSEPULUH * 10);
INTLIMA := INTSATU DIV 5;
INTSATU := INTSATU - (INTLIMA * 5);
(*=================================*)
FOR I := 0 TO INTSERIBU-1 DO
STRSERIBU := STRSERIBU + 'M';
IF INTSERATUS <> 4 THEN
FOR I := 0 TO INTLIMARATUS-1 DO
STRLIMARATUS := STRLIMARATUS + 'D';
FOR I := 0 TO INTSERATUS-1 DO
STRSERATUS := STRSERATUS + 'C';
IF INTSERATUS = 4 THEN
IF INTLIMARATUS = 1 THEN
STRSERATUS := STRROMAWI + 'CM'
ELSE
STRSERATUS := STRROMAWI + 'CD';
IF INTSEPULUH <> 4 THEN
FOR I := 0 TO INTLIMAPULUH-1 DO
STRLIMAPULUH := STRLIMAPULUH + 'L';
FOR I := 0 TO INTSEPULUH-1 DO
STRSEPULUH := STRSEPULUH + 'X' ;
IF INTSEPULUH = 4 THEN
IF INTLIMAPULUH = 1 THEN
STRSEPULUH := STRROMAWI + 'XC'
ELSE
STRSEPULUH := STRROMAWI +'XL';
IF INTSATU <> 4 THEN
FOR I := 0 TO INTLIMA-1 DO
STRLIMA := STRLIMA + 'V';
FOR I := 0 TO INTSATU-1 DO
STRSATU := STRSATU + 'I' ;
IF INTSATU = 4 THEN
IF INTLIMA = 1 THEN
STRSATU := STRROMAWI + 'IX'
ELSE
STRSATU := STRROMAWI +'IV';
STRROMAWI := STRSERIBU + STRLIMARATUS
+ STRSERATUS + STRLIMAPULUH
+ STRSEPULUH + STRLIMA + STRSATU;
CONVROMAN := STRROMAWI;
END;
b. Konversi Desimal ke Binear
Fungsi ini akan mengkonversi suatu nilai bilangan (decimal) ke basis Binear. Contoh:
123 menjadi: 1111011.
FUNCTION BINEAR(INTANGKA : INTEGER): STRING;
VAR
INTNILAI :LONGINT;
INTLEN :INTEGER;
J :INTEGER;
STRHASIL :STRING;
STREND :STRING[1];
STRSUB : STRING;
BEGIN
STRHASIL := '';
STREND := '';
STRSUB := '';
REPEAT
INTNILAI := INTANGKA MOD 2;
INTANGKA := INTANGKA DIV 2;
STRHASIL := STRHASIL + IntToStr(INTNILAI);
UNTIL INTANGKA = 1;
INTLEN := LENGTH(STRHASIL);
STREND := IntToStr(INTANGKA);
FOR J := INTLEN DOWNTO 1 DO
STRSUB := STRSUB + COPY(STRHASIL, J, 1);
BINEAR := STREND + STRSUB;
END;
c. Konversi Desimal ke Hexadecimal
Fungsi ini akan mengkonversi suatu nilai bilangan (decimal) ke basis Hexadecimal.
Contoh: 123 menjadi: 7B.
FUNCTION HEXADEC(INTANGKA : INTEGER): STRING;
VAR
INTNILAI :LONGINT;
INTLEN :INTEGER;
J :INTEGER;
STRHASIL :STRING;
STRHEXA :STRING;
STREND :STRING[1];
STRSUB :STRING;
BEGIN
STRHASIL := '';
STRHEXA := '';
STRSUB := '';
STREND := '';
REPEAT
INTNILAI := INTANGKA MOD 16;
INTANGKA := INTANGKA DIV 16;
CASE INTNILAI OF
10: STRHEXA := 'A';
11: STRHEXA := 'B';
12: STRHEXA := 'C';
13: STRHEXA := 'D';
14: STRHEXA := 'E';
15: STRHEXA := 'F';
ELSE
STRHEXA := IntToStr(INTNILAI);
END;
STRHASIL := STRHASIL + STRHEXA;
UNTIL INTANGKA < 16;
INTLEN := LENGTH(STRHASIL);
STREND := IntToStr(INTANGKA);
FOR J := INTLEN DOWNTO 1 DO
STRSUB := STRSUB + COPY(STRHASIL, J, 1);
HEXADEC := STREND + STRSUB;
END;
d. Konversi Desimal ke Nominal
Fungsi ini akan mengkonversi suatu nilai bilangan (decimal) ke huruf nominal. Contoh:
123 menjadi: Seratus duapuluh tiga.
Function DlmHuruf(Var nHuruf:String):String;
Begin
If nHuruf ='1' Then DlmHuruf:='satu' Else
If nHuruf ='2' Then DlmHuruf:='dua' Else
If nHuruf ='3' Then DlmHuruf:='tiga' Else
If nHuruf ='4' Then DlmHuruf:='empat' Else
If nHuruf ='5' Then DlmHuruf:='lima' Else
If nHuruf ='6' Then DlmHuruf:='enam' Else
If nHuruf ='7' Then DlmHuruf:='tujuh' Else
If nHuruf ='8' Then DlmHuruf:='delapan' Else
If nHuruf ='9' Then DlmHuruf:='sembilan' Else
DlmHuruf:=' ';
End;
{-------------------------------------------}
Function Terbilang(Angka:LongInt):String;
var
ChrS : Array[1..10] of String;
StrT : Array[1..10] of String;
Huruf:String;Indeks,Panjang:Integer;
Begin
Huruf:=''; Panjang:=0;
For Indeks := 1 to 10 do begin
ChrS[Indeks]:='';
StrT[Indeks]:='';End;
Panjang:=Length(IntToStr(Angka));
For Indeks := 1 to Panjang do
ChrS[Indeks] :=
Copy(IntToStr(Angka),
(Panjang-(Indeks-1)),1);
If ChrS[8] ='0' Then
Begin
StrT[8] :='';
StrT[7]:=DlmHuruf(ChrS[7]) + 'juta ';
End
Else If ChrS[8] ='1' Then
Begin
StrT[8]:='';
If ChrS[7] = '0' Then
StrT[7]:='Sepuluh juta ' Else
If ChrS[7] = '1' Then
StrT[7]:='Sebelas juta ' Else
StrT[7]:= DlmHuruf(ChrS[7]) +
'belas juta';
End
Else If ChrS[8] >'1' Then
Begin
StrT[7]:=DlmHuruf(ChrS[7]) + 'juta ';
StrT[8]:=DlmHuruf(ChrS[8]) + 'puluh ';
End;
Begin
End;
If ChrS[6] = '0' Then
StrT[6]:=''
Else
Begin
If ChrS[6] <> '1' Then
StrT[6]:=DlmHuruf(ChrS[6]) + 'ratus '
Else
StrT[6]:='Seratus ';
End;
If ChrS[5] = '0' Then
Begin
StrT[5]:='';
If ChrS[4] = '1' Then
StrT[4]:= 'Seribu '
Else
StrT[4] := DlmHuruf(ChrS[4]) + 'ribu ';
End
Else If ChrS[5] = '1' Then
Begin
StrT[5]:='';
If ChrS[4] = '0' Then
StrT[4]:='Sepuluh ribu ' Else
If ChrS[4] = '1' Then
StrT[4]:='Sebelas ribu ' Else
StrT[4]:= DlmHuruf(ChrS[4]) +
'belas ribu ';
End
Else
Begin
StrT[4]:=DlmHuruf(ChrS[4]) + 'ribu ';
StrT[5]:=DlmHuruf(ChrS[5]) + 'puluh ';
End;
If ChrS[3] = '0' Then
StrT[3]:=''
Else If ChrS[3] ='1' Then
StrT[3]:='Seratus '
Else If ChrS[3] > '1' Then
StrT[3]:=DlmHuruf(ChrS[3]) + 'ratus ';
{========================================}
If ChrS[2] = '0' Then
Begin
StrT[2]:='';
StrT[1]:=DlmHuruf(ChrS[1]);
End
Else If ChrS[2] ='1' Then
Begin
StrT[2]:='';
If ChrS[1] = '0' Then
StrT[1]:='Sepuluh' Else
If ChrS[1] = '1' Then
StrT[1]:='Sebelas' Else
StrT[1]:= DlmHuruf(ChrS[1]) +'belas';
End
Else If ChrS[2] > '1' Then
Begin
StrT[1]:=DlmHuruf(ChrS[1]);
StrT[2]:=DlmHuruf(ChrS[2])+'puluh ';
End;
For Indeks := 1 to 8 Do
If Panjang <= Indeks Then
StrT[Indeks + 1] :='';
For Indeks := 8 DownTo 1 Do
Huruf:=Huruf + StrT[Indeks];
Terbilang := Huruf;
Untuk mencoba fungsi-fungsi di atas, ketikkan program utama sebagai berikut:
(* program utama *)
BEGIN
CLRSCR;
WRITE ('MASUKAN ANGKA : ');
READLN(MASUKAN);
WRITELN('ROMAWI = ', CONVROMAN(MASUKAN));
WRITELN('BINEAR = ', BINEAR(MASUKAN));
WRITELN('HEXA = ','&H', HEXADEC(MASUKAN));
WRITELN('TERBILANG = ', TERBILANG(MASUKAN));
READLN
END.
Tampilan akhir program seperti gambar di bawah ini:

PROGRAM PERMAINAN
Berikut ini adalah contoh pembuatan sebuah program permainan, sulap angka. Program
ini akan menebak sebuah angka yang dipilih oleh seorang pemain, setelah menempuh
beberapa wizard. Jalankan Pascal dan ketikkan kode yang banyak ini:
PROGRAM SULAPANGKA;
USES CRT;
VAR I, J, K, L: INTEGER;
YT: CHAR;
NILAI:INTEGER;
FUNCTION CSTR(I: INTEGER): STRING;
VAR
S: STRING[11];
BEGIN
STR(I, S);
CSTR := S;
END;
PROCEDURE TULIS(POSISI:INTEGER; TEKS:STRING);
VAR A, B, C: INTEGER;
BEGIN
A := POSISI;
B := POSISI MOD 10;
C := 1;
IF B = 0 THEN
BEGIN B := 10;C := 0; END;
GOTOXY(B * 8 - 5,
(A DIV 10 + C) * 3 + 1);
WRITE(TEKS);
END;
(* Untuk symbol-symbol seperti : ÉÍÍ,
dapat Anda ganti dengan symbol: # atau lainnya *)
PROCEDURE BIKIN_KOTAK(KOLOM, BARIS: INTEGER);
BEGIN
CLRSCR;
FOR I:= 1 TO KOLOM DO
BEGIN
FOR J := 1 TO BARIS DO
BEGIN
GOTOXY (J * 8 - 7, (I * 3));
WRITE('ÉÍÍÍÍ»');
GOTOXY (J * 8 - 7, (I * 3 + 1));
WRITE('º º');
GOTOXY (J * 8 - 7, (I * 3 + 2));
WRITE('ÈÍÍÍͼ');
END;
END;
END;
PROCEDURE WIZARD7;
BEGIN
CLRSCR;
WRITELN('ANGKA YANG ANDA PILIH = ', NILAI);
WRITELN;
WRITE('INGIN MENGULANG (Y/ESC.)? ');READKEY;
YT := READKEY;
END;
PROCEDURE WIZARD6;
BEGIN
BIKIN_KOTAK(2, 10);
FOR I := 1 TO 19 DO
TULIS(I, CSTR(I + 31));
GOTOXY (5, 15);
WRITE('APAKAH ANGKA YANG ANDA PILIH',
' ADA PADA DERETAN ANGKA DI ATAS (Y/T) ');
REPEAT
YT := READKEY;
UNTIL YT IN ['y', 'Y', 't', 'T', #27];
IF UPCASE(YT) = 'Y' THEN
NILAI := NILAI + 32;
WIZARD7;
{===============================}
END;
PROCEDURE WIZARD5;
BEGIN
BIKIN_KOTAK(2, 10);
FOR I := 1 TO 16 DO
TULIS(I, CSTR(I + 15));
FOR J := 17 TO 19 DO
TULIS (J, CSTR(J + 31));
GOTOXY (5, 15);
WRITE('APAKAH ANGKA YANG ANDA PILIH',
' ADA PADA DERETAN ANGKA DI ATAS (Y/T) ');
REPEAT
YT := READKEY;
UNTIL YT IN ['y', 'Y', 't', 'T', #27];
{===============================}
IF UPCASE(YT) = 'Y' THEN
NILAI := NILAI + 16;
WIZARD6;
END;
PROCEDURE WIZARD4;
BEGIN
BIKIN_KOTAK(3, 10);
FOR J := 0 TO 2 DO
FOR I := 1 TO 8 DO
TULIS(J * 8 + I, CSTR(J * 16 + I + 7));
GOTOXY (5, 15);
WRITE('APAKAH ANGKA YANG ANDA PILIH',
' ADA PADA DERETAN ANGKA DI ATAS (Y/T) ');
REPEAT
YT := READKEY;
UNTIL YT IN ['y', 'Y', 't', 'T', #27];
IF UPCASE(YT) = 'Y' THEN
NILAI := NILAI + 8;
WIZARD5;
{===============================}
END;
PROCEDURE WIZARD3;
BEGIN
BIKIN_KOTAK(3, 10);
FOR J := 0 TO 5 DO
FOR I := 1 TO 4 DO
TULIS(J * 4 + I, CSTR(J * 8 + I + 3));
GOTOXY (5, 15);
WRITE('APAKAH ANGKA YANG ANDA PILIH',
' ADA PADA DERETAN ANGKA DI ATAS (Y/T) ');
REPEAT
YT := READKEY;
UNTIL YT IN ['y', 'Y', 't', 'T'];
IF UPCASE(YT) = 'Y' THEN
NILAI := NILAI + 4;
WIZARD4;
{===============================}
END;
PROCEDURE WIZARD2;
BEGIN
BIKIN_KOTAK(3, 10);
J:=0;
FOR J := 0 TO 12 DO
FOR I := 1 TO 2 DO
TULIS(J * 2 + I, CSTR(J * 4 + I + 1));
GOTOXY (5, 15);
WRITE('APAKAH ANGKA YANG ANDA PILIH',
' ADA PADA DERETAN ANGKA DI ATAS (Y/T) ');
REPEAT
YT := READKEY;
UNTIL YT IN ['y', 'Y', 't', 'T', #27];
IF UPCASE(YT) = 'Y' THEN
NILAI := NILAI + 2;
WIZARD3;
{===============================}
END;
PROCEDURE WIZARD1;
BEGIN
BIKIN_KOTAK(3, 10);
L:= 1;
REPEAT
TULIS ((L + 1) DIV 2,CSTR(L));
L:= L + 2;
UNTIL L > 50;
GOTOXY (5, 15);
WRITE('APAKAH ANGKA YANG ANDA PILIH',
' ADA PADA DERETAN ANGKA DI ATAS (Y/T) ');
REPEAT
YT := READKEY;
UNTIL YT IN ['y', 'Y', 't', 'T', #27];
IF UPCASE(YT) = 'Y' THEN
NILAI := 1;
WIZARD2;
{===============================}
END;
PROCEDURE TULIS_NOMOR;
BEGIN
BIKIN_KOTAK(5, 10);
FOR K:= 1 TO 50 DO
TULIS(K, CSTR(K));
GOTOXY(1, 20);
WRITE ('PILIH SEBUAH ANGKA, ',
'TEKAN: Y, KALO MAU TERUS! ');
WRITE ('TEKAN ESC UNTUK KELUAR ');
REPEAT
YT := READKEY;
IF UPCASE(YT) = 'Y' THEN
BEGIN
NILAI := 0;
WIZARD1;
END;
UNTIL YT IN ['y', 'Y', 't', 'T', #27];
{===============================}
END;
(* Program Utama *)
BEGIN
CLRSCR;
TEXTATTR := $1F;
REPEAT
TULIS_NOMOR;
UNTIL YT = #27;
END.

Statemen-Statemen pada Pemrograman Pascal

Reserved Word Reserved Word adalah kata-kata baku yang digunakan dalam program dan sudah terintergrated dalam pascal dan juga mempunyai bentuk serta kegunaan tertentu yang telah didefinisikan oleh Pascal. Reserved Word tidak boleh didefinisikan kembali oleh pemakai, sehingga tidak dapat digunakan sebagai pengenal (Identifier). Dalam bahasa pemrograman Pascal, beberapa Reserved Word dalam Pascal antara lain:
AND DOWNTO IN OF STRING
ASM ELSE INHERITED OR THEN
ARRAY END INLINE PACKED TO
BEGIN EXPORTS INTERFACE PROCEDURE TYPE
CASE FILE LABEL PROGRAM UNIT
CONST FOR LIBRARY RECORD UNTIL
CONSTRUCTOR FUNCTION MOD REPEAT USES
DESTRUCTOR GOTO NIL SET VAR
DIV IF NOT SHL WHILE
DO IMPLEMENTATION OBJECT SHR WITH
.
Selain dari Reserved Word di atas, Turbo Pascal masih memiliki tambahan Reserved Word berikut:
ABSOLUTE ASSEMBLER () FAR FORWARD INDEX

Beberapa Statemen Turbo Pascal
Statemen adalah perintah untuk pengerjaan program pascal. Statemen terletak di bagian deklarasi statemen dengan diawali oleh kata cadangan BEGIN dan diakhiri dengan kata cadangan END. Akhir dari setiap statemen diakhiri dengan titik koma [;]. Statemen statemen dalam bahasa Pascal terdiri dari pernyataan yang berupa fungsi dan prosedur yang telah disediakan sebagai perintah standar Turbo Pascal.

1. Statemen-statemen yang digunakan untuk input/output.

# Read/Readln [prosedur]. Perintah ini digunakan untuk memasukkan [input] data lewat keyboard ke dalam suatu variabel.
Sintaks: Read/Readln(x); (ingat, selalu diakhiri dengan titik koma [;])
Keterangan : x = variabel.
Read = pada statemen ini posisi kursor tidak pindah ke baris selanjutnya.
Readln = pada statemen ini posisi kursor akan pindah ke baris selanjutnya setelah di input.

# ReadKey [fungsi]. Untuk pembacaan sebuah karakter dari keyboard. Tipe data yang dihasilkan adalah char.
Sintaks: ReadKey;

# Write/Writeln [prosedur]. Digunakan untuk menampilkan isi dari suatu nilai variable dilayar.
Sintaks: Write/Writeln(x);
Keterangan : x = variabel.
Write/Writeln= statement ini digunakan untuk mencetak variable ke dalam monitor
Contoh :
Program input;
Uses Crt;
Var nm : String;
npm : String;
Begin
Clrscr;
Writeln ('masukkan nama dan NPM ');
Writeln ('------------------------------');
Write ('nama anda : ');
Readln (nm);
Writeln ('NPM anda : ');
Readln (npm);
End.
Bila dijalankan hasilnya adalah:
masukkan nama dan NPM
------------------------------
nama anda : ( di input )
NPM anda : ( di input )

2. Statemen-statemen yang digunakan untuk pengaturan letak layar.

# ClrScr [prosedur]. Perintah ini digunakan untuk membersihkan layar.
sintaks: ClrScr; [Clear screen]

# GotoXY[prosedur]. Untuk menempatkan posisi kursor pada layar.
Sintaks: GotoXY(X, Y: Byte);
Keterangan : X = sumbu X (posisi horisontal)
Y = sumbu Y (posisi vertikal)

# DelLine [prosedur]. Untuk menghapus sebuah baris pada posisi kursor dan menaikkan baris-baris dibawahnya.
Sintaks: DelLine;

# InsLine [prosedur]. Untuk menyisipkan sebuah baris pada posisi kursor dan menggeser kebawah tampilan-tampilan baris dibawahnya.
Sintaks: InsLine;

# Delay [prosedur]. Untuk menghentikan sejenak proses program.
Sintaks: Delay (MS: Word);
Keterangan : variable MS = ukuran waktu dalam milisecond.
Contoh :
Program Layar;
Uses Crt;
Var x : Char;
Begin
ClrScr;
GotoXY(35,10);Writeln (‘I Love Dinda');
Write (tunggu sebentar...!!');
Delay (5000);
InsLine;
GotoXY (35,11);Writeln ('Bayi sehatku');
GotoXY(01,13);Writeln ('Tekan Enter !');
Delay(1000);
GotoXY(15,12);
DelLine;
Read(x);
End.
Hasilnya adalah :
I Love Dinda
Bayi sehatku
tunggu sebentar...!!
Tekan Enter !

3. Statemen yang digunakan untuk memanipulasi string.

# ConCat[fungsi]. Untuk menggabungkan 2 atau beberapa variabel string.
Sintaks: ConCat (s1 [,s2,...,sn]: String) : String;
contoh: ConCat ('ABC','DEF') { ABCDEF }

# Copy [fungsi]. Mengambil satu atau beberapa karakter dari sebuah string.
Sintaks: Copy (S,Index,Count) : String;
Keterangan : S = sebuah string (string).
Index = posisi awal kita akan mengambil beberapa karakter (integer)
Count = banyaknya karakter yang akan diambil (integer).

# Delete [prosedur]. Menghapus sebagian karakter dari sebuah string.
Sintaks: Delete (S,Index,Count);
Keterangan : sama dengan statemen Copy.

# Insert [prosedur]. Menyisipkan satu atau beberapa karakter ke dalam sebuah string.
Sintaks: Insert (Source,var S,Index);
Keterangan : Source = sumber string untuk disisipi (string)
var S = string tujuan yang akan disisipi oleh string Source (string)
Index = posisi mulai (integer).

# Length [fungsi]. Memberikan nilai panjang dari suatu string (jumlah karakter dalam string).
Sintaks: Length (S);
Keterangan : S = string
Length(S) menghasilkan nilai integer.

# Pos [fungsi]. Mencari posisi sebuah bagian string (substring) didalam sebuah string.
Sintaks: Pos (Substr,S); {menghasilkan nilai Byte}
Keterangan : Substr = substring yang akan dicari posisinya didalam sebuah string S. Bila bernilai 0 berarti nilai string yang dicari tidak ada.

# Str [prosedur]. Merubah nilai numerik ke dalam nilai string.
Sintaks: Str (N,S);
Keterangan :
N = data tipe integer,
S = data tipe string.

# Val [prosedur]. Merubah nilai string ke dalam nilai numerik.
Sintaks: Val (S,N,P);
Keterangan :
S = nilai string,
N = nilai real,
P = posisi salah.
Nilai string harus berisi angka, plus atau minus, bila tidak berarti kesalahan dan letak kesalahannya ditunjukkan oleh variabel posisi salah. Jika benar, maka nilai variabel tsb = 0 (nol).

# UpCase [fungsi]. Memberikan huruf kapital dari argumen.
Sintaks: UpCase (S);
Keterangan :
S = variabel bertipe karakter.
Contoh :
Program Man_String;
Uses Crt;
Var s : String;
l : Integer;
h : String;
Const a='Dinda';
b='Bayi ';
c='Sehatku';
Begin
ClrScr;
s:= ConCat (a,b,c);
Writeln (s);
Insert (' & ',s,6);
Writeln(s);
Delete (s,7,7);
Writeln (s);
h:=Copy (s,1,5);
Writeln (h);
l:= Length(s);
Writeln ('Panjangnya string S : ',l);
Writeln ('Posisi "Sehat" pada nilai S : ',POS('Sehat',s));
END.
Hasilnya adalah :
DindaBayiSehatku
Dinda & Bayi Sehatku
Dinda Sehatku
Dinda
Panjangnya string S : 16
Posisi "Sehat" pada nilai S : 7

4. Statemen-statemen untuk perhitungan aritmatik.

# Abs [fungsi]. Memberikan nilai mutlak dari suatu argumen.
Sintaks: ABS(x);

# ArcTan[fungsi]. Memberikan nilai dari fungsi arctangent dari perhitungan goniometri.
Sintaks: ArcTan (x); ‘dimana x dapat bertipe real atau integer dan akan menghasilkan nilai bertipe real.’

# Cos [fungsi]. Memberikan nilai dari fungsi Cosinus.
Sintaks: Cos (x);

# Exp [fungsi]. Menghitung nilai pangkat dari bilangan e (bilangan alam),yaitu sebesar x.
Sintaks: Exp (x); ‘x dapat bertipe real atau integer dan akan menghasilkan nilai bertipe real. ‘

# Frac [fungsi]. Untuk mendapatkan nilai pecahan dari suatu bilangan.
Sintaks: Frac (x); ‘Tipe dari x sama seperti yang diatas. ‘

# Int [fungsi]. Memberikan nilai integer (bilangan bulat) dari suatu variabel dengan membuang bilangan di belakang koma.
Sintaks: Int (X);

# Ln [fungsi]. Digunakan untuk menghitung nilai logaritma alam (natural logarithm) dari nilai x.
Sintaks: Ln (x);

# Sin [fungsi]. Memberikan nilai dari fungsi Sinus.
Sintaks: Sin (x);

# Sqr [fungsi]. Digunakan untuk menghitung nilai pangkat kuadrat dari suatu bilangan.
Sintaks: Sqr (x);
Tipe dari x bisa berupa real maupun integer. Dan hasilnya akan sama dengan tipe dari x.

# Sqrt (fungsi). Digunakan untuk menghitung nilai akar dari suatu bilangan.
Sintaks: Sqrt (x);
Contoh :
Program Aritmatik;
Uses Crt;
Var x : Real;
Begin
Clrscr;
Write('Masukkan nilai dari X = ');
Readln (x);
If x <0 Then x:=Abs (x);
Writeln('Nilai X = ',x:5:2);
Writeln ('Nilai eksponentialnya = ',EXP(x):9:3);
Writeln ('Nilai logaritma alamnya = ',LN(x):9:3);
Writeln ('Nilai integernya = ',INT(x):5:2);
Writeln ('Nilai fraksionalnya = ',FRAC(x):5:2);
Writeln ('Nilai X dipangkatkan = ',SQRT(x):9:3);
Writeln ('Nilai X diakarkan = ',SQRT(x):9:3);
Write('Nilai X jika dimasukkan dalam ');
Writeln('fungsi Sin,Cos,Tangen: ');
Writeln('- Sinus = ',Sin(x):9:3);
Writeln('- Cosinus = ',Cos(x):9:3);
Writeln('- Tangen = ',ArcTan(x):9:3);
End.
Hasilnya :
masukkan nilai dari X = -2.5
Nilai X = 2.50
Nilai eksponensialnya = 12,182
Nilai logarima alamnya = 0,196
Nilai integernya = 2.00
Nilai fraksionalnya = 0.50
Nilai X dipangkatkan = 6.250
Nilai X diakarkan = 1.581
Nilai X jika dimasukkan dalam fungsi Sin,Cos,Tangen:
- Sinus = 0.598
- Cosinus = -0.801
- Tangen = 1.190

5. Statemen-statemen untuk transfer nilai dari suatu variabel.

# Chr [fungsi]. Merubah nilai dari byte ke bentuk karakter yang sesuai dengan kode ASCII.
Sintaks: Chr (x);
Keterangan : x bertipe byte
contoh : Writeln (Chr (61));
hasilnya : a

# Ord [fungsi]. Merubah nilai suatu variabel dari bentuk karakter ke bentuk longint.
Sintaks: Ord (x);
Keteranagn : x bertipe char
contoh : Writeln(Ord ('B'));
hasilnya : 42

# Round [fungsi]. Membulatkan data tipe real ke data tipe longint.
Sintaks: Round (x);
Keterangan : Jika nilai pecahan < 0,5 maka dibulatkan kebawah. Jika nilai pecahan > 0,5 maka dibulatkan keatas.
contoh : Writeln('10/3 dibulatkan = ',Round(10/3));
hasilnya : 10/3 dibulatkan = 3

# TRUNC [fungsi]. Membulatkan kebawah data tipe real ke data tipe longint.
Sintaks: Trunc (x);
contoh : Writeln('20/3 dibulatkan kebawah = ',Trunc (20/3));
hasilnya : 20/3 dibulatkan kebawah = 6

6. Statemen-statemen untuk memanipulasi data.

# Pred [fungsi]. Memberikan nilai sebelum nilai argumen dalam urutannya dalam ASCII.
Sintaks: Pred (x);

# Succ [fungsi]. Memberikan nilai sesudah nilai argumen dalam urutannya dalam ASCII.
Sintaks: Succ (x);

# Inc[fungsi]. Menambah (increments) nilai suatu variabel.
Sintaks: Inc (x,i); {i >= 1}

# Dec [fungsi]. Mengurangi (decrements) nilai suatu variabel.
Sintaks: DEC(x,i); {i >=1}

Contoh :
Progam Man_Data;
Uses Crt;
Type
hari = (hr0,hr1,hr2,hr3,hr4,hr5,hr6,hr7)
Var
urutanhr : hari;
Const
namahr : Array [hr1..hr7] of String [6]=('Senin','Selasa','Rabu','Kamis','Jumat','Sabtu','Minggu');
Begin
Writeln('Daftar Nama Hari);
urutanhr := hr0;
While Urutanhr < hr7 DO
Begin
urutanhr := Succ(urutanhr);
Write('hari ke ',Ord(Urutanhr):2,' adalah ');
Writeln(namahr[urutanhr]);
End;
End.
hasilnya adalah :
Daftar Nama Hari
hari ke 1 adalah Senin
hari ke 2 adalah Selasa
hari ke 3 adalah Rabu
hari ke 4 adalah Kamis
hari ke 5 adalah Jumat
hari ke 6 adalah Sabtu
hari ke 7 adalah Minggu

7. Statemen-statemen tambahan (warna,suara dan window).

# TextColor [prosedur]. Untuk mengatur warna dari karakter-karakter di layar.
Sintaks: TextColor (color : Byte);
Catatan : untuk pilihan warna lihat pada buku Turbo Pascal yang anda miliki.
Daftar TextColor :
(2) Hijau Muda (3)Hijau pupus (4)Merah
(5)Ungu Tua (6) Kuning (7)Putih
(8)Biru Tua (9)Biru Cerah (10)Hijau Muda
(12)Merah Muda (13)Ungu Cerah (14)Kuning Muda
(15) Ungu Pupus (16)Hitam

Daftar TextColor dengan Blink :
(17)Biru Tua (18)Hijau Muda (19)Hijau Pupus
(20)Merah (21)Ungu Tua

# TextBackGround [prosedur]. Untuk mengatur warna latar belakang dari karakter-karakter dilayar.
Sintaks: TextBackGround (Color : Byte);

# Window [prosedur]. Untuk membuat suatu jendela (window) yang terletak pada layar.
Sintaks: Window (x1,x2,y1,y2 : Byte);
x1,x2 = kordinat kiri atas dengan nilai maksimal sesuai dengan mode layar.
y1,y2 = kordinat kanan bawah dengan nilai maksimal sesuai dengan mode layar.

# TextMode [prosedur]. Untuk mengatur lebar layar, 80 kolom atau 40 kolom.
Sintaks: TextMode(Mode: Byte);
Default = C80

# Sound [prosedur]. Untuk mengaktifkan suara (beep) pada internal speaker.
Sintaks: Sound (Hz : word);
Untuk mengnonaktifkannya, gunakan statemen NoSound.
Contoh :
Program Layar2;
Uses Crt;
Begin
ClrScr;
Window (5,5,20,75);
TextBackGround(Red); ‘anda juga bisa menggunakan angka (4)
TextColor(Yellow);
Sound (220);
GotoXY(10,7);
Writeln('I Love Dinda');
GotoXY(11,7);
Writeln('Bayi Sehatku');
NoSound;
End.
Sebagai Latihan dari teori-teori yang sudah anda pelajari diatas, coba anda kerjakan soal-soal dibawah ini .

Soal Latihan
1. Soal I
Buatlah program dibawah ini dengan tampilan menggunakan perintah Window, TextColor, Blink TextColor, Textbackground, GotoXY, dan Sound untuk memperindah tampilan.
1. Mengubah derajat temperatur, dari derajat Celcius ke derajat Fahreinheit dan Reamur (derajat Celcius diinput)
2. Menghitung Luas dan Keliling lingkaran, dengan jari-jari diketahui (diinput).
3. Menghitung Luas dan Keliling segitiga sembarang yang diketahui ke tiga sisinya.
4. Mencari nilai Sinus, Cosinus, dan Tangen dengan sudut diinput.
5. Mencari akar dan kuadrat dari suatu nilai (nilai diinput).
6. Mencari nilai bulat dan pecahan dari suatu nilai yang dimasukkan melalui keyboard (diinput). Nilai pecahan tersebut dibulatkan sampai 3 angka dibelakang koma (,).
7. Tampilkan nama dan NPM anda di dalam window, dan terletak pada tengah-tengah layar.
8. Tampilkan tulisan 'I Love Dinda’ di dalam window pada pojok kanan atas dengan ukuran window sama dengan tulisan tersebut.
2. Soal II
Buatlah program pada soal jenis I (no. 1-6) dengan tampilan menggunakan 2 window. Window yang pertama digunakan untuk nilai yang diinput. Window yang kedua untuk hasil dari program (output).
3. Soal III
1. Buatlah program untuk menggabungkan 2 buah kata yang diinput. Setiap kata yang diinput harus berada didalam window yang dan hasilnya berada pada window yang berbeda pula.
2. Buatlah program untuk menampilkan window secara acak dengan warna yang berbeda.

ARRAY PASCAL

 Array adalah tipe data terstruktur yang terdiri dari sejumlah komponen-komponen yang mempunyai tipe sama. Komponen-komponen tersebut disebut sebagai komponen type, larik mempunyai jumlah komponen yang jumlahnya tetap. Banyaknya komponen dalam larik ditunjukkan oleh suatu index, dimana tiap komponen di array dapat diakses dengan menunjukkan nilai indexnya atau subskript. Array dapat bertipe data sederhana seperti byte, word, integer, real, bolean, char, string dan tipe data scalar atau subrange. Tipe larik mengartikan isi dari larik atau komponen- komponenya mempunyai nilai dengan tipe data tersebut.
Contoh:
Var
Untai : array[1..50] of Integer;
Pada contoh Array dengan nama untai telah dideklarasikan dengan tipe integer, dengan jumlah elemen maksimum 50 elemen, nilai dari elemen array tersebut diatas harus bertipe integer.

Contoh Program :
Program Contoh_Array_Input;
Uses Crt;
Var
Bilangan : array[1..50] of Integer;
Begin
ClrScr;
Bilangan[1]:=3;
Bilangan[2]:=29;
Bilangan[3]:=30;
Bilangan[4]:=31;
Bilangan[5]:=23;
Writeln('nilai varibel bilangan ke 3 =',Bilangan[3]);
Readln;
End.

Array juga dapat dideklarasikan bersama dengan tipe yang beragam seperti contoh dibawah ini :
Program Contoh_Deklarasi_Array_Beragam;
Uses Crt;
Var
NPM : array[1..20] of string[10];
Nama : array[1..20] of string[25];
Nilai : array[1..20] of real;
Umur : array[1..20] of byte;
banyak,i : integer;
Begin
ClrScr;
Write('Isi berapa data array yang diperlukan :');Readln(banyak);
For i := 1 to banyak Do
Begin
Write('NPM =');Readln(NPM[i]);
Write('Nama =');readln(Nama[i]);
Write('Nilai=');readln(Nilai[i]);
Write('Umur =');readln(Umur[i]);
End;
{cetak varibel array}
Writeln('NPM NAMA NILAI UMUR ');
For i:= 1 to banyak Do
Begin
Writeln(Npm[i]:10,Nama[i]:25,Nilai[i]:3:2,' ',Umur[i]:3);
End;
Readln;
End.

Untuk deklarasi array dapat digunakan beberapa cara seperti berikut ini :
Type
Angka = String[20];
Var
Nama : Array [1..50] of Angka;
Begin
.
.
End.

Deklarasi tipe indeks subrange integer Indeks pada array dapat tipe skalar atau subrange, tetapi tidak bisa real.
Contoh:
Var
Nilai : Array[1..10] of Integer;
pada contoh ini array nilai mempunyai 10 buah elemen yaitu dari 1 sampai 10. Array tersebut dapat dideklarasikan dengan type seperti berikut ini :

Type
Skala = 1..10;
Var
Nilai : Array [skala] of Integer;
atau :
Type
Skala = 1..10;
Y = Array[skala] of Integer;
Var
Nilai : Y;
atau :
Type
Y = Array[1..10] of Integer;
Var
Nilai : Y;
atau :
Const
Atas =1;
Bawah = 5;
type
Y = Array[Atas..Bawah] of Integer;
Var
Nilai : Y;

I. Deklarasi Type Indeks Skalar
Indeks dari larik dapat berupa tipe skalar.
Contoh. :
Program Deklarasi_Indeks_Array_Skalar;
Uses Crt;
Var
Jum : Array[(jan,feb,mar,apr,mei)] of Integer;
Begin
Jum[jan]:=25;
Jum[feb]:=45;
Jum[mar]:=21;
Jum[apr]:=23;
Jum[mei]:=50;
Writeln('Jumlah nilai bulan maret =',Jum[mar]);
Readln;
End.
dapat juga ditulis :
type
Bln = (jan,feb,mar,apr,mei);
Var
Jum : Array[bln] of Integer;
atau :
type
Bln =(jan,feb,mar,apr,mei);
Var
Jum : Array[jan..mei] of Integer;

II. Deklarasi Konstanta Array
Array tidak hanya dapat berupa suatu varibel yang dideklarasikan di bagian deklarasi variabel, tetapi dapat juga berupa konstanta (const).
Contoh Program :
Program Contoh_Deklarasi_Array_Konstan;
Uses Crt;
Const
Tetap : Array[1..4] of Integer=(7,10,21,20);
Var
i : Integer;
Begin
For i:= 1 to 4 Do
Writeln('Nilai Konstan array ke ',i:2,' =',Tetap[i]);
Readln;
End.
konstanta array dapat juga berupa ketetapan dalam bentuk karakter seperti berikut.
Contoh Program :
Program Contoh_Konstan_Array_Char_;
Uses Crt;
Const
Huruf : Array[0..5] of Char=('A','B','C','D','E','F');
Var
i : Integer;
Begin
For i:= 0 to 5 Do
Writeln('Nilai konstan array ke',i:2,' = ',Huruf[i]);
Readln;
End.
Konstanta array dapat juga berupa string seperti berikut ini.
Contoh Program :
Program Constanta_Array_String;
Uses Crt;
Type
A = Array [1..5] of String;
Const
Nama : A = ('basic','pascal','cobol','paradox','dbase');
Var
i : Integer;
Begin
For i:= 1 to 5 Do
Writeln('Nilai Array ke-',i:2,'= ',Nama[i]);
readln;
end.

Dalam pascal string merupakan array dari elemen- elemen karakter seperti berikut :
Contoh Program :
Program String_Adalah_Array_Tipe_Char;
Uses Crt;
Var
Nama : string;
i : Integer;
Begin
Nama:='Turbo Pascal';
For i:= 1 to Length(nama) Do
Writeln('Elemen ',i,' dari ',Nama,'= ',Nama[i]);
Readln;
End.

contoh program bilangan prima dengan menggunakan bantuan array.
Contoh program :
Program Mencari_Bilangan_Prima_Dengan_Array;
Uses Crt;
Var
Prima : Array[1..100] of Integer;
i,j : Integer;
bil : Integer;
Begin
ClrScr;
For i := 2 to 100 Do
Begin
Prima[i]:=i;
For j:= 2 to i-1 Do
Begin
bil := (i mod j); {* i dibagi j dicek apakah 0*}
If bil = 0 then Prima[i]:=0; {*jika habis dibagi,berarti bkn prima*}
End;
If Prima[i]<> 0 Then Write(Prima[i],' '); {*cetak array yg prima*}
End;
Readln;
End.

Contoh pengurutan data dengan metode buble sort, yaitu dengan cara penukaran, dapat dilihat pada contoh dibawah ini :
Contoh Program :
Program Penggunaan_Array_Untuk_Sortir_Buble_Sort;
Uses Crt;
Var
nil1 : Array[1..100] of Integer;
n,i,j,dum : Integer;
Begin
ClrScr;
Write('mau isi berapa data acak (integer) ='); readln(n);
For i := 1 to n Do
Begin
Write('Data Ke ',i,':');Readln(nil1[i]);
End;
{* penyapuan proses}
for i:= 1 to n-1 do
begin
for j:= i to n do
begin
if nil1[j]begin
dum:=nil1[j];
nil1[j]:=nil1[i];
nil1[i]:=dum;
end;
end;
end;
writeln;
writeln('Hasil Sortir');
for i := 1 to n do
write(nil1[i]:3);
readln;
end.


III. Array Dua Dimensi
Di dalam pascal Array dapat berdimensi lebih dari satu yang disebut dengan array dimensi banyak (Multidimensional array), disini akan dibahas array 2 dimensi saja. Array 2 dimensi dapat mewakili suatu bentuk tabel atau matrik, yaitu indeks pertama menunjukkan baris dan indeks ke dua menunjukkan kolom dari tabel atau matrik.
1 2
1 2 3
Untuk mengetahui cara mendeklarasikan dari penggunaan aray dua dimensi dapat dilihat pada listing program dibawah ini .

Contoh Program:
Program Deklarasi_Array_Dua_Dimensi;
Uses Crt;
Var Tabel : Array[1..3,1..2] of Integer;
i,j : Integer;
Begin
ClrScr;
Tabel[1,1]:=1;
Tabel[1,2]:=2;
Tabel[2,1]:=3;
Tabel[2,2]:=4;
Tabel[3,1]:=5;
Tabel[3,2]:=6;
For I := 1 to 3 Do Begin For J:= 1 to 2 Do Begin Writeln('Elemen ',i,',',j,'= ',tabel[i,j]);
End;
End;
Readln;
End.


IV. Alternatif Deklarasi Array Dua Dimensi.
Ada beberapa cara dalam mendeklarasikan array dua dimensi, beberapa cara tersebut dapat dilihat dibawah ini :
Contoh :
Var
Tabel : Array[1..3] of Array[1..2] of Byte;
atau :
Type
Matrik = Array[1..3,1..2] of Byte;
Var
Tabel : Matrik;
atau :
Type
Baris = 1..3;
Kolom = 1..2;
Matrik = Array[Baris,Kolom] of Byte;
Var
Tabel : Matrik;
atau :
Type
Baris = 1..3;
Kolom=1..2;
Matrik= Array[Baris] of Array[Kolom] of Byte;
Var
Tabel : Matrik;
Dibawah ini akan diberikan listing program penggunaan array dua dimensi dalam aplikasi penjumlahan matrik :
Contoh Prorgam:
Program Penjumlahan_Matrik;
Uses Crt;
Var
Matrik1,Matrik2, Hasil : Array[1..3,1..2] of Integer;
i,j : Integer;
Begin
ClrScr;
{ input matrik ke satu }
Writeln(' Elemen matrik satu');
For i := 1 to 3 Do
Begin
For j := 1 to 2 Do
Begin
Write('Elemen baris -',i,' Kolom -',j,'= ');
Readln(matrik1[i,j]);
End;
End;
{input matrik ke dua}
Writeln('input elemen matrik dua');
For i:= 1 to 3 Do
Begin
For j:= 1 to 2 Do
Begin
Write('Elemen baris -',i,' kolom -',j,'= ');
Readln(matrik2[i,j]);
End;
End;
{proses penjumlahan tiap elemen}
For i := 1 to 3 Do
Begin
For j:= 1 to 2 Do
Begin
Hasil[i,j]:=Matrik1[i,j]+Matrik2[i,j];
End;
End;
{proses cetak hasil}
For i:= 1 to 3 Do
Begin
For j:= 1 to 2 Do
Begin
Write(Hasil[i,j]:6);
End;
Writeln;
End;
Readln;
End.


V. Array Sebagai Parameter
Array dapat digunakan sebagai parameter yang dikirimkan baik secara nilai (by value) atau secara acuan (by reference) ke procedure atau ke function. Procedure yang menggunakan parameter berupa array harus dideklarasikan di dalam judul procedure yang menyebutkan parameternya bertipe array.

Contoh Program :
Program Contoh_Pengiriman_Parameter_Array_Di_Procedure;
Uses Crt;
Const
Garis ='---------------------------------------------------';
Type
Untai = Array[1..10] of String[15];
Bulat = Array[1..10] of Integer;
Huruf = Array[1..10] of Char;
Var
i,Banyak : Integer;
Procedure Proses(Nama:Untai;Nilai:Bulat);
Var
Ket : String;
Abjad : Char;
Begin
Writeln(Garis);
Writeln('Nama Nilai Abjad Keterangan');
Writeln(Garis);
For i := 1 to Banyak Do
Begin
If Nilai[i] > 90 Then
Begin
Abjad:='A';
Ket :='Istimewa';
End;
If (Nilai[i]<90) And (Nilai[i]>70) Then
Begin
Abjad:='B';
Ket :='Memuaskan';
End;
If (Nilai[i]<70) And (Nilai[i]>60) Then
Begin
Abjad:='C';
Ket :='Cukup';
End;
If (Nilai[i]<60) And (Nilai[i]>45) Then
Begin
Abjad:='D';
Ket :='Kurang';
End;
If Nilai[i]< 45 Then
Begin
Abjad:='E';
Ket :='Sangat kurang';
End;
Writeln(Nama[i]:15,' ',Nilai[i]:4,' ',Abjad,' ',Ket:15);
End;
Writeln(Garis);
End;
Procedure Masuk_Data;
Var
Nama : Untai;
Nilai : Bulat;
Begin
Write('Banyak data =');Readln(Banyak);
For i:= 1 to Banyak Do
Begin
ClrScr;
Writeln('Data ke - ',i);
Write('Nama =');readln(Nama[i]);
Write('Nilai =');readln(Nilai[i]);
End;
Proses(Nama,Nilai);
End;
{modul Utama}
Begin
Masuk_Data;
Readln;
End.
Referensi :
# Lepkom Universitas Gunadarma.

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)

Read more: http://komputok.blogspot.com/2010/01/kumpulan-source-code-sederhana-dalam.html#ixzz190R9Bvps

 

Untuk download dalam format PDF silahkan Click Link ini :

Kumpulan Source code Sederhana Dalam Bahasa Pascal