[RESOLVED] Built in function for Roman Numerals?

[paralinx]

Hey all,

I'm making a notetaking program for a computer's class, and I was wondering if there was any built in VB function to retreive roman numerals such as I, II, III, ect.

What I have done is made a long that had roman numberals up to 50 like this..

lngData = "I|II|III|IV|V|VI|VII|VIII"

and then split the long where the |'s are and just called the array that the long was split into. But if there was a function to get roman numerals already that would be much easier

thanks

[Bruce Fox]

Hi paralinx,

This tread any goood?

http://www.vbforums.com/showthread.p...ighlight=roman

[MartinLiss]

No, there isn't.

[bpd]

This only converts value less than 1,000:

'NOTE:  49 is converted as XLIV, instead of the shortcut IL.
'       95 is converted as XCV, instead of the shortcut VC.
Private Function RomanNumerals(ByVal Value As Long) As String
  Dim Ones     As Long
  Dim Tens     As Long
  Dim Hundreds As Long
  
  If Value < 1 Then
    RomanNumerals = "Value too small."
    Exit Function
  End If
  
  Ones = Value Mod 10
  Tens = (Value \ 10) Mod 10
  Hundreds = Value \ 100
  
  If Hundreds > 9 Then
    RomanNumerals = "Value too large."
  Else
    RomanNumerals = ConvertPlace(Hundreds, "C", "D", "M") _
                  & ConvertPlace(Tens, "X", "L", "C") _
                  & ConvertPlace(Ones, "I", "V", "X")
  End If
End Function
 
Private Function ConvertPlace(ByVal Value As Long, _
                              ByVal One As String, _
                              ByVal Five As String, _
                              ByVal Ten As String) As String
  Debug.Assert Value >= 0
  Debug.Assert Value <= 10
  
  Select Case Value
  Case Is < 0:   ConvertPlace = "** ERROR **"
  Case Is = 0:   ConvertPlace = ""
  Case Is < 4:   ConvertPlace = String$(Value, One)
  Case Is < 6:   ConvertPlace = String$(5 - Value, One) & Five
  Case Is < 9:   ConvertPlace = Five & String$(Value - 5, One)
  Case Is <= 10: ConvertPlace = String$(10 - Value, One) & Ten
  Case Else:     ConvertPlace = "** ERROR **"
  End Select
End Function

[DKenny]

Here's a function that will give you all Roman numerals upto 3,999.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments:     This function returns a string that is the Roman
'               Numeral version of a passed Arabic number.
'               The function will only work if the value is less
'               than 4000
'
' Arguments:    Arabic      The arabic number to be converted to
'                           Roman
'
' Date          Developer       Action
' --------------------------------------------------------------
' 03/14/06      Declan Kenny    Initial version
'
Function GetRoman(Arabic As Long) As String
Dim sArabic As String
Dim sReturn As String
    
    If Arabic > 3999 Then
        GetRoman = "Value is too large"
        Exit Function
    End If
    
    sArabic = CStr(Arabic)
    
    'Thousand Part
    If Len(sArabic) = 4 Then
        sReturn = String(CLng(Left(sArabic, 1)), "M")
        sArabic = Right(sArabic, 3)
    End If
    
    'Hundred Part
    If Len(sArabic) = 3 Then
        Select Case CLng(Left(sArabic, 1))
            Case 1 To 3
                sReturn = sReturn & String(CLng(Left(sArabic, 1)), "C")
            Case 4
                sReturn = sReturn & "CD"
            Case 5
                sReturn = sReturn & "D"
            Case 6 To 8
                sReturn = sReturn & "D" & String(CLng(Left(sArabic, 1)) - 5, "C")
            Case 9
                sReturn = sReturn & "CM"
        End Select
        sArabic = Right(sArabic, 2)
    End If
    
    'Ten Part
    If Len(sArabic) = 2 Then
        Select Case CLng(Left(sArabic, 1))
            Case 1 To 3
                sReturn = sReturn & String(CLng(Left(sArabic, 1)), "X")
            Case 4
                sReturn = sReturn & "XL"
            Case 5
                sReturn = sReturn & "L"
            Case 6 To 8
                sReturn = sReturn & "L" & String(CLng(Left(sArabic, 1)) - 5, "X")
            Case 9
                sReturn = sReturn & "XC"
        End Select
        sArabic = Right(sArabic, 1)
    End If
    
    'One Part
    Select Case CLng(Left(sArabic, 1))
        Case 1 To 3
            sReturn = sReturn & String(CLng(Left(sArabic, 1)), "I")
        Case 4
            sReturn = sReturn & "IV"
        Case 5
            sReturn = sReturn & "V"
        Case 6 To 8
            sReturn = sReturn & "V" & String(CLng(Left(sArabic, 1)) - 5, "I")
        Case 9
            sReturn = sReturn & "IX"
    End Select
    
    GetRoman = sReturn
End Function

[paralinx]

Great thanks,

I would have never figured it out