Advertisement
4_2005-2006 Miscellaneous #164136

Decimal To Roman Converter

This code takes an input decimal number and converts it to roman numerals. Will work for any number inputted until the output string becomes too big (and testing seems to show this doesnt actuually happen)! This is the shortest piece of code to o this (to my knowledge), as all the others I've seen are useless....

AI

AI சுருக்கம்: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

மூலக் குறியீடு
original-source
Const sMatrix As String = "I~V~X~L~C~D~M"
Private Function ToRoman(ByVal sDecNum As String) As String
  If sDecNum <> "0" And sDecNum <> vbNullString Then
    Dim sNumArray() As String
    If Len(sDecNum) > 3 Then ToRoman = String(Mid(sDecNum, 1, Len(sDecNum) - 3), "M")
    If Len(sDecNum) > 2 Then ToRoman = ToRoman & GiveLetters(Mid(sDecNum, Len(sDecNum) - 2, 1), 4)
    If Len(sDecNum) > 1 Then ToRoman = ToRoman & GiveLetters(Mid(sDecNum, Len(sDecNum) - 1, 1), 2)
    ToRoman = ToRoman & GiveLetters(Mid(sDecNum, Len(sDecNum), 1), 0)
  Else: ToRoman = "No Roman value for 0"
  End If
End Function
Private Function GiveLetters(ByVal sInput As String, ByVal iArrStart As Integer) As String
  Dim sLetterArray() As String
  sLetterArray() = Split(sMatrix, "~")
  Select Case sInput
    Case 4: GiveLetters = sLetterArray(iArrStart) & sLetterArray(iArrStart + 1)
    Case 5: GiveLetters = sLetterArray(iArrStart + 1)
    Case 9: GiveLetters = sLetterArray(iArrStart) & sLetterArray(iArrStart + 2)
    Case 6 To 8: GiveLetters = sLetterArray(iArrStart + 1) & String(sInput - 5, sLetterArray(iArrStart))
    Case Else: GiveLetters = GiveLetters + String(sInput, sLetterArray(iArrStart))
  End Select
End Function
Private Sub Command1_Click()
  Dim sRoman As String
  sRoman = ToRoman(2002)
End Sub
அசல் கருத்துகள் (3)
வேபேக் மெஷினிலிருந்து (Wayback Machine) மீட்டெடுக்கப்பட்டது