Konu: Rakamı Yazıya çeviren prg
Rakamı (örneğin fatura toplamını) yazıya çeviren bir .prg yi değerli arşivlerinizden rica edebilirmiyim.
Şimdiden teşekkür ederim
- soykanozcelik
- Uzman Üye
- Offline
Re: Rakamı Yazıya çeviren prg
* kodlar Tarkan Haser e aittir
Visual Fox Pro
*!* Program : Yaziyla
*!* Author : Haser Yazılım Ekibi
*!* Date : 26/11/2004 09:15:00 PM
*!* Copyright : Haser Bil. Sis. ve Yazılım Ltd. Şti.
*!* Description : Rakamı yazıya çeviren program
*!* Parametreleri :
*!* tnDeger As Double : Yaziya dönüşecek olan rakam
*!* tlKucukHarfMi As Boolean : .F. = Dönen sonuç büyük harf (Varsayılan)
*!* .T. = Dönen sonuç küçük harf
*!* tlVirgullu As Boolean : .F. = Dönen değeri tam ve kuruşlu okumaya göre verir (Varsayılan)
*!* .T. = Dönen değeri virgüllü okumaya göre verir
*!* Sistemde kuruş kısmı "," ile ayrılması ayarlandıysa "VİRGÜL"
*!* başka bir karakterle ayrıldıysa "NOKTA" yazar
*!* tcTamSayiBirim As String : Tam sayı para birimi (Varsayılan YTL)
*!* tcKurusBirim As String : Kuruş para birimi (Varsayılan YKR)
*!* Revision Information:
Clear
? "Örnek 1 : Yaziyla(156.65) -> " + Yaziyla(13267.29)
? "Örnek 2 : Yaziyla(156.65, .T.) -> " + Yaziyla(156.65, .T.)
? "Örnek 3 : Yaziyla(156.65, , .T.) -> " + Yaziyla(156.65, ,.T.)
? "Örnek 4 : Yaziyla(156.65, , , 'DOLAR','SENT') -> " + Yaziyla(156.65, , , 'DOLAR','SENT')
? "Örnek 5 : Yaziyla(156.65, , .T., 'DOLAR','SENT') -> " + Yaziyla(156.65, ,.T., 'DOLAR','SENT')
Function Yaziyla
LParameters tnDeger As Double, tlKucukHarfMi As Boolean, tlVirgullu As Boolean, ;
tcTamSayiBirim As String, tcKurusBirim As String
If Empty(m.tcTamSayiBirim)
m.tcTamSayiBirim = "Ytl"
EndIf
If Empty(m.tcKurusBirim)
m.tcKurusBirim = "Ykr"
EndIf
Local lnTamSayi As Integer, lnKurus As Integer, lcYaziyla As String, lcVirgul As String
If Set("Point") = ","
m.lcVirgul = "VİRGÜL"
Else
m.lcVirgul = "NOKTA"
EndIf
m.tnDeger = Round(m.tnDeger, 2)
m.lnTamSayi = Int(m.tnDeger)
m.lnKurus = (m.tnDeger - m.lnTamSayi) * 100
If m.tlVirgullu .And. m.lnKurus <> 0
m.tcKurusBirim = m.tcTamSayiBirim
m.tcTamSayiBirim = m.lcVirgul
EndIf
*m.lcYaziyla = ;
IIf(m.lnTamSayi < 0, "EKSİ", "") + ;
IIf(m.lnTamSayi = 0, "", RakamYazi(ABS(m.lnTamSayi)) + m.tcTamSayiBirim) + ;
IIf(m.lnKurus = 0, "", RakamYazi(ABS(m.lnKurus)) + m.tcKurusBirim)
m.lcYaziyla = ;
IIf(m.lnTamSayi < 0, "EKSİ", "") + ;
IIf(m.lnTamSayi = 0, "", RakamYazi(ABS(m.lnTamSayi)) + " " + m.tcTamSayiBirim) + " "+;
IIf(m.lnKurus = 0, "", RakamYazi(ABS(m.lnKurus)) + " " + m.tcKurusBirim)
If m.tlKucukHarfMi
Return Lower(ChrTran(m.lcYaziyla, "İI", "iı"))
Else
Return m.lcYaziyla
EndIf
EndFunc
Function RakamYazi
LParameters tnDeger As Integer
Local tcDeger As String, lcYaziyla As String, ;
lcBolum1 As String, ;
lcBolum2 As String, ;
lcBolum3 As String, ;
lcBolum4 As String, ;
lcBolum5 As String
m.lcYaziyla = ""
m.lcDeger = Str(m.tnDeger, 15)
m.lcBolum1 = SubStr(m.lcDeger, 1, 3)
m.lcBolum2 = SubStr(m.lcDeger, 4, 3)
m.lcBolum3 = SubStr(m.lcDeger, 7, 3)
m.lcBolum4 = SubStr(m.lcDeger, 10, 3)
m.lcBolum5 = SubStr(m.lcDeger, 13, 3)
If Val(m.lcBolum1) > 0
m.lcYaziyla = m.lcYaziyla + BolumYaz(m.lcBolum1, "TRİLYON")
EndIf
If Val(m.lcBolum2) > 0
m.lcYaziyla = m.lcYaziyla + BolumYaz(m.lcBolum2, "MİLYAR")
EndIf
If Val(m.lcBolum3) > 0
m.lcYaziyla = m.lcYaziyla + BolumYaz(m.lcBolum3, "MİLYON")
EndIf
If Val(m.lcBolum4) > 0
m.lcYaziyla = m.lcYaziyla + BolumYaz(m.lcBolum4, "BİN")
EndIf
If Val(m.lcBolum5) > 0
m.lcYaziyla = m.lcYaziyla + BolumYaz(m.lcBolum5, "")
EndIf
Return m.lcYaziyla
EndFunc
Function BolumYaz
LParameters tcDeger As String, m.tcEk As String
Local lcYaziyla As String, ;
lnBolum1 As Integer, ;
lnBolum2 As Integer, ;
lnBolum3 As Integer
Local Array laBirler(9), laOnlar(9)
m.laBirler(1) = "BİR"
m.laBirler(2) = "İKİ"
m.laBirler(3) = "ÜÇ"
m.laBirler(4) = "DÖRT"
m.laBirler(5) = "BEŞ"
m.laBirler(6) = "ALTI"
m.laBirler(7) = "YEDİ"
m.laBirler(8) = "SEKİZ"
m.laBirler(9) = "DOKUZ"
m.laOnlar(1) = "ON"
m.laOnlar(2) = "YİRMİ"
m.laOnlar(3) = "OTUZ"
m.laOnlar(4) = "KIRK"
m.laOnlar(5) = "ELLİ"
m.laOnlar(6) = "ALTMIŞ"
m.laOnlar(7) = "YETMİŞ"
m.laOnlar(8) = "SEKSEN"
m.laOnlar(9) = "DOKSAN"
m.lnBolum1 = Val(SubStr(m.tcDeger, 1, 1))
m.lnBolum2 = Val(SubStr(m.tcDeger, 2, 1))
m.lnBolum3 = Val(SubStr(m.tcDeger, 3, 1))
m.lcYaziyla = ""
If m.lnBolum1 > 0
If m.lnBolum1 = 1
m.lcYaziyla = m.lcYaziyla + "YÜZ"
Else
m.lcYaziyla = m.lcYaziyla + m.laBirler(m.lnBolum1) + "YÜZ"
EndIf
EndIf
If m.lnBolum2 > 0
m.lcYaziyla = m.lcYaziyla + m.laOnlar(m.lnBolum2)
EndIf
If m.lnBolum3 > 0
If !(Val(m.tcDeger) = 1 And m.tcEk = "BİN")
m.lcYaziyla = m.lcYaziyla + m.laBirler(m.lnBolum3)
EndIf
EndIf
Return m.lcYaziyla + m.tcEk
EndFunc