Mega Code Archive
Sayıı yazıya çeviren fonksiyon ytl destekli
<![CDATA[
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;
//fonksiyonun kullanımı
procedure TForm1.Button1Click(Sender: TObject);
var
a1,b,c:integer;
kusurat :string;
begin
a1:=length(edit1.text);
b:= pos(',',edit1.Text)+1;
c:=(a1-b)+1;
kusurat:= copy(Edit1.Text,b,c);
try
if pos(',',edit1.Text)>0 then begin
Label1.Caption:=SayiYazi(StrToFloat(Edit1.Text));
Label2.Caption:=SayiYazi(StrToFloat(kusurat));
Label3.Caption := Label1.Caption+' YTL '+Label2.Caption+' Kuruş';
end
else begin
Label1.Caption:=SayiYazi(StrToFloat(Edit1.Text));
Label3.Caption:= Label1.Caption+' YTL ';
end;
except
on e : exception do ShowMessage(' hatali giriş');
end;
end;
]]>