Mega Code Archive
Sayı yazı çeviren function kuruş dahil
<![CDATA[
//Baktım olacak gibi değil kendim SayiYazi function'ına ek yaptım ve güzel bir sonuç
//aldım. Aşağıdaki Kod girilen para birimi ve kuruş birimine göre herhangi başka bir
//ülkenin para birimine göre de ayarlanabiliyor. Ayrıca ondalik Kısmının basamak
//sayısını da belirterek kuruş kısmını yazdırabilirsiniz. Sonuç kuruşlu olsa dahi
//siz belirtmedikçe kuruş kısmını yazmaz veya kuruş kısmı 2 basamaklıdır. Siz sonucu
//3 basamak olarak isteyebilirsiniz. Kimi kodlara baktım eğer sayı 0,25 şeklinde ise
//sonucu vermiyordu veya 0 YTL 25 Kuruş gibi bir sonuç veriyordu. Bu kodda bu tür
//sorunlar yok ve para ve kuruş birimi sizin elinizde.
// Öncelikle aşağıdaki function'ı unit'inizin aşağıdaki kısmından sonra tanımlayın.
//implementation
//{$R *.DFM}
Function SayiYaziKurus(Rakam: Extended; ParaBirimi: String; KurusBirimi: String;Ondalik:Integer): string;
var
Asil, Kurus: Extended;
Say, Onda: Integer;
Function SayiYazi(Sayi: Extended): String;
Const
Yuzler: Array[1..3,0..9] of String=(
('','Yüz','İkiYüz','ÜçYüz','DörtYüz','BeşYüz','AltıYüz','YediYüz','SekizYüz','DokuzYüz'),
('','On','Yirmi','Otuz','Kırk','Elli','Altmış','Yetmiş','Seksen','Doksan'),
('','Bir','İki','Üç','Dört','Beş','Altı','Yedi','Sekiz','Dokuz'));
Binler: Array[1..8] of String=
('KatTrilyar','Trilyar','KatTrilyon','Trilyon','Milyar','Milyon','Bin','');
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='BirBin' then AraSonuc:='Bin';
i:=i+3;
Inc(hane);
Sonuc:=Sonuc+AraSonuc;
end;
SayiYazi:=Sonuc;
end;
begin
if Ondalik > 0 then
begin
Onda := 1;
for say := 1 to Ondalik do
begin
Onda := 10*Onda;
end;
end;
Asil:= int(Rakam);
Kurus:= (Rakam-Asil)*onda;
if Asil > 0 then
begin
if Kurus <= 0 then
begin
Result := SayiYazi(asil)+Parabirimi;
end else
begin
Result := SayiYazi(asil)+Parabirimi+' '+SayiYazi(Kurus)+ KurusBirimi;
end;
end else
begin
if kurus > 0 then
begin
Result := SayiYazi(Kurus)+ Kurusbirimi;
end;
end;
if Rakam = 0 then
Result := 'Sıfır'+Parabirimi;
end;
// Kullanımı (Mesela Bir Edit'in Onchange Olayında)
procedure TForm1.Edit1Change(Sender: TObject);
begin
Label1.Caption := SayiYaziKurus(StrToFloat(Edit1.Text),' YTL',' YKR',2);
end;
//Edit1.Text := '125,25'; olduğunu kabul edersek Sonuç 'YüzYirmiBeş YTL 25 YKR' olacaktır.
// İlginç, farklı ve kullanışlı kodları olanlar bad_badboy_boy@hotmail.com 'a
// mail atabilir. Teşekkürler.
]]>