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.
