Integer to Strin...

Може ли някой да помогне със следния проблем, на който се натъкнах?

Имам някакво число с n на брой цифри. Може ли да се измисли алгоритъм, който "прочита" числото и го превръща в символи" Пример:

2500 - Словом: Две Хиляди и петстотин

Мислех за алгоритъм, който проверява с колко цифри е числото и поставя на n-1,n-2,n-3... -та позиция "Хиляди" Или "ста" и т.н. но ми се ще да вярвам че има и по -лесен начин...

Мерси предварително...

Имам модулче. Само че ще ти го постна след час-два, че си забакнах малко компа.

Браво бе Щирлиц, кефиш ме... Има ли нещо дето да не знаеш:). Предварително ти благодаря. Ще трябва да почерпя...:)

Във формата:

Private Sub Command1_Click()

  Text2.Text = N2W(Val(Text1.Text))

End Sub

и във модул:

Option Base 1



Private cResult As String

Private lAnd As Boolean



Function N2W(nNumber As Double) As String

  Dim cNumber As String

  Dim nGroups As Integer

  Dim n As Integer

  Dim nDiv As Integer

      

  cResult = ""

  nNumber = nNumber * 100

  nDiv = nNumber Mod 100

  nNumber = nNumber \ 100

  lAnd = False

  cNumber = Trim(Str(nNumber))

  Do Until Len(cNumber) >= 12

    cNumber = "0" & cNumber

  Loop

  nGroups = Int(Len(cNumber) / 3)

  For n = 1 To nGroups

    Call ProcGroup(Val(Mid(cNumber, n * 3 - 2, 3)), 5 - n)

  Next

  If nDiv > 0 Then

    N2W = LTrim(cResult) + " лв. и " + Str(nDiv) + " ст."

  Else

    N2W = LTrim(cResult) + " лв."

  End If

End Function



Private Sub ProcGroup(nNumber, nGroup)

  cGroupS = Array("", " хиляда", " милион", " трилион")

  cGroupM = Array("", " хиляди", " милиона", " трилиона")

  c3_9 = Array(" три", " четири", " пет", " шест", " седем", " осем", " девет")

  c10_19 = Array(" десет", " единаесет", " дванадесет", " тринадесет", " четиринадесет", _

    " петнадесет", " шестнадесет", " седемнадесет", " осемнадсесет", " деветнадесет")

  c2X_9X = Array(" двадесет", " тридесет", " четиридесет", " петдесет", " шестдесет", _

    " седемдесет", " осемдесет", " деветдесет")

  c0XX_9XX = Array("", " сто", " двеста", " триста", " четиристотин", " петстотин", _

    " шестотин", " седемстотин", " осемстотин", " деветстотин")

  Dim n, nleft, nRight1, nRight2, nMid As Integer

  Dim lMidNo1 As Boolean

  nleft = Int(nNumber / 100)

  nRight1 = nNumber Mod 10

  nRight2 = nNumber Mod 100

  nMid = Int((nNumber Mod 100) / 10)

  lMidNo1 = True

  If nGroup = 1 And lAnd And nleft > 0 And nRight2 = 0 Then cResult = cResult + " и"

  cResult = cResult + c0XX_9XX(nleft + 1)

  If (Between(nRight2, 1, 20) Or _

      InSet(nRight2, 30, 40, 50, 60, 70, 80, 90)) And (lAnd Or nleft > 0) Then

    cResult = cResult + " и"

  End If

  If nMid > 1 Then

    cResult = cResult + c2X_9X(nMid - 1)

    If nRight1 > 0 Then cResult = cResult + " и"

  ElseIf nMid = 1 Then

    lMidNo1 = False

    cResult = cResult + c10_19(nRight2 - 9)

  End If

  If Between(nRight1, 3, 9) And lMidNo1 Then cResult = cResult + c3_9(nRight1 - 2)

  If nRight1 = 1 And lMidNo1 Then

    If nGroup <> 2 Or nNumber > 1 Then cResult = cResult + " един"

  End If

  If nRight1 = 2 And lMidNo1 Then cResult = cResult + Iif(nGroup = 2, " две", " два")

  If nGroup > 1 And nNumber > 0 Then

    lAnd = True

    cResult = cResult + Iif(nNumber > 1, cGroupM(nGroup), cGroupS(nGroup))

  End If

End Sub



Private Function Between(xValue, xLo, xUp) As Boolean

  If xValue >= xLo And xValue <= xUp Then

    Between = True

  Else

    Between = False

  End If

End Function



Private Function InSet(xValue, ParamArray xArray())

  Dim n

  For n = LBound(xArray) To UBound(xArray)

    If xValue = xArray(n) Then

      InSet = True

      Exit For

    End If

  Next

End Function

Фунцкията всъщност я поизкопирах от "едно място", но не е много комерсиална. Пък и който си дебъгне нещо - негово си е. ;о)

..и даже работи

Работи супер:). Много ти благодаря! Имаш почерпка:)

А бе има числа, при които изгърмява. Например 999999999 не баца! 99999999 също! А 10999999 баца! Не съм търсил защо!

Вчера като видях постинга и ми мина през ума, че е интересна задача да се напише такава функция, но с повечко възможности. Например да дава не само бройни, но и редни, да има възможност да връща в различен род, число и членуване, а когато е в мъжки и единствено, да може да го членува и с пълен и кратък член... Да има съкратена версия и несъкратена (тринайсе и тринадесет- и двете са граматически правилни!)... И примерно да работи с числа до 999`999`999`999

Друга интересна задача (като чисто програмистко предизвикателство) е да се научи да дава и десетични и обикновени дроби! Ще видя- задават се три почивни дни... ако нямам какво да правя :)

БАба...


Ама баба не е жена, вие не знаете ли?

Хммм...
Щирлиц, я кажи кой е този, който използва:
Option Base 1
И НЕ ИЗПОЛЗВА !?!?!?!!??!?!?!?!?!
Option Explicit
Да му се накарам малко

Абе, аз пробвах да го пусна без това "Option Base 1", ама да не ти разправям какви хуморески излезнаха.

Пък от друга страна, "Option Explicit" за 30-40 реда код си е направо параноя!!! А пък и без това съм го копирал, не е мой кода. ;о)))

П.П. Всъщност кода го копирах от VBA от Excel. Попреправих 2-3 реда, че нещо не ми пасваше, но в общи линии си е така както си беше.

dai mail, shte ti pratia :)))