Mega Code Archive
Sayıyı yazıya çeviren fonsiyon
<![CDATA[
{Bu fonksiyon 24 haneleri hata vermeden
yazıya çevirmektedir. 18 haneye kadar tam
olarak dönüşüm yapmaktadır. Bilindiği gibi bilgisayar
18 haneden sonra yuvarlama yapmaktadır.}
Function SayiYazi(Sayi: Extended): String;
Const
Yuzler: Array[1..3,0..9] of String=(
('','YÜZ','İKİYÜZ','ÜÇYÜZ','DÖRTYÜZ','BEŞYÜZ','ALTIYÜZ','YEDİYÜZ','SEKİZYÜZ','DOKUZYÜZ'),
('','ON','YİRMİ','OTUZ','KIRK','ELLİ','ALTMIŞ','YETMİŞ','SEKSEN','DOKSAN'),
('','BİR','İKİ','ÜÇ','DÖRT','BEŞ','ALTI','YEDİ','SEKİZ','DOKUZ'));
Binler: Array[1..8] of String=
('KATTRİLYAR','TRİLYAR','KATTRİLYON','TRİLYON','MİLYAR','MİLYON','BİN','');
Var
FloR: TFloatRec;
FloV: TFloatValue;
i, y, z: Integer;
Parca : String;
ASt: String[24];
EkSt: String[26];
AraSonuc, Sonuc: String;
n, hane: Integer;
Begin
Sonuc:='';
FloV:= fvExtended;
FloatToDecimal(FloR,Sayi,FloV,18,0);
ASt:=FloR.Digits;
n:=length(ASt);
if FloR.Exponent<>Length(ASt) then
begin
EkSt:='';
FillChar(EkSt,FloR.Exponent-n+1,'0');
EkSt[0]:=Chr(FloR.Exponent-n);
ASt:=ASt+EkSt;
end;
n:=Length(ASt);
if n<24 then
begin
EkSt:='';
FillChar(EkSt,24-n+1,'0');
EkSt[0]:=Chr(24-n);
ASt:=EkSt+ASt;
end;
n:=Length(ASt);
i:=1;
hane:=1;
while i<n do
begin
Parca:=Copy(ASt,i,3);
AraSonuc:='';
for y:=1 to 3 do
begin
z:=StrToInt(Copy(Parca,y,1));
AraSonuc:=AraSonuc+Yuzler[y,z];
end;
if AraSonuc<>'' then AraSonuc:=AraSonuc+Binler[hane];
if AraSonuc='BİRBİN' then AraSonuc:='BİN';
i:=i+3;
Inc(hane);
Sonuc:=Sonuc+AraSonuc;
end;
SayiYazi:=Sonuc;
end;
//Kullanımı
//Formumuzda label,edit ve button olsun.
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:=SayiYazi(StrToFloat(Edit1.Text));
end;
]]>