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.
Demikian semoga membantu, jika ada yang ingin ditanyakan silahkan tinggalkan pesan di kolom komentar. terima kasih.