Sabtu, 17 Juli 2010

Function Of Numeric With Delphi

Judulnya agak nyentrik buat saya yang cuma memiliki kemampuan berbahasa inggris yes/no hahahha, ketahuan lagi deh..nggak bisa inggrisan, tapi harapan saya sedikit demi sedikit bisa bahasa inggris heheheh.
langsung ke topik pembicaraan "Function Of Numeric With Delphi" yang saya maksudkan disini adalah tidak lain adalah bagaimana kita membuat fungsi terbilang tetapi kali ini kita menggunakan bahasa sintaxnya Delphi sedangkan untuk link resminya delphi teman-teman bisa klik disini .

Fungsi terbilang yang saya buat ini lumayan sudah tua karena pada awal kami buat dahulu masih menggunakan delphi ver 5 bersama sahabat saya "Yafie Anak Kolong" tapi alhamdulillah fungsi ini banyak memberikan manfaat bagi saya dan rekan-rekan, pada kesempatan ini saya akan berikan kode ini kepada teman-teman delphier untuk dapat dikembangkan kembali atau untuk dimanfaatkan atau untuk menambah manfaat bagi teman-teman ya, kalau bagus mohon komentarnya tapi kalau jelek atau ada kemiripan dengan coding teman-teman mohon dimaafkan.

sebagai informasi tambahan fungsi yang kami buat ini telah dapat digunakan dalam 2 format mata uang yaitu indonesia (xxx.xxx,xx) dan inggris (xxx,xxx,xxx.00)

sintax source terbilang :

function Tfutil.konversi(karakter: string):string;
var i,a1,a2,a3 : integer; c,k,c1,c2,huruf : string; d : array [0..8] of char;

function satuan(angka : integer):string;
var kata : string;
begin
case angka of
0 : kata := '';
1 : kata := 'Satu';
2 : kata := 'Dua';
3 : kata := 'Tiga';
4 : kata := 'Empat';
5 : kata := 'Lima';
6 : kata := 'Enam';
7 : kata := 'Tujuh';
8 : kata := 'Delapan';
9 : kata := 'Sembilan';
end;
Result := kata;
end;

function puluhan(angka : integer):string;
var kata : string; a,b :integer;
begin
a := angka div 10;
b := angka - (a*10);
if a > 0 then
begin
if a = 1 then
begin
if b = 0 then
kata := 'Sepuluh'
else if b = 1 then
kata := 'Sebelas'
else
kata := satuan(b) + ' Belas';
end else
begin
kata := satuan(a)+' Puluh '+ satuan(b);
end;
end else
kata := satuan(angka);
Result := kata;
end;

function ratusan(angka : integer):string;
var kata : string; a,b :integer;
begin
a := angka div 100;
b := angka - (a*100);
if a > 0 then
begin
if a = 1 then
begin
kata := 'Seratus ' + puluhan(b)
end else
begin
kata := satuan(a)+' Ratus '+ puluhan(b);
end;
end else
kata := puluhan(angka);
Result := kata;
end;

function ribuan(angka : integer):string;
var kata : string; a,b :integer;
begin
a := angka div 1000;
b := angka - (a*1000);
if a > 0 then
begin
if a = 1 then
begin
kata := 'Seribu ' + ratusan(b)
end else
begin
kata := Ratusan(a)+' Ribu '+ Ratusan(b);
end;
end else
kata := Ratusan(angka);
Result := kata;
end;

function jutaan(angka : integer):string;
var kata : string; a,b :integer;
begin
a := angka div 1000000;
b := angka - (a*1000000);
if a > 0 then
begin
kata := Ratusan(a)+' Juta '+ Ribuan(b)
end else
kata := Ribuan(angka);
Result := kata;
end;

function milyardan(angka : integer):string;
var kata : string;
begin
if angka > 0 then
begin
kata := Ratusan(angka)+' Milyar'
end else
kata := '';
Result := kata;
end;

function trilyunan(angka : integer):string;
var kata : string; a,b :integer;
begin
a := angka div 1000;
b := angka - (a*1000);
if a > 0 then
begin
kata := Ratusan(a)+' Trilyun ' + milyardan(b);
end else
kata := milyardan(angka);
Result := kata;
end;

function koma(angka : string):string;
var kata : string; a,b : integer;
begin
kata := copy(angka,1,1);
a := strtoint(kata);
if a = 0 then
begin
kata := 'Nol'
end else
begin
kata := satuan(a);
end;
a := strtoint(angka);
b := a div 10;
a := a - (b * 10);
kata := kata + ' ' + satuan(a);
result := kata;
end;
begin
a1 := AnsiPos(',',trim(karakter));
a2 := AnsiPos('.',trim(karakter));
if ((a1 <> 0) or (a2<>0)) then
begin
if (a1 > a2) then
begin
k := copy(trim(karakter),1,a1-1);
c := '';
for i := 1 to length(k) do
begin
if k[i] <> '.' then c := c + k[i];
end;
if (length(karakter)-a1 > 1) then k := copy(trim(karakter),a1+1,2)
else
begin
k := copy(trim(karakter),a1+1,1);
k := k + '0';
end;
end else
begin
k := copy(trim(karakter),1,a2-1);
c := '';
for i := 1 to length(k) do
begin
if k[i] <> ',' then c := c + k[i];
end;
if (length(karakter)-a2 > 1) then k := copy(trim(karakter),a2+1,2)
else
begin
k := copy(trim(karakter),a2+1,1);
k := k + '0';
end;
end;
end else
begin
c:= karakter;
k := '00';
end;
if length(trim(c)) > 9 then
begin
a3 := length(c);
i :=0;
while i <=8 do
begin
d[8-i] := c[a3];
a3 := a3 - 1;
i := i + 1;
end;
for i := 0 to 8 do begin c2 :=c2+d[i];d[i]:=' ' ; end;
a3 := length(c)- 9;
while a3 > 0 do
begin
d[a3-1] := c[a3];
a3 := a3-1;
end;
for i := 0 to 8 do begin c1 := c1 + d[i];d[i]:=' '; end;
a1 := strtoint(trim(c1));
a2 := strtoint(trim(c2));
huruf := trilyunan(a1) +' '+ jutaan(a2);
end else
begin
a1 := strtoint(c);
huruf := jutaan(a1);
end;
if ((trim(k) <> '00') and (trim(k)<>'0')) then
begin
if huruf = '' then huruf := 'Nol Koma';
huruf := huruf +' Koma ' + koma(k);
end;
result := huruf;
end;




2 komentar:

Yafie mengatakan...

Perasaan kenal hihihi

Kaceng mengatakan...

Iya Pak Kriwul, ini karyamu dulu hahahahahah.... tu ada saya konversi ke C# juga mudah2 an bermanfaat juga untuk teman2 lainnya