Arsip: Contoh aplikasi dari Procedure Rupiah ke Terbilang?
more 17 years ago
gormet
Lama tak nongol nanya lagi ah....
Saya ingin membuat aplikasi dari Procedure Rupiah ke Terbilang,
sesuai dengan contoh Procedure Konversi Rupiah ke Terbilang ();,
kiriman mas hasan_plg
dari link: http://pascal-id.org/dpr/Article132.pas
setelah saya coba-coba, hasilnya tidak sesuai.
1. saya copy langsung dari artikel nya:
unit U_Rkt;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function Right( Str: String; Len: Integer ): String;
function Left( Str: String; Len: Integer ): String;
function RpToStr( Rp: Double ): String; overload;
function RpToStr( Rp: String ): String; overload;
end;
var
Form1: TForm1;
implementation
{$R .DFM}
function Right( Str: String; Len: Integer ): String;
begin
Result := Copy(St, (Length(St)+1)-Len, Len);
end;
function Left( Str: String; Len: Integer ): String;
begin
Result := Copy(St, 1, Len);
end;
function RpToStr( Rp: Double ): String; overload;
begin
Result := RpToStr( FloatToStr(Rp) );
end;
function RpToStr( Rp: String ): String; overload;
var cRp, sRp: String;
var nRp, nRp1, nRp2: Integer;
var aRp1 : array of String = ('', 'Satu ', 'Dua ', 'Tiga ', 'Empat ', 'Lima ', 'Enam ', 'Tujuh ', 'Delapan ', 'Sembilan ');
var aRp2 : array of String = ('', 'Ribu ', 'Juta ', 'Milyar ', 'Triliun ');
var aRp3 : Array of String;
nRp1 := 0;
cRp := Trim( Rp );
while length(cRp) > 0 do begin
aRp3[nRp1] := Right(cRp, 3);
cRp := Left(cRp, length(cRp)-3);
inc(nRp1);
end;
nRp2 := nRp1;
Result := '';
while nRp1 >= 0 do begin
cRp := '';
sRp := aRp3[nRp1];
if (length(sRp) = 3) then begin
nRp := StrToInt( Left(sRp,1) )
if (nRp = 1) then begin
cRp := 'Seratus ';
end else if (nRp <> 0) then begin
cRp := aRp1[nRp] + 'Ratus ';
end;
sRp := Right(sRp,len(sRp)-1);
end;
if (length(sRp) = 2) then begin
nRp := StrToInt( Left(sRp,1) );
if (nRp = 1) then begin
nRp := StrToInt( Right(sRp,1) );
if (nRp = 0) then begin
cRp := cRp + 'Sepuluh ';
end else if (nRp = 1) then begin
cRp := cRp + 'Sebelas ';
end else begin
cRp := cRp + aRp1[nRp] + 'Belas ';
end;
sRp := '';
end else begin
cRp := cRp + aRp1[nRp] + 'Puluh ';
end;
sRp := Right(sRp,length(sRp)-1)
end;
if (length(sRp) = 1) then begin
nRp := StrToInt( sRp );
cRp := cRp + aRp1[nRp];
end;
Result := Result + cRp + aRp2[nRp2];
dec(nRp1);
dec(nRp2);
end;
if Trim(Result) <> '' then Result := Result + 'Rupiah';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
edit2.Text:=RpToStr(edit1.text);
end;
end.
error yang muncul:
[Error] U_Rkt.pas(36): Undeclared identifier: 'St' [Error] U_Rkt.pas(36): Incompatible types [Error] U_Rkt.pas(41): Undeclared identifier: 'St' [Error] U_Rkt.pas(47): There is no overloaded version of 'RpToStr' that can be called with these arguments [Error] U_Rkt.pas(53): Cannot initialize local variables [Error] U_Rkt.pas(54): Cannot initialize local variables [Error] U_Rkt.pas(54): Number of elements differs from declaration [Error] U_Rkt.pas(57): Identifier redeclared: 'nRp1' [Error] U_Rkt.pas(58 ) : Identifier redeclared: 'cRp' [Error] U_Rkt.pas(58 ) : ',' or ':' expected but '(' found [Error] U_Rkt.pas(60): Declaration expected but 'WHILE' found [Error] U_Rkt.pas(61): Incompatible types: 'String' and 'Enumeration' [Error] U_Rkt.pas(62): Incompatible types: 'String' and 'Enumeration' [Error] U_Rkt.pas(62): Incompatible types [Error] U_Rkt.pas(65): Declaration expected but identifier 'nRp2' found [Error] U_Rkt.pas(69): Undeclared identifier: 'cRp' [Error] U_Rkt.pas(70): Undeclared identifier: 'sRp' [Error] U_Rkt.pas(70): Undeclared identifier: 'nRp1' [Error] U_Rkt.pas(72): Incompatible types [Error] U_Rkt.pas(73): Undeclared identifier: 'nRp' [Error] U_Rkt.pas(74): Missing operator or semicolon [Warning] U_Rkt.pas(74): Comparing signed and unsigned types - widened both operands [Warning] U_Rkt.pas(76): Comparing signed and unsigned types - widened both operands [Error] U_Rkt.pas(77): Undeclared identifier: 'aRp1' [Error] U_Rkt.pas(79): Undeclared identifier: 'len' [Error] U_Rkt.pas(82): Incompatible types [Warning] U_Rkt.pas(84): Comparing signed and unsigned types - widened both operands [Warning] U_Rkt.pas(86): Comparing signed and unsigned types - widened both operands [Warning] U_Rkt.pas(88 ) : Comparing signed and unsigned types - widened both operands [Error] U_Rkt.pas(91): Incompatible types: 'String' and 'Integer' [Error] U_Rkt.pas(95): Incompatible types: 'String' and 'Integer' [Error] U_Rkt.pas(97): Incompatible types [Error] U_Rkt.pas(100): Incompatible types [Error] U_Rkt.pas(105): Undeclared identifier: 'Result' [Error] U_Rkt.pas(105): Undeclared identifier: 'aRp2' [Error] U_Rkt.pas(108): '.' expected but ';' found [Warning] U_Rkt.pas(111): Text after final 'END.' - ignored by compiler [Error] U_Rkt.pas(16): Unsatisfied forward or external declaration: 'TForm1.Button1Click' [Error] U_Rkt.pas(21): Unsatisfied forward or external declaration: 'TForm1.Right' [Error] U_Rkt.pas(22): Unsatisfied forward or external declaration: 'TForm1.Left' [Error] U_Rkt.pas(23): Unsatisfied forward or external declaration: 'TForm1.RpToStr' [Error] U_Rkt.pas(24): Unsatisfied forward or external declaration: 'TForm1.RpToStr' [Fatal Error] P_Rkt.dpr(5): Could not compile used unit 'U_Rkt.pas'2. saya coba utak-atik:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
aRp1 : array of String
= ('', 'Satu ', 'Dua ', 'Tiga ',
'Empat ', 'Lima ', 'Enam ', 'Tujuh ', 'Delapan ', 'Sembilan ');
aRp2 : array of String
= ('', 'Ribu ', 'Juta ', 'Milyar ', 'Triliun ');
type
TForm1 = class(TForm)
ed_rupiah: TEdit;
btn_convert: TButton;
ed_terbilang: TEdit;
Label1: TLabel;
Label2: TLabel;
btn_close: TButton;
procedure btn_convertClick(Sender: TObject);
procedure btn_closeClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function Right( Str: String; Len: Integer ): String;
function Left( Str: String; Len: Integer ): String;
function RpToStr( Rp: Double ): String; overload;
function RpToStr( Rp: String ): String; overload;
var
Form1: TForm1;
// Len:integer;
implementation
function Right( Str: String; Len: Integer ): String;
begin
Result := Copy(Str, (Length(Str)+1)-Len, Len);
end;
function Left( Str: String; Len: Integer ): String;
begin
Result := Copy(Str, 1, Len);
end;
function RpToStr( Rp: Double ): String; overload;
begin
Result := RpToStr( FloatToStr(Rp) );
end;
function RpToStr( Rp: String ): String; overload;
var cRp, sRp: String;
var nRp, nRp1, nRp2,len: Integer;
//var aRp1 : array of String
// = ('', 'Satu ', 'Dua ', 'Tiga ',
// 'Empat ', 'Lima ', 'Enam ', 'Tujuh ', 'Delapan ', 'Sembilan ');
//var aRp2 : array of String
// = ('', 'Ribu ', 'Juta ', 'Milyar ', 'Triliun ');
var aRp3 : Array of String;
begin
nRp1 := 0;
cRp := Trim( Rp );
while length(cRp) > 0 do begin
aRp3[nRp1] := Right(cRp, 3);
cRp := Left(cRp, length(cRp)-3);
inc(nRp1);
end;
nRp2 := nRp1;
Result := '';
while nRp1 >= 0 do begin
cRp := '';
sRp := aRp3[nRp1];
if (length(sRp) = 3) then begin
nRp := StrToInt( Left(sRp,1) );
if (nRp = 1) then begin
cRp := 'Seratus ';
end else if (nRp <> 0) then begin
cRp := aRp1[nRp] + 'Ratus ';
end;
// sRp := Right(sRp,len(sRp)-1);
sRp := Right(sRp,len-1);
end;
if (length(sRp) = 2) then begin
nRp := StrToInt( Left(sRp,1) );
if (nRp = 1) then begin
nRp := StrToInt( Right(sRp,1) );
if (nRp = 0) then begin
cRp := cRp + 'Sepuluh ';
end else if (nRp = 1) then begin
cRp := cRp + 'Sebelas ';
end else begin
cRp := cRp + aRp1[nRp] + 'Belas ';
end;
sRp := '';
end else begin
cRp := cRp + aRp1[nRp] + 'Puluh ';
end;
sRp := Right(sRp,length(sRp)-1)
end;
if (length(sRp) = 1) then begin
nRp := StrToInt( sRp );
cRp := cRp + aRp1[nRp];
end;
Result := Result + cRp + aRp2[nRp2];
dec(nRp1);
dec(nRp2);
end;
if Trim(Result) <> '' then Result := Result + 'Rupiah';
end;
{$R .DFM}
procedure TForm1.btn_convertClick(Sender: TObject);
begin
if ed_rupiah.Text='' then
begin
application.messagebox('isi heula Jang!', 'peringatan', MB_iconStop);
end
else
ed_terbilang.Text:=RpToStr(ed_rupiah.text);
end;
procedure TForm1.btn_closeClick(Sender: TObject);
begin
close;
end;
end.
ketika di running hasilnya emang "cuman" warning (program jalan):
[Warning] Unit1.pas(91): Variable 'len' might not have been initialized
tetapi Fatal! karena ketika program di coba hasilnya:
rupiah = 1 --> terbilang = Ribu Satu Rupiah
rupiah = 19 --> terbilang = Ribu Satu Rupiah
rupiah = 120 --> terbilang = Ribu Seratus Rupiah
Mohon pencerahannya...
karena jika ini berhasil, saya pengen coba buat aplikasi sistem antrian
seperti yang didiskusikan di link: http://pascal-id.org/dpr/viewtopic.php?t=3012&postdays=0&postorder=asc
thx b 4 :)
more 17 years ago
ImanD
ini dari library-ku, cuman ini function bukan procedure,xixixix
function Num2Word_Indonesian(dNumber: Extended): string;
const
aNum: array of String[8] = ('satu', 'dua', 'tiga', 'empat', 'lima', 'enam', 'tujuh', 'delapan', 'sembilan');
aUnit: array of String[7] = ('trilyun', 'milyar', 'juta', 'ribu', '');
var
iCount, iDigit1, iDigit2, iDigit3: Integer;
sNum2Str, s3Digit, sWord: string;
begin
Result := '';
if (dNumber=0) then Exit;
sNum2Str:=Copy(Format('%18.2f', [dNumber]), 1, 15);
for ICount:=1 to 5 do
begin
s3Digit:=Copy(sNum2Str, iCount*3-2, 3);
if (StrToIntDef(s3Digit, 0)<>0) then
begin
sWord:='';
iDigit1:=StrToIntDef(Copy(s3Digit, 1, 1), 0);
iDigit2:=StrToIntDef(Copy(s3Digit, 2, 1), 0);
iDigit3:=StrToIntDef(Copy(s3Digit, 3, 1), 0);
case iDigit1 of
2..9: sWord:=sWord+aNum[iDigit1]+' ratus ';
1: sWord:=sWord+'seratus ';
end; { case }
case iDigit2 of
2..9: sWord:=sWord+aNum[iDigit2]+' puluh ';
1: case iDigit3 of
2..9: sWord:=sWord+aNum[iDigit3]+' belas ';
1: sWord:=sWord+'sebelas ';
0: sWord:=sWord+'sepuluh ';
end; { case }
end; { case }
if (iDigit2<>1) then
case iDigit3 of
2..9: sWord:=sWord + aNum[iDigit3] + ' ';
1: if (iCount=4) and ((iDigit1+iDigit2)=0) then
sWord:=sWord+'se'
else
sWord:=sWord+'satu ';
end;
Result:=Result+sWord+aUnit[iCount]+' ';
end;
end;
while Result[Length(Result)]=' ' do
SetLength(Result, Length(Result)-1);
end;
cara pke
begin
Label1.Caption:=Num2Word_Indonesian(1234);
end;
more 17 years ago
gormet
alhamdulillah, sukses kang ImanD :)
rencana membuat "Sistem Antrean Berbasiskan Komputer" terus berjalan deh...
paling klo ada masalah nanya ke forum sini, hehehe...
berikut ini program Angka-ke-Terbilang:
unit U_NumToWord;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ed_number: TEdit;
Label1: TLabel;
btn_ubah: TButton;
Label2: TLabel;
ed_word: TEdit;
procedure btn_ubahClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R .DFM}
function Num2Word_Indonesian(dNumber: Extended): string;
const
aNum: array of String[8] = ('satu', 'dua', 'tiga', 'empat', 'lima', 'enam', 'tujuh', 'delapan', 'sembilan');
aUnit: array of String[7] = ('trilyun', 'milyar', 'juta', 'ribu', '');
var
iCount, iDigit1, iDigit2, iDigit3: Integer;
sNum2Str, s3Digit, sWord: string;
begin
Result := '';
if (dNumber=0) then Exit;
sNum2Str:=Copy(Format('%18.2f', [dNumber]), 1, 15);
for ICount:=1 to 5 do
begin
s3Digit:=Copy(sNum2Str, iCount 3-2, 3);
if (StrToIntDef(s3Digit, 0)<>0) then
begin
sWord:='';
iDigit1:=StrToIntDef(Copy(s3Digit, 1, 1), 0);
iDigit2:=StrToIntDef(Copy(s3Digit, 2, 1), 0);
iDigit3:=StrToIntDef(Copy(s3Digit, 3, 1), 0);
case iDigit1 of
2..9: sWord:=sWord+aNum[iDigit1]+' ratus ';
1: sWord:=sWord+'seratus ';
end; { case }
case iDigit2 of
2..9: sWord:=sWord+aNum[iDigit2]+' puluh ';
1: case iDigit3 of
2..9: sWord:=sWord+aNum[iDigit3]+' belas ';
1: sWord:=sWord+'sebelas ';
0: sWord:=sWord+'sepuluh ';
end; { case }
end; { case }
if (iDigit2<>1) then
case iDigit3 of
2..9: sWord:=sWord + aNum[iDigit3] + ' ';
1: if (iCount=4) and ((iDigit1+iDigit2)=0) then
sWord:=sWord+'se'
else
sWord:=sWord+'satu ';
end;
Result:=Result+sWord+aUnit[iCount]+' ';
end;
end;
while Result[Length(Result)]=' ' do
SetLength(Result, Length(Result)-1);
end;
procedure TForm1.btn_ubahClick(Sender: TObject);
var
x: double;
begin
x:=strtoint(ed_number.Text);
ed_word.Text:=Num2Word_Indonesian(x);
end;
end.
more ...
- Pages:
- 1
reply |
Report Obsolete
AI Forward
🚀 We're thrilled to partner with Alibaba Cloud for "AI Forward - Alibaba Cloud Global Developer Summit 2025" in Jakarta! Join us and explore the future of AI. Register now:
https://int.alibabacloud.com/m/1000400772/
#AlibabaCloud #DeveloperSummit #Jakarta #AIFORWARD
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 5 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 5 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 5 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 13 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 13 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 13 years ago
Random Topic
- select data dari combobox lalu tampil di DBGrid??
by titi3 in Hal umum tentang Pascal Indonesia more 16 years ago - mysql,oracle, interbase atau...database mana yang terbaik?
by ignisce in MySQL more 17 years ago - backup file access
by nurez in Enginering more 19 years ago - Export fild Image dari SQLServer 2005 ke Excell
by mrzie05 in MsSQL more 13 years ago - tanya form
by sulth4n in Tip n Trik Pemrograman more 19 years ago - Gate Access + Barcode
by ir1keren in Network, Files, I/O & System more 16 years ago - Tanya : bikin program database diinternet
by cyber_hecker in Network, Files, I/O & System more 20 years ago - Posisi Alligment Center di TEDIT
by DeulleDo-X in Hal umum tentang Pascal Indonesia more 18 years ago - mendesable scrollbar di webbrowser
by skh_cay in Hal umum tentang Pascal Indonesia more 15 years ago - Jual Aplikasi BPR
by adokonax in OOT more 19 years ago