Prikazi cijelu temu 09.11.2016 20:19
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Lokacija:zagreb


Predmet:Re: konvert broja u slovo
PreuzmiIzvorni kôd (Visual Basic):
  1. Function SlovimA(broj As Single)
  2. '******************************************
  3. 'Ime:     SlovimA Function
  4. 'Sadržaj: ispisuje broj tekstom
  5. 'Autor:     Sijedi
  6. 'Adresa: Srebrenik BiH
  7. 'Ulazni parametri:broj
  8. 'Izlazni parametri:broj ispisan tekstom
  9. '*****************************************
  10. Dim rez As String, Cjeli As Integer, Dec As Single, CBroj As String
  11. Dim Duzina As Integer, i As Integer, Tric As String, cs As Integer, cj As Integer, cd As Integer
  12. Dim dDec As String, Slov As String
  13. Dim ImeBr(9) As String
  14. On Error GoTo Greska
  15.  broj = Trim(broj)
  16.    If (broj = 0) Then
  17.       SlovimA = "nula"
  18.       Exit Function
  19.    End If
  20.    ImeBr(1) = "jedan"
  21.    ImeBr(2) = "dva"
  22.    ImeBr(3) = "tri"
  23.    ImeBr(4) = "
  24. etiri"
  25.    ImeBr(5) = "pet"
  26.    ImeBr(6) = "Å¡est"
  27.    ImeBr(7) = "sedam"
  28.    ImeBr(8) = "osam"
  29.    ImeBr(9) = "devet"
  30.    rez = ""
  31.    Cjeli = Int(broj)
  32.    Dec = (broj - Cjeli) * 100
  33.    CBroj = Trim(Str(Cjeli)) ', 15)
  34.    Duzina = Len(CBroj)
  35.    CBroj = Space$(15 - Duzina) & CBroj
  36.    i = 1
  37.    Do While (i < 15)
  38.       Tric = Mid(CBroj, i, 3)
  39.       If (Tric <> "   " And (Tric <> "001" Or i = 4)) Then
  40.          cs = Val(Mid(Tric, 1, 1))
  41.          cd = Val(Mid(Tric, 2, 1))
  42.          cj = Val(Mid(Tric, 3, 1))
  43.          If (cs = 1) Then
  44.             rez = rez + "sto"
  45.          ElseIf (cs = 2) Then
  46.             rez = rez + "dvije"
  47.          ElseIf (cs > 2) Then
  48.             rez = rez + ImeBr(cs)
  49.          End If
  50.          If (cs > 4) Then
  51.             rez = rez + "stotina"
  52.          ElseIf (cs > 1) Then
  53.             rez = rez + "stotine"
  54.          End If
  55.          Select Case cd
  56.          Case 4
  57.             rez = rez + "
  58. etr"
  59.          Case 5
  60.             rez = rez + "pe"
  61.          Case 6
  62.             rez = rez + "Å¡ez"
  63.          Case 9
  64.             rez = rez + "deve"
  65.          Case Is > 1
  66.             rez = rez + ImeBr(cd)
  67.          Case 1
  68.             If (cj = 0) Then
  69.                rez = rez + "deset"
  70.             ElseIf (cj = 1) Then
  71.                rez = rez + "jeda"
  72.             ElseIf (cj = 4) Then
  73.                rez = rez + "
  74. etr"
  75.             Else
  76.                rez = rez + ImeBr(cj)
  77.             End If
  78.             If (cj > 0) Then
  79.                rez = rez + "naest"
  80.             End If
  81.          Case Else
  82.          End Select
  83.          If (cd > 1) Then
  84.             rez = rez + "deset"
  85.          End If
  86.          If (cd <> 1 And cj <> 0 And (i = 13 Or Val(Tric) <> 1)) Then
  87.             If (cj = 2 And i <> 13 And i <> 7) Then
  88.                rez = rez + "dvije"
  89.             Else
  90.                rez = rez + ImeBr(cj)
  91.             End If
  92.          End If
  93.          If ((i = 1 Or i = 10) And cs + cd + cj <> 0) Then
  94.             rez = rez + "hiljad"
  95.             If (Val(Tric) = 1) Then
  96.                rez = rez + "u"
  97.             ElseIf (cj > 4 Or cj = 0) Then
  98.                rez = rez + "a"
  99.             ElseIf (cj > 1) Then
  100.                rez = rez + "e"
  101.             End If
  102.          ElseIf (i = 4 And cs + cd + cj <> 0) Then
  103.             rez = rez + "milijard"
  104.             If (Val(Tric) = 1) Then
  105.                rez = rez + "u"
  106.             ElseIf (cj > 4 Or cj = 0) Then
  107.                rez = rez + "i"
  108.             ElseIf (cj > 1) Then
  109.                rez = rez + "e"
  110.             End If
  111.          ElseIf (i = 7 And cs + cd + cj <> 0) Then
  112.             rez = rez + "milion"
  113.             If (cj <> 1) Then
  114.                rez = rez + "a"
  115.             End If
  116.          End If
  117.       ElseIf (Tric = "001") Then
  118.          rez = rez + "jedan"
  119.       End If
  120.       i = i + 3
  121.    Loop
  122.    dDec = Str(Val(Dec)) ', 2)
  123.   Slov = rez + " " + dDec + "/100"
  124.    SlovimA = Slov
  125.  Exit Function
  126. Greska:
  127.  SlovimA = "NEIZRECIVO"
  128. End Function

Sijedi: 0,0000472127048851689
Zxz: 0,0000486095286760246

evo vidimo da je funkcija od Sijedoga brza pa ako netko zeli koristiti funkciju pretvaranja broja u slova neka koristi ovu od Sijedoga
zivot je moja domovina.