Virgül ile Ayrılmış Sayıyı Yazıya ÇEvirmek

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

function Cevir(Val : extended) : String;
const
hanex : array[0..2, '0'..'9'] of String = (
('', 'Bir ', 'İki ', 'Üç ', 'Dört ', 'Beş ', 'Altı ', 'Yedi ', 'Sekiz ', 'Dokuz '),
('', 'On ', 'Yirmi ', 'Otuz ', 'Kırk ', 'Elli ', 'Atmış ', 'Yetmiş ', '****en ', 'Doksan '),
('', 'Yüz ', 'İki Yüz ', 'Üç Yüz ', 'Dört Yüz ', 'Beş Yüz ', 'Altı Yüz ', 'Yedi Yüz ', 'Sekiz Yüz ', 'Dokuz Yüz '));
katx : array[0..5] of String = ('', 'Bin ', 'Milyon ', 'Milyar ', 'Trilyon ', 'Katrilyon ');
var
Kat : Integer;
function _Cevir(sy : String) : String;
var
lsy, hn : Integer;
begin

Result := ''; if sy = '' then Exit;
if (sy = '1') and (kat = 1) then begin Result := 'Bin'; Exit; end;
hn := 0; lsy := length(sy);
while (hn < 3) and (hn < lsy)
do
begin

Result := hanex[hn, sy[lsy - hn]] + Result;
Inc(hn);
end;
Result := Result + katx[kat];
Inc(kat);
if lsy > 3 then Result := _Cevir(copy(sy, 1, lsy - 3)) + Result;
end;
begin
Result := ''; kat := 0;
Result := _Cevir(formatFloat('##0', int(Val)));
end;
function TExCevir(e:extended):string;
var
e1,e2:Extended;
lenE2:integer;
s1,s2:string;
const virgul : array[0..20] of string = (
'','Onda','Yüzde','Binde','Onbinde',
'Yüzbinde','Milyonda','Onmilyonda','Yüzmilyonda',' Milyarda',
'Onmilyarda','Yüzmilyarda','Trilyonda','Ontrilyond a','Yüztrilyonda',
'Katrilyonda','Onkatrilyonda','Yüzkatrilyonda','Ka trilyarda','Onkatrilyarda','Yüzkatrilyarda');
begin
e1:=Int(e);
e2:=e-e1;
lenE2:=StrLen(PChar(FloatToStr(e2)));
e2:=e2 * Power(10,lenE2-2);
s1:=Cevir(e1);
s2:=Cevir(e2);
lenE2:=StrLen(PChar(FloatToStr(e2)));
if e2<>0 then
begin
Result:=s1 + ' tam ' + virgul[lenE2] + ' ' + s2;
end
else
begin
Result:=s1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(TExCevir(StrToFloat(edit1.Text)));

end;

28-01-2008, 12:26	#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 :	Virgül ile Ayrılmış Sayıyı Yazıya ÇEvirmek function Cevir(Val : extended) : String; const hanex : array[0..2, '0'..'9'] of String = ( ('', 'Bir ', 'İki ', 'Üç ', 'Dört ', 'Beş ', 'Altı ', 'Yedi ', 'Sekiz ', 'Dokuz '), ('', 'On ', 'Yirmi ', 'Otuz ', 'Kırk ', 'Elli ', 'Atmış ', 'Yetmiş ', '***en ', 'Doksan '), ('', 'Yüz ', 'İki Yüz ', 'Üç Yüz ', 'Dört Yüz ', 'Beş Yüz ', 'Altı Yüz ', 'Yedi Yüz ', 'Sekiz Yüz ', 'Dokuz Yüz ')); katx : array[0..5] of String = ('', 'Bin ', 'Milyon ', 'Milyar ', 'Trilyon ', 'Katrilyon '); var Kat : Integer; function _Cevir(sy : String) : String; var lsy, hn : Integer; begin Result := ''; if sy = '' then Exit; if (sy = '1') and (kat = 1) then begin Result := 'Bin'; Exit; end; hn := 0; lsy := length(sy); while (hn < 3) and (hn < lsy) do begin Result := hanex[hn, sy[lsy - hn]] + Result; Inc(hn); end; Result := Result + katx[kat]; Inc(kat); if lsy > 3 then Result := _Cevir(copy(sy, 1, lsy - 3)) + Result; end; begin Result := ''; kat := 0; Result := _Cevir(formatFloat('##0', int(Val))); end; function TExCevir(e:extended):string; var e1,e2:Extended; lenE2:integer; s1,s2:string; const virgul : array[0..20] of string = ( '','Onda','Yüzde','Binde','Onbinde', 'Yüzbinde','Milyonda','Onmilyonda','Yüzmilyonda',' Milyarda', 'Onmilyarda','Yüzmilyarda','Trilyonda','Ontrilyond a','Yüztrilyonda', 'Katrilyonda','Onkatrilyonda','Yüzkatrilyonda','Ka trilyarda','Onkatrilyarda','Yüzkatrilyarda'); begin e1:=Int(e); e2:=e-e1; lenE2:=StrLen(PChar(FloatToStr(e2))); e2:=e2 Power(10,lenE2-2); s1:=Cevir(e1); s2:=Cevir(e2); lenE2:=StrLen(PChar(FloatToStr(e2))); if e2<>0 then begin Result:=s1 + ' tam ' + virgul[lenE2] + ' ' + s2; end else begin Result:=s1; end; end; procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage(TExCevir(StrToFloat(edit1.Text))); 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
Track müzik dosyalarını MP3'e cevirmek	LetHaLSpike_The_Bro	Programlar	0	16-06-2008 16:26
Bu SaYıYı oKuYana HeLAL oLSUn (Dunyanın En uzun saYsı DıyoLar !!)	biLL_BoySs	Garip olaylar	1	23-03-2008 22:32