Перевод чисел в римские и префиксные типы: -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [3.144.36.141]

Модераторы: SCINER, B.V.

Перевод чисел в римские и префиксные типы:

SCINER

Сообщ. #1 , 23.01.05, 16:28

Moderator

Профиль · PM

Поощрения: 45 Dgm

Рейтинг (т): 228

Функция перевода числа в римское представление:

'Например MsgBox ToRoman(2005) вернет MMV

Function ToRoman(ByVal X As Integer) As String

' function provided by Jason Roozee

' jason@vbhelp.com

' www.VBHelp.com

Dim sFinished As String

If (X > 3999) Or (X < 0) Then

ToRoman = CStr(X)

Exit Function

End If

sFinished = String(Int(X / 1000), "M")

X = X - (Int(X / 1000) * 1000)

If X >= 900 Then

sFinished = sFinished & "CM"

ElseIf X >= 500 And X < 900 Then

sFinished = sFinished & "D" & String(Int((X - 500) / 100), "C")

ElseIf X >= 400 And X < 500 Then

sFinished = sFinished & "CD"

Else

sFinished = sFinished & String(Int(X / 100), "C")

End If

X = X - (Int(X / 100) * 100)

If X >= 90 Then

sFinished = sFinished & "XC"

ElseIf X >= 50 And X < 90 Then

sFinished = sFinished & "L" & String(Int((X - 50) / 10), "X")

ElseIf X >= 40 And X < 50 Then

sFinished = sFinished & "XL"

Else

sFinished = sFinished & String(Int(X / 10), "X")

End If

X = X - (Int(X / 10) * 10)

If X >= 9 Then

sFinished = sFinished & "IX"

ElseIf X >= 5 And X < 9 Then

sFinished = sFinished & "V" & String(Int((X - 5) / 1), "I")

ElseIf X >= 4 And X < 5 Then

sFinished = sFinished & "IV"

Else

sFinished = sFinished & String(Int(X / 1), "I")

End If

ToRoman = sFinished

End Function

Перевод числа в префиксное представление, наподобии нумерации столбцов в Excell'e:
(максимальное число, которое можно конвертнуть этой функцией 17575, т.к. (26*26*26)=17576), число 26 это количество букв в английском алфавите

'Преобразование целого в символьную строку A,B,...,Z,AA,AB,...,ZZ,AAA,AAB,...

'A=0,AA=26

Function IntToABC(ByVal ANum As Integer) As String

Dim H As Long, i As Long

Dim Result As String

Dim Divisor

Dim Substructor

Dim Lit As Long

Divisor = Array(0, 308915776, 11881376, 456976, 17576, 676, 26)

Substructor = Array(0, 12356630, 475254, 18278, 702, 26, 0)

Lit = Asc("A")

If ANum < 0 Then IntToABC = "<0": Exit Function

For i = 1 To 6

H = ANum - Substructor(i)

If H >= 0 Then

If i < 6 Then H = (H Mod Divisor(i)) \ Divisor(i + 1) Else H = H Mod Divisor(i)

Result = Result & Chr$(Lit + H)

End If

IntToABC = Result

End Function

Private Sub Form_Load()

MsgBox IntToABC(26866)

End Sub

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0173 ] [ 16 queries used ] [ Generated: 27.04.24, 20:55 GMT ]