Клубове Дир.бг
powered by diri.bg
търси в Клубове diri.bg Разширено търсене

Вход
Име
Парола

Клубове
Dir.bg
Взаимопомощ
Горещи теми
Компютри и Интернет
Контакти
Култура и изкуство
Мнения
Наука
Политика, Свят
Спорт
Техника
Градове
Религия и мистика
Фен клубове
Хоби, Развлечения
Общества
Я, архивите са живи
Клубове Дирене Регистрация Кой е тук Въпроси Списък Купувам / Продавам 08:50 15.06.24 
Клубове/ Компютри и Интернет / Visual Basic Пълен преглед*
Информация за клуба
Тема Re: Izpisvane na number [re: VBDEV]
Автор ЩиpлицМодератор (разузнавач)
Публикувано01.02.05 09:11  



Разбира се. Дори мисля, че вече съм го поствал тук. Погледни в темата горе Tips&Tricks.

Ако не можеш да го намериш, след час ще имам време да ти го пусна като модул.

П.П. Сори, няма го там. Сега ще го постна...

...

Файл: modNum2Word.bas

Ползва се: N2W 342.76
(в кода на програмата)

Съдържание:


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



Щирлиц<P ID="edit"><FONT class="small"><EM>Редактирано от Щиpлиц на 01.02.05 09:17.</EM></FONT></P>

Редактирано от Щиpлиц на 01.02.05 09:19.



Цялата тема
ТемаАвторПубликувано
* Izpisvane na number VBDEV   31.01.05 23:42
. * Re: Izpisvane na number Щиpлиц   01.02.05 09:11
. * Re: Izpisvane na number niki   01.02.05 19:10
. * Re: Izpisvane na number Щиpлиц   01.02.05 20:45
. * На полето, Smile   02.02.05 10:14
. * Re: На полето, Niki   02.02.05 19:33
. * Давай Smile   03.02.05 09:22
. * Изпратих ти Smile   07.02.05 13:08
. * Re: Izpisvane na number DDeli   06.02.05 16:32
. * Ама тая функция на Щирлиц нещо не работи! USER   06.02.05 22:44
. * Re: Ама тая функция на Щирлиц нещо не работи! Щиpлиц   07.02.05 11:07
. * Re: Ама тая функция на Щирлиц нещо не работи! USER   07.02.05 21:00
. * Re: Ама тая функция на Щирлиц нещо не работи! VBDEV   07.02.05 21:24
. * To Smile   08.02.05 07:49
. * Re: Izpisvane na number SimonP   13.06.05 18:49
. * Ето и моят ревизиран код SimonP   15.06.05 17:31
. * Re: Izpisvane na number Bob   15.06.05 18:15
Клуб :  


Clubs.dir.bg е форум за дискусии. Dir.bg не носи отговорност за съдържанието и достоверността на публикуваните в дискусиите материали.

Никаква част от съдържанието на тази страница не може да бъде репродуцирана, записвана или предавана под каквато и да е форма или по какъвто и да е повод без писменото съгласие на Dir.bg
За Забележки, коментари и предложения ползвайте формата за Обратна връзка | Мобилна версия | Потребителско споразумение
© 2006-2024 Dir.bg Всички права запазени.