Parayı İngilizce yazdırmak için Fonksiyon

~~*MeLeK*~~ · 28-01-2008, 12:27

const
Birler : Array[0..9] of string = ('','one','two','three','four','five','six','seven ','eight','nine');
YirmiyeKadar : Array[0..19] of string = ('','one','two','three','four','five','six','seven ','eight','nine','ten','eleven','twelve','thirteen ','fourteen','fifteen','sixteen','seventeen','eigh teen','nineteen');
Onluklar : Array[2..9] of string = ('twenty','thirty','forty','fifty','sixty','sevent y','eighty','ninety');

implementation

{$R *.dfm}

function UcluyuCevir(CevirilecekSayi: Integer): string;
var
Donecek: String;
begin
Donecek := '';
if Length(IntToStr(CevirilecekSayi)) = 3 then // 33333333333333333333333333333
begin
Donecek := Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))]+'hundred';
if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,2))];
if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) >= 20 then
begin
Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))];
Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),3,1))];
end;
end;
if Length(IntToStr(CevirilecekSayi)) = 2 then // 22222222222222222222222222222
begin
if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,2))];
if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) >= 20 then
begin
Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))];
Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))];
end;
end;
if Length(IntToStr(CevirilecekSayi)) = 1 then // 11111111111111111111111111111
begin
if StrToInt(Copy(IntToStr(CevirilecekSayi),1,1)) = 0 then Exit;
Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))];
end;
Result := Donecek;
end;

function YaziyaCevir(CevirilecekSayi: Real): string;
var
a,AlinacakYer,Bolum,Kalan,YaziUzunlugu: Integer;
Yazi,Parca: String;
begin
if CevirilecekSayi = 0 then
begin
Result := 'Zero'; Exit;
end;
// Tamsayı kısmı ************************************************** ***********
Yazi := '';
Bolum := Length(FloatToStr(int(CevirilecekSayi))) div 3;
Kalan := Length(FloatToStr(Trunc(CevirilecekSayi))) mod 3;
YaziUzunlugu := Length(FloatToStr(Trunc(CevirilecekSayi)));
for a := 1 to Bolum do
begin
AlinacakYer := YaziUzunlugu-(a*3)+1;
Parca := '';
Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),AlinacakYer,3)));
if a = 1 then Yazi := Parca;
if (a = 2) and (Parca <> '') then Yazi := Parca+'thousand'+Yazi;
if (a = 3) and (Parca <> '') then Yazi := Parca+'million'+Yazi;
if (a = 4) and (Parca <> '') then Yazi := Parca+'billion'+Yazi;
if (a = 5) and (Parca <> '') then Yazi := Parca+'trillion'+Yazi;
end;
if Kalan > 0 then
begin
if a = 0 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)));
if a = 2 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'thousand'+Yazi;
if a = 3 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'million'+Yazi;
if a = 4 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'billion'+Yazi;
if a = 5 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'trillion'+Yazi;
end;
// Virgüllü kısmı ************************************************** **********
Parca := '';
a := Pos(',',FloatToStr(CevirilecekSayi));
if a > 0 then
begin
if Length(Copy(FloatToStr(CevirilecekSayi),a+1,2)) = 1 then
Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),a+1,2)+'0')) else
Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),a+1,2)));
if Parca <> '' then Parca := ' and ' + Parca + ' cent';
end;
if Yazi <> '' then Result := Yazi + ' Euro' + Parca;
if Yazi = '' then
begin
Delete(Parca,1,5);
Result := Parca;
end;
end;

28-01-2008, 12:27	#1 (permalink)
~~MeLeK~~ Banlandı Üyelik tarihi: 22-11-2007 Nerden: napıcan ziyaretemi geLcen!! Mesajlar: 0 Konular: 2724 Üye No: 11416 Ruh halim: Rep Gücü : 0 Rep Puanı : 0 Rep Seviyesi :	Parayı İngilizce yazdırmak için Fonksiyon const Birler : Array[0..9] of string = ('','one','two','three','four','five','six','seven ','eight','nine'); YirmiyeKadar : Array[0..19] of string = ('','one','two','three','four','five','six','seven ','eight','nine','ten','eleven','twelve','thirteen ','fourteen','fifteen','sixteen','seventeen','eigh teen','nineteen'); Onluklar : Array[2..9] of string = ('twenty','thirty','forty','fifty','sixty','sevent y','eighty','ninety'); implementation {$R .dfm} function UcluyuCevir(CevirilecekSayi: Integer): string; var Donecek: String; begin Donecek := ''; if Length(IntToStr(CevirilecekSayi)) = 3 then // 33333333333333333333333333333 begin Donecek := Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))]+'hundred'; if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,2))]; if StrToInt(Copy(IntToStr(CevirilecekSayi),2,2)) >= 20 then begin Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))]; Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),3,1))]; end; end; if Length(IntToStr(CevirilecekSayi)) = 2 then // 22222222222222222222222222222 begin if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) < 20 then Donecek := Donecek + YirmiyeKadar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,2))]; if StrToInt(Copy(IntToStr(CevirilecekSayi),1,2)) >= 20 then begin Donecek := Donecek + Onluklar[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))]; Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),2,1))]; end; end; if Length(IntToStr(CevirilecekSayi)) = 1 then // 11111111111111111111111111111 begin if StrToInt(Copy(IntToStr(CevirilecekSayi),1,1)) = 0 then Exit; Donecek := Donecek + Birler[StrToInt(Copy(IntToStr(CevirilecekSayi),1,1))]; end; Result := Donecek; end; function YaziyaCevir(CevirilecekSayi: Real): string; var a,AlinacakYer,Bolum,Kalan,YaziUzunlugu: Integer; Yazi,Parca: String; begin if CevirilecekSayi = 0 then begin Result := 'Zero'; Exit; end; // Tamsayı kısmı *********************************************** ********* Yazi := ''; Bolum := Length(FloatToStr(int(CevirilecekSayi))) div 3; Kalan := Length(FloatToStr(Trunc(CevirilecekSayi))) mod 3; YaziUzunlugu := Length(FloatToStr(Trunc(CevirilecekSayi))); for a := 1 to Bolum do begin AlinacakYer := YaziUzunlugu-(a3)+1; Parca := ''; Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),AlinacakYer,3))); if a = 1 then Yazi := Parca; if (a = 2) and (Parca <> '') then Yazi := Parca+'thousand'+Yazi; if (a = 3) and (Parca <> '') then Yazi := Parca+'million'+Yazi; if (a = 4) and (Parca <> '') then Yazi := Parca+'billion'+Yazi; if (a = 5) and (Parca <> '') then Yazi := Parca+'trillion'+Yazi; end; if Kalan > 0 then begin if a = 0 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan))); if a = 2 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'thousand'+Yazi; if a = 3 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'million'+Yazi; if a = 4 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'billion'+Yazi; if a = 5 then Yazi := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),1,Kalan)))+'trillion'+Yazi; end; // Virgüllü kısmı *********************************************** ******** Parca := ''; a := Pos(',',FloatToStr(CevirilecekSayi)); if a > 0 then begin if Length(Copy(FloatToStr(CevirilecekSayi),a+1,2)) = 1 then Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),a+1,2)+'0')) else Parca := UcluyuCevir(StrToInt(Copy(FloatToStr(CevirilecekSa yi),a+1,2))); if Parca <> '' then Parca := ' and ' + Parca + ' cent'; end; if Yazi <> '' then Result := Yazi + ' Euro' + Parca; if Yazi = '' then begin Delete(Parca,1,5); Result := Parca; end; end;

Konu Araçları
Yazdırılabilir şekli göster Sayfayı E-Mail olarak gönder
Stil
Normal Hybrid-şeklinde gösterime geç Ağaç şeklinde gösterime geç

Benzer Konular
Konu	Konuyu Başlatan	Forum	Cevaplar	son Mesaj
parayı veren düdüğü çalar	TürküBaba	Fıkralar	0	10-08-2008 15:52
İngilizce Ders - 14	αкѕу	Yabancı Dil	0	23-07-2008 03:55
G.Saray EURO 2008 zengini olacak yine parayı kırdınız :)	WaHShi	EURO 2008	8	22-05-2008 20:10
MS-DOS Konsolunda Türkçe karakter sorununa SON! printf() ile Türkçe Harf yazdırmak!	wanted	C ve C++	0	28-01-2008 02:03
.::Nero 'da 900 Mb Cd Yazdırmak::.	game ower	Donanım	0	23-01-2008 18:01