firebird’de sayıları yazıya çeviren procedure

Firebird ve Interbase veritabanları ve SQL komutlarıyla ilgli sorularınızı sorabilirsiniz. Delphi tarafındaki sorularınızı lütfen Programlama forumunda sorunuz.
Cevapla
Kullanıcı avatarı
ALUCARD
Üye
Mesajlar: 1269
Kayıt: 27 Eyl 2003 10:12
Konum: Samsun
İletişim:

firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen ALUCARD »

bu fonksiyonu bulduğumda çok sevinmiştim. çok işime yaradı.

Kullanım:

Kod: Tümünü seç

SELECT p.TUTARYAZI FROM YAZIYLA(111023.03) p
TUTARYAZI
---------
YÜZONBİRBİNYİRMİÜÇ TL ÜÇ KR
Kaynak kodları…

Kod: Tümünü seç

SET TERM ^ ;

CREATE PROCEDURE BASAMAKYAZI( BASAMAK Integer, RAKAM Integer )
RETURNS ( YAZI Varchar(20) ) 
AS
BEGIN
    YAZI= 
    case basamak
    when 1 then
        case rakam
            when 1 then 'BİR'
            when 2 then 'İKİ'
            when 3 then 'ÜÇ'
            when 4 then 'DÖRT'
            when 5 then 'BEŞ'
            when 6 then 'ALTI'
            when 7 then 'YEDİ'
            when 8 then 'SEKİZ'
            when 9 then 'DOKUZ'
        end
    when 2 then
        case rakam
            when 1 then 'ON'
            when 2 then 'YİRMİ'
            when 3 then 'OTUZ'
            when 4 then 'KIRK'
            when 5 then 'ELLİ'
            when 6 then 'ALTMIŞ'
            when 7 then 'YETMİŞ'
            when 8 then 'SEKSEN'
            when 9 then 'DOKSAN'
        end
    when 3 then
        case rakam
        when 1 then 'YÜZ'
        when 2 then 'İKİYÜZ'
        when 3 then 'ÜÇYÜZ'
        when 4 then 'DÖRTYÜZ'
        when 5 then 'BEŞYÜZ'
        when 6 then 'ALTIYÜZ'
        when 7 then 'YEDİYÜZ'
        when 8 then 'SEKİZYÜZ'
        when 9 then 'DOKUZYÜZ'
    end
end;
SUSPEND;
END^
SET TERM ; ^

SET TERM ^ ;
CREATE PROCEDURE YAZIYLA ( TUTAR Numeric(18,2) )
RETURNS ( TUTARYAZI Varchar(300) )
AS
DECLARE VARIABLE tutarstr VARCHAR(50);
DECLARE VARIABLE yazi VARCHAR(50);
DECLARE VARIABLE len integer;
DECLARE VARIABLE tamsayistr VARCHAR(50);
DECLARE VARIABLE tamsayiuz integer;
DECLARE VARIABLE kesirstr VARCHAR(2);
DECLARE VARIABLE i integer;
DECLARE VARIABLE rakam integer;
DECLARE VARIABLE basamak integer;
DECLARE VARIABLE uclubasamak integer;
BEGIN

    tutarstr=tutar;
    len = 0;
    TUTARYAZI = '';
    len= CHAR_LENGTH(tutarstr);

    IF (len = 0) THEN
    BEGIN
        TUTARYAZI = 'SIFIR';
    END
    
    tamsayiuz = len-3;
    tamsayistr = SUBSTRING(tutarstr FROM 1 FOR tamsayiuz);
    kesirstr = SUBSTRING(tutarstr FROM len-1 FOR 2);

    i = 1;
    uclubasamak = tamsayiuz;
    WHILE (uclubasamak>3) DO BEGIN
        uclubasamak = uclubasamak-3;
    END

    -- Tam kısmı
    WHILE (i<=tamsayiuz) DO
    BEGIN
        rakam = SUBSTRING(tamsayistr FROM i FOR 1);
        basamak = tamsayiuz-i+1;
    
        IF ((tamsayiuz=1) AND rakam=0) THEN TUTARYAZI = 'SIFIR';

        IF (( rakam>0 ) and (not ( tamsayiuz = 4 and basamak = 4 and rakam = 1 ))) THEN
        BEGIN
            -- 1111 
            EXECUTE PROCEDURE BASAMAKYAZI(:uclubasamak,:rakam) RETURNING_VALUES :YAZI;
            TUTARYAZI = TUTARYAZI || TRIM(YAZI);
        END

        IF ((BASAMAK=4) AND (TUTARYAZI not like '%MİLYON' and TUTARYAZI not like '%MİLYAR')) THEN TUTARYAZI = TUTARYAZI||'BİN' ;
        IF ((BASAMAK=7) AND ( TUTARYAZI not like '%MİLYAR' )) THEN TUTARYAZI = TUTARYAZI || 'MİLYON';
        IF (BASAMAK=10) THEN TUTARYAZI = TUTARYAZI || 'MİLYAR';

        i = i + 1;
        uclubasamak = uclubasamak - 1;
        IF (uclubasamak = 0) THEN uclubasamak = 3;
    END
    
    TUTARYAZI = TUTARYAZI||' TL ';

    -- Kuruş Kısmı
    IF (CAST (kesirstr AS INTEGER)>0) THEN
    BEGIN
        rakam = SUBSTRING(kesirstr FROM 1 FOR 1);
        IF ( rakam > 0 ) THEN
        BEGIN
            EXECUTE PROCEDURE BASAMAKYAZI(2,:rakam) RETURNING_VALUES :YAZI;
            TUTARYAZI= TUTARYAZI||TRIM(YAZI);
        END

        rakam = SUBSTRING(kesirstr FROM 2 FOR 1);
        IF ( rakam > 0 ) THEN
        BEGIN
            EXECUTE PROCEDURE BASAMAKYAZI(1,:rakam) RETURNING_VALUES :YAZI;
            TUTARYAZI= TUTARYAZI||TRIM(YAZI);
        END
        TUTARYAZI= TUTARYAZI||' KR';
    END

SUSPEND;
END^
SET TERM ; ^
Sitemde de yayınladım : http://www.erkancaglar.com.tr/firebirdd ... procedure/
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
Forumun 365. Üyesi
Hiç Bir Şey İnsan Kadar Yükselemez ve Alçalamaz

Erkan ÇAĞLAR
Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 12:07
Konum: İstanbul
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen Kuri_YJ »

Selamlar,

Ben kodu inceledim ve ben de bir tane yazayım dedim. Biraz daha anlaşılır ve açıklamalar içeren procedureler yazdım. Yeni başlayan arkadaşlara hem bir mantık vermesi açısından hem de değişik bir çözüm olması açısından ben de gönderiyorum.

Kod: Tümünü seç

SET TERM ^^ ;
CREATE PROCEDURE SP_BLOK_BASAMAK (
  PRM_BLOK SmallInt)
 returns (
  RET_YAZI VarChar(25))
AS
BEGIN
    RET_YAZI = CASE PRM_BLOK 
                    WHEN 0 THEN ''
                    WHEN 1 THEN 'BİN'
                    WHEN 2 THEN 'MİLYON'
                    WHEN 3 THEN 'MİLYAR'
                    WHEN 4 THEN 'TRİLYON'
                    WHEN 5 THEN 'KATRİLYON'
                    WHEN 6 THEN 'KENTİLYON'
                    ELSE 'ÇÜŞİLYON...'
               END; 
    SUSPEND;
END ^^
SET TERM ; ^^

Kod: Tümünü seç

SET TERM ^^ ;
CREATE PROCEDURE SP_BASAMAK (
  PRM_BASAMAK SmallInt, 
  PRM_RAKAM Char(1))
 returns (
  RET_YAZI VarChar(25))
AS
BEGIN
    RET_YAZI = CASE PRM_BASAMAK
                    WHEN 3 THEN
                         CASE PRM_RAKAM 
                              WHEN '0' THEN ''
                              WHEN '1' THEN 'BİR'
                              WHEN '2' THEN 'İKİ'
                              WHEN '3' THEN 'ÜÇ'
                              WHEN '4' THEN 'DÖRT'
                              WHEN '5' THEN 'BEŞ'
                              WHEN '6' THEN 'ALTI'
                              WHEN '7' THEN 'YEDİ'
                              WHEN '8' THEN 'SEKİZ'
                              WHEN '9' THEN 'DOKUZ'
                         END
                    WHEN 2 THEN 
                         CASE PRM_RAKAM 
                              WHEN '0' THEN ''
                              WHEN '1' THEN 'ON'
                              WHEN '2' THEN 'YİRMİ'
                              WHEN '3' THEN 'OTUZ'
                              WHEN '4' THEN 'KIRK'
                              WHEN '5' THEN 'ELLİ'
                              WHEN '6' THEN 'ALTMIŞ'
                              WHEN '7' THEN 'YETMİŞ'
                              WHEN '8' THEN 'SEKSEN'
                              WHEN '9' THEN 'DOKSAN'
                         END
                    WHEN 1 THEN 
                         CASE PRM_RAKAM 
                              WHEN '0' THEN ''
                              WHEN '1' THEN 'YÜZ'
                              WHEN '2' THEN 'İKİYÜZ'
                              WHEN '3' THEN 'ÜÇYÜZ'
                              WHEN '4' THEN 'DÖRTYÜZ'
                              WHEN '5' THEN 'BEŞYÜZ'
                              WHEN '6' THEN 'ALTIYÜZ'
                              WHEN '7' THEN 'YEDİYÜZ'
                              WHEN '8' THEN 'SEKİZYÜZ'
                              WHEN '9' THEN 'DOKUZYÜZ'
                         END
               END ; 
    SUSPEND;
END ^^
SET TERM ; ^^

Kod: Tümünü seç

SET TERM ^^ ;
CREATE PROCEDURE SP_YAZI_ILE (
  PRM_TUTAR Numeric(18,2))
 returns (
  RET_YAZI VarChar(512))
AS
DECLARE VARIABLE STR_RAKAMLAR VARCHAR(25);
DECLARE VARIABLE INT_BOY INTEGER;
DECLARE VARIABLE STR_TAMSAYI VARCHAR(25);
DECLARE VARIABLE STR_ONDALIK VARCHAR(3);
DECLARE VARIABLE INT_BLOK_SAYISI INTEGER;
DECLARE VARIABLE INT_SAYAC INTEGER;
DECLARE VARIABLE INT_GECICI INTEGER;
DECLARE VARIABLE STR_GECICI VARCHAR(25);
DECLARE VARIABLE STR_UCLU VARCHAR(100);
BEGIN
  -- ONCE GELEN DEGERI KOMPLE STRINGE CEVIRIYORUZ
  RET_YAZI = '';                             
  STR_RAKAMLAR = CAST(PRM_TUTAR AS VARCHAR(25));
  
  -- UZUNLUGUNU BULUYORUZ                            
  INT_BOY = CHAR_LENGTH(STR_RAKAMLAR);                                        
                                                                              
  -- TAMSAYI KISMINI ALIYORUZ
  STR_TAMSAYI = SUBSTRING(STR_RAKAMLAR FROM 1 FOR (INT_BOY - 3));             
  
  -- ONDALIK KISMI ALIYORUZ
  STR_ONDALIK = SUBSTRING(STR_RAKAMLAR FROM (INT_BOY - 1));                   
  
  -- UZUNLUGU 3 UN KATLARINA TAMAMLAMAK ICIN EKSİK KALAN KISMI BULUYORUZ      
  -- ORNEGIN 1234567 SAYISININ UZUNLUGUNU 3 UN KATI 9 A TAMAMLAMAK ICIN SOLUNA 2 ADET SIFIR EKLEYECEGIZ
  -- 001234567 OLACAK BU DA -> 001,234,567 SEKLINDE BLOKLANABILECEK
  INT_GECICI = MOD((3-MOD(INT_BOY, 3)), 3);                                   
  INT_SAYAC = 0;
    
  WHILE (INT_SAYAC < INT_GECICI) DO
  BEGIN
        STR_TAMSAYI = '0' || STR_TAMSAYI;
        INT_SAYAC = INT_SAYAC + 1;
        INT_BOY = INT_BOY + 1; 
  END
  -- TAM SAYI KISMININ UZUNLUGUNU 3 UN KATLARINA TAMAMLADIK VB UZUNLUGUNU BULUYORUZ
  INT_BOY = CHAR_LENGTH(STR_TAMSAYI);                                        
                                    
  -- KAC BLOK OLACAK BUNU BULUYORUZ, ANCAK BLOKLAR SIFIRDAN BASLAYACAK
  INT_BLOK_SAYISI = (INT_BOY / 3) - 1 ;  

  INT_SAYAC = 0;
  -- TAMSAYI YAZISINI OLUSTURUYORUZ
  WHILE (INT_SAYAC <= INT_BLOK_SAYISI) DO
  BEGIN      
    STR_UCLU = '';                    
    EXECUTE PROCEDURE SP_BASAMAK(1, SUBSTRING(STR_TAMSAYI FROM  ((INT_SAYAC * 3)+1) FOR 1)) RETURNING_VALUES :STR_GECICI;
    STR_UCLU = STR_UCLU || TRIM(STR_GECICI);
    EXECUTE PROCEDURE SP_BASAMAK(2, SUBSTRING(STR_TAMSAYI FROM  ((INT_SAYAC * 3)+2) FOR 1)) RETURNING_VALUES :STR_GECICI;  
    STR_UCLU = STR_UCLU || TRIM(STR_GECICI); 
    EXECUTE PROCEDURE SP_BASAMAK(3, SUBSTRING(STR_TAMSAYI FROM  ((INT_SAYAC * 3)+3) FOR 1)) RETURNING_VALUES :STR_GECICI;  
    STR_UCLU = STR_UCLU || TRIM(STR_GECICI);
    
    EXECUTE PROCEDURE SP_BLOK_BASAMAK(INT_BLOK_SAYISI - INT_SAYAC) RETURNING_VALUES :STR_GECICI;
    -- TURKCE DEN KAYNAKLI KONTROL
    IF ((STR_UCLU = 'BİR') AND (INT_SAYAC = 0) AND (INT_BOY = 4)) THEN
    BEGIN
       RET_YAZI = RET_YAZI || TRIM(STR_GECICI);
    END
    ELSE
    IF (STR_UCLU <> '') THEN 
    BEGIN
       RET_YAZI = RET_YAZI || STR_UCLU || TRIM(STR_GECICI);
    END
    
    INT_SAYAC = INT_SAYAC + 1 ;
  END
                    
  -- ONDALIK YAZIYI OLUSTURUYORUZ
  STR_UCLU = '';                    
  EXECUTE PROCEDURE SP_BASAMAK(2, SUBSTRING(STR_ONDALIK FROM  1 FOR 1)) RETURNING_VALUES :STR_GECICI;
  STR_UCLU = STR_UCLU || TRIM(STR_GECICI);
  EXECUTE PROCEDURE SP_BASAMAK(3, SUBSTRING(STR_ONDALIK FROM  2 FOR 1)) RETURNING_VALUES :STR_GECICI;
  STR_UCLU = STR_UCLU || TRIM(STR_GECICI);
  
  IF (RET_YAZI = '') THEN
  BEGIN
    RET_YAZI = 'SIFIR';
  END                  
  
  IF (STR_UCLU = '') THEN
  BEGIN
    STR_UCLU = 'SIFIR';
  END
  
  RET_YAZI = RET_YAZI || ' TL ' || STR_UCLU || ' KRŞ';
  SUSPEND;
END ^^
SET TERM ; ^^
Yukarıda verdiğim kod ile okutabileceğiniz en büyük sayı örneğini de veriyorum.

Kod: Tümünü seç

SELECT * 
FROM SP_YAZI_ILE(92233720368547758.07)

Kolay Gelsin
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
Kullanıcı avatarı
ALUCARD
Üye
Mesajlar: 1269
Kayıt: 27 Eyl 2003 10:12
Konum: Samsun
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen ALUCARD »

hocam yazdığınız fonksiyon gerçekten güzel oldu. kullanmak istedim. ancak ondalık ayıracı nokta(.) da sorunsuz çalışırken virgul(,) de hata alıyorum.

bir çözüm varmıdır yoksa çevirecekmiyiz.
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
Forumun 365. Üyesi
Hiç Bir Şey İnsan Kadar Yükselemez ve Alçalamaz

Erkan ÇAĞLAR
Kullanıcı avatarı
ALUCARD
Üye
Mesajlar: 1269
Kayıt: 27 Eyl 2003 10:12
Konum: Samsun
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen ALUCARD »

Kod: Tümünü seç

procedure TForm1.cxButton1Click(Sender: TObject);
var
say : string;
begin
Say := StringReplace(cxCalcEdit1.Text, ',', '.', [rfReplaceAll]);
IBQuery1.Close;
IBQuery1.SQL.Clear;
IBQuery1.SQL.Add('SELECT * FROM SP_YAZI_ILE('''+Say+''')');
IBQuery1.Open;
end;
bu şekilde yapınca sorunsuz çalışıyor.
بِسْمِ اللهِ الرَّحْمنِ الرَّحِيمِ
Forumun 365. Üyesi
Hiç Bir Şey İnsan Kadar Yükselemez ve Alçalamaz

Erkan ÇAĞLAR
denizfatihi
Üye
Mesajlar: 254
Kayıt: 16 Şub 2004 06:12
Konum: istanbul

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen denizfatihi »

Merhaba,

Delphi içinde kullandığım function

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;
Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 12:07
Konum: İstanbul
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen Kuri_YJ »

Selamlar,

Dikkat edin, sizin söylediğini Nokta ve Virgül olayı Windows ve Firebird'ün kurulu olduğu yerdeki Bölgesel ayarlar nedeni ile sorun yaratıyor. Stored Procedure'de buna ilişkin bir şey yok.
Stored procedure'ü şu şekilde çağırabilir misiniz.

Kod: Tümünü seç

procedure TForm1.cxButton1Click(Sender: TObject);
begin
IBQuery1.Close;
IBQuery1.SQL.Clear;
IBQuery1.SQL.Add('SELECT * FROM SP_YAZI_ILE(:P1)');
IBQuerı1.ParamByName('P1').AsFloat := Sayı; // cxCalcEdit1'deki Value'yu Float olarak doğrudan buraya koyun. Nokta virgül ile uğraşmayın.
IBQuery1.Open;
end;
Kolay Gelsin
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 12:07
Konum: İstanbul
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen Kuri_YJ »

Bu arada asıl sıkıntı, bölgesel ayarlardaki farklardan çıkar. Kimisi tarih formatını mm.dd.yyyy kimisi yyyy-mm-dd kimisi ddd.mmm.yyyy kullanır, (/) kullanır (.) kullanı, (-) kullanır, sayısal değerlerde (.) (,) bir sürü değişik seçenek olur. Bunlardan kurtulmanın en kolay yolu, Parametre kullanmak. Parametre kullandığınızda herhengi bir bölgesel ayarla uğraşmanıza gerek kalmaz. Programın bölgesel ayarlarında mutlaka (.) olmalı, efendim tarih ayarlarında mutlaka (/) kullanılmalı gibi zorunluluklarınız olmaz. İsteyen istediği gibi kullanır. Ben programlarımda buna dikkat ederim. Eğer bir SQL cümlesine parametre gidecekse, : P1, : P2, : P3 her ne ise parametrelere taiıyıp parametre ile çağırırım. Böylelikle adamın kullandığı bölgesel ayarlar beni bağlamamış olur. Tavsiye ederim.

Kolay Gelsin
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 12:07
Konum: İstanbul
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen Kuri_YJ »

@denizfatihi kardeşim. Eğer kaynak kodların gönderdiğin gibi ise Block Programlama mantıklarını ve Indent olaylarını biraz araştır. Yoksa programlarında çok sorun yaşar ve bir sorunu bulman çoook uzun sürer. Buna dikkat et bence.

('KatTrilyar','Trilyar','KatTrilyon','Trilyon','Milyar','Milyon','Bin','');
Yazdığın yazıda yanlışlık var. Sayıların okunuşları ile ilgili bilgi vermek için paylaşıyorum. Buraya bakıp düzenlemesini yaparsınız.

http://www.teknobaz.com/2010/04/05/buyu ... matematik/

Kolay Gelsin

Not : Sakın beni yanlış anlama, kötülemek için değil, sana hatalı olduğun veya başına ileride dert açacak konuları gösteriyorum ki sonradan sorun yaşamayasın.
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
denizfatihi
Üye
Mesajlar: 254
Kayıt: 16 Şub 2004 06:12
Konum: istanbul

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen denizfatihi »

Kuri_YJ Hocam estahfurullah ne yanlış anlaması tam tersine, sizin bizi bu şekilde bilgilendirmeniz ve uyarmanız bizim hoşumuza gider. :)
Uyarı için teşekkür ederim.

iyi çalışmalar,
Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 12:07
Konum: İstanbul
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen Kuri_YJ »

@denizfatihi kardeşim,

Bak senin source normalde aşağıdaki gibi olması lazım (okunaklılık ve düzen açısından).

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;
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 12:07
Konum: İstanbul
İletişim:

Re: firebird’de sayıları yazıya çeviren procedure

Mesaj gönderen Kuri_YJ »

Bu da benim kullandığım Sayıyı Yazıya çeviren fonksiyon,

Kod: Tümünü seç

const
  aryBasamak_Yuzluk : 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')) ;
  aryBasamak_Binlik : array[1..7] of string =
    ('', 'BİN', 'MİLYON', 'MİLYAR', 'TRİLYON', 'KATRİLYON', 'KENTİLYON') ;

Kod: Tümünü seç

function KYJ_PadLeft(strVar, strChr: string; intLen: integer): string;
var
  intMyLen, intI: integer;
begin
  Result := Trim(strVar);
  intMyLen := Length(Result);
  if intMyLen < intLen then
  begin
    for intI := 1 to intLen - intMyLen do
    begin
      Result := strChr + Result;
    end;
  end;
end;

Kod: Tümünü seç

function KYJ_YaziIle(varTutar : double) : string;
var
  strTutar, strRakamTL, strRakamKRS, strYaziTL : string ;
  strKesit, strUcluYazi : string ;
  intI : integer ;
begin
  if varTutar > 0 then
  begin
    strTutar := FormatFloat('0.00', varTutar) ;
    if Pos(FormatSettings.DecimalSeparator,strTutar) > 0 then
    begin
      // Ondalık Kesir Kısmı Varsa
      strRakamTL := Copy(strTutar,1,Pos(FormatSettings.DecimalSeparator,strTutar)-1) ;
      strRakamKRS := Copy(strTutar,Pos(FormatSettings.DecimalSeparator,strTutar)+1,2) ;
    end
    else
    begin
      // Ondalık Kesir Kısmı Yoksa !!!
      strRakamTL := strTutar ;
      strRakamKRS:= '00' ;
    end;
    // Önce Noktadan Öncesini Çeviriyoruz
    // Basitleştirmek İin Toplam 18 Basamaklı Sayıya Tamamlıyorum (Sola Sıfır Dolduruyorum)
    strRakamTL := KYJ_PadLeft(strRakamTL,'0',18) ;
    for intI := 5 downto 0 do // Binler Basamağı Döngüsü
    begin
      strKesit := Copy(strRakamTL, (3 * intI) + 1, 3) ;
      if strKesit <> '000' then
      begin
        // Anlaşılır Olsun Diye Doğrudan Eklemedim, strUcluYazi Değişkenine Atama Yaptım !...

        if not ((strKesit = '001') and (intI = 4)) then
        begin
          strUcluYazi := aryBasamak_Yuzluk[1,StrToInt(strKesit[1])]
                         + aryBasamak_Yuzluk[2,StrToInt(strKesit[2])]
                         + aryBasamak_Yuzluk[3,StrToInt(strKesit[3])] ;

          strYaziTL := strUcluYazi + aryBasamak_Binlik[6-intI] + strYaziTL ;
        end
        else
        begin
          // Binler Basamağında Sadece 1 varsa Yani
          // 1256 gibi bir rakamı okuyacak ise
          // BİRBİNİKİYÜZELLİALTI şeklinde okumasın diye düzeltme yaptık :)

          strYaziTL := aryBasamak_Binlik[6-intI] + strYaziTL ;
        end;
      end ;
    end ;
    // Noktadan Öncesi İçin TL Ekliyoruz. Çoklu Döviz Kullanan Arkadaşlar
    // Burada TL ve KRŞ yerine Kendi Döviz Türlerine göre bir algoritma
    // Yapabilirler.
    strYaziTL := strYaziTL + ' TL' ;
    if strRakamKRS <> '00' then
    begin
      strYaziTL := strYaziTL + ', - '+ aryBasamak_Yuzluk[2,StrToInt(strRakamKRS[1])]
                                     + aryBasamak_Yuzluk[3,StrToInt(strRakamKRS[2])] + ' KRŞ';
    end;
    Result := strYaziTL ;
  end
  else
  if varTutar = 0 then
  begin
    Result := 'SIFIR' ;
  end
  else
  begin
    Result := '!!! HATA - NEGATİF PARA OLMAZ !...' ;
  end;
end;
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/
Cevapla