YTL Rakamları Yazıya Cevirme

[zengin]

Degerli arkadaşlarım YTL Rakamları Yazıya Cevirmek istiyorum
1.250,00 olan sayıyı yazıya dönüştürmek istiyorum
örnegin aşagıdaki kodlarla ben bunu yapıyorum fakat 1. nokta derken hata veriyor bana bu konuda yardımlarınızı bekliyorum
saygılarımla y zengin

Kod: Tümünü seç

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:= frac(Rakam)*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 Asil = 0 then 
        begin 
        Result := 'Sıfır'+ParaBirimi; 
        end; 
        if kurus > 0 then 
        begin 
        Result := SayiYazi(Kurus)+ Kurusbirimi; 
        end else 
        begin 
        if Kurus < 0 then 
        begin 
        Result := 'Eksi'+SayiYazi(Kurus)+ Kurusbirimi; 
        end; 
        end; 
        if Asil < 0 then 
        begin 
        if Kurus = 0 then 
        begin 
        Result := 'Eksi'+SayiYazi(asil)+Parabirimi; 
        end else 
        begin 
        Result := 'Eksi'+SayiYazi(asil)+Parabirimi+' '+SayiYazi(Kurus)+ KurusBirimi; 
        end; 
        end; 
        end; 
end; 

{$R *.DFM} 
procedure TForm1.Edit1Change(Sender: TObject); 
begin 
Label1.Caption := SayiYaziKurus(StrToFloat(Edit1.Text),' YTL',' YKR',2); 
end; 

[husonet]

Hazır kodlarını Forum'a daha önce ben ve Gökmen hocam atmıştı.

Arayalım bulalım zaman kazanalım


Kolay Gelsin...

[mrmarman]

Merhaba...

- Virgül ile girmene izin veriyorsa, Lira / Kuruş ayracın sistemde virgül olarak tanımlı demektir... Bu durumda nokta koyduğundahata vermesi doğal...

- İsterden OnKeyPress olayında tüm nokta girişlerini virgül ile otomatik değişmesini sağlayabilirsin..

- Hatta bir ekleme ile bunu mükerrer nokta girişine engel olarak da halledebilirsin...

Kod: Tümünü seç

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  If (Key = '.') Then If ( Pos(',', Edit1.Text) = 0 )
  then Key := ','
  else Key := #0;
end;

[zengin]

Dedegli ustalarım ilgilendiginiz icin teşekkür ederim
Amacım fatura tutarını yazı ile göstermek tablede format Flot olayını Bu şekilde#,##0.00 ayarladım
örnegin fatura tutarı 24.816,75 ytl oldugunda hata veriyor iki defa ayrac
kullanmak zorunda kalıyorum bir nokta bir virgül
bana bu konuda yardımlarınızı bekliyorum
saygılarımla

[Firarist]

Aynı sıkıntıyı bende yaşamıştım. Sağolsun buranın ustalarından Husonet hocam problemi anında çözüvermişti. Ben de size yardımcı olmak için yazıyorum. Ayrıca bu forumda bu benim ilk cevabım olacak
HusoEdit Component'ini kullanıyorum.

Label1.Caption := SayiYaziKurus(StrToFloat(FloatToStr(Edit1.Value(Edit1.Text))),' YTL.',' YKr.',2);

Başarılar

[selimr]

selam

SrEditFloat; adında bir bileşen yazmıştım onu kullanabilirsin.

sreditfloat diye arat gelir.

[zengin]

Degerli arkadaşlarım sayıları yazıya cevirme işlemini gecici olarak
iki editle yaptım fakat daha degişik bir kısa koda ihtiyacım var
bilgili arkadaşlardan yardım bekliyorum

örnek kod aşagıdaki gibi calışıyor

Kod: Tümünü seç

var
a:string;
i:integer;
begin
if length(Tedit(Sender).text)>0 then begin
a:=Tedit(sender).text;
for i:=0 to length(a) do begin
delete(a,pos('.',a),1);
end;
keybd_event(vk_end,0,0,0);
keybd_event(vk_end,0,KEYEVENTF_KEYUP,0);
edit3.text:=FormatFloat('#.00',strtofloat(a));
Tedit(edit2).text:=FormatFloat('#,##.00',strtofloat(a));
Label10.Caption := SayiYaziKurus(StrToFloat(Edit3.Text),' YTL',' YKR',2);