Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Römische Zahlen ohne Goto
| Uploader: |  MOD |
| Datum/Zeit: | 27.07.2011 23:05:00 |
Function Num2Rom(Number As Integer) As String
'nur für positive Zahlen von 1 - 3999
Dim As Integer i = 1, nDigitValue
Dim As String c, v ,nRoman, nDigits = " IVXLCDM"
Select Case Number
Case 1 To 3999
Case Else
Return ""
End Select
Do While Number > 0
nDigitValue = Number Mod 10
c = Chr(nDigits[i])
v = Chr(nDigits[i + 1])
Select Case nDigitValue
Case 1 : nRoman = c & nRoman
Case 2 : nRoman = c & c & nRoman
Case 3 : nRoman = c & c & c & nRoman
Case 4 : nRoman = c & v & nRoman
Case 5 : nRoman = v & nRoman
Case 6 : nRoman = v & c & nRoman
Case 7 : nRoman = v & c & c & nRoman
Case 8 : nRoman = v & c & c & c & nRoman
Case 9 : nRoman = c & Chr(nDigits[i + 2]) & nRoman
End Select
i = i + 2
Number = Number \ 10
Loop
Function = nRoman
End Function
Function Rom2Num(r As String) As Integer
'nur für positive Zahlen von 1 - 3999
Dim As String x = "MDCLXVI", u = "IVIXXLXCCDCM"
Dim As Integer j, k, z, _
b(7) = {1000,500,100,50,10,5,1}, _
c(5) = {2,2,20,20,200,200}
r = Trim(UCase(r))
For j = 0 To Len(r)-1
k = 0
While r[j] <> x[k]
k = k + 1
If k > 6 Then Return 0
Wend
z = z + b(k)
Next j
For j = 0 To Len(r)-1
k = 0
Do
If (r[j] <> u[k]) Or (r[j+1] <> u[k+1]) Then
k = k + 2
If k > 10 Then
Exit Do
EndIf
Else
z = z - c(k/2)
Exit Do
EndIf
Loop
Next j
Function = z
End Function
Print "3999"; " entspricht "; Num2Rom(3999)
Print "MCMXCVIII"; " entspricht"; Rom2Num("MCMXCVIII")
Sleep