ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 27.12.1999

Diese Seite wurde zuletzt aktualisiert am 27.12.1999
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicActiveX-Komponenten, Controls, Klassen und mehr...AddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zum ABOUT Visual Basic-Magazin, Kontakt und Impressum

Zurück...

Zurück...


Anzeige

(-hg) mailto:hg_romannumbers@aboutvb.de

Die Darstellung von Zahlen als römische Zahlen ist zwar heutzutage nicht mehr sonderlich aktuell. Dennoch wird sie hin und wieder noch gebraucht, etwa zur Darstellung von Jahreszahlen oder zur Nummerierung von Kapiteln oder Absätzen in Büchern oder juristischen Schriftsätzen. Für diese Zwecke mag auch der Wertebereich, der sich in römischen Zahlen darstellen lässt, vollauf ausreichend sein - er reicht nur von 1 bis 3999. Die Handicaps der römischen Zahlen sind nämlich, dass erstens 1000 der höchste durch ein einzelnes Zahlzeichen darstellbare Wert ist, und zweitens die fundamentale Regel, dass nicht mehr als drei gleiche Zeichen aufeinander folgen dürfen. Sie können natürlich letztere Regel einfach ignorieren, wenn Ihnen danach sein sollte - nur würde man solche Zeichengebilde kaum mehr als römische Zahlen betrachten können, sondern sie eher als "komische Zahlen" empfinden...

Die Funktion NumToRoman wandelt eine Integer-Zahl im Bereich von 1 bis 3999 in eine römische Zahl um. Werte außerhalb dieses Bereichs werden mit einem im aufrufenden Code abfangbaren Laufzeitfehler (romanErrOutOfRange) quittiert.

Umgekehrt konvertiert die Funktion RomanToNum die Zeichenfolge einer römischen Zahl in eine Integer-Zahl. Ihr können die Zeichen der römischen Zahl in Groß- oder Kleinschreibung übergeben werden. Enthält die Zeichenfolge ungültige Zeichen, wird der abfangbare Laufzeitfehler romanErrInvalidRomanDigit ausgelöst.

Public Const romanErrOutOfRange = 1
Public Const romanErrInvalidRomanDigit = 2

Public Function NumToRoman(ByVal Number As Integer) As String
  Dim i As Integer
  Dim nDigitValue As Integer
  Dim nRoman As String
  Dim nDigits(1 To 7)
  
  Select Case Number
    Case 1 To 3999
    Case Else
      Err.Raise romanErrOutOfRange, "modRomanNumbers.NumToRoman", _
       "Wert außerhalb des Bereichs 1 bis 3999"
      Exit Function
  End Select
  nDigits(1) = "I"
  nDigits(2) = "V"
  nDigits(3) = "X"
  nDigits(4) = "L"
  nDigits(5) = "C"
  nDigits(6) = "D"
  nDigits(7) = "M"
  i = 1
  Do While Number > 0
    nDigitValue = Number Mod 10
    Select Case nDigitValue
      Case 1
        nRoman = nDigits(i) & nRoman
      Case 2
        nRoman = nDigits(i) & nDigits(i) & nRoman
      Case 3
        nRoman = nDigits(i) & nDigits(i) & nDigits(i) & nRoman
      Case 4
        nRoman = nDigits(i) & nDigits(i + 1) & nRoman
      Case 5
        nRoman = nDigits(i + 1) & nRoman
      Case 6
        nRoman = nDigits(i + 1) & nDigits(i) & nRoman
      Case 7
        nRoman = nDigits(i + 1) & nDigits(i) & nDigits(i) & nRoman
      Case 8
        nRoman = nDigits(i + 1) & nDigits(i) & nDigits(i) & _
         nDigits(i) & nRoman
      Case 9
        nRoman = nDigits(i) & nDigits(i + 2) & nRoman
    End Select
    i = i + 2
    Number = Number \ 10
  Loop
  NumToRoman = nRoman
End Function

Public Function RomanToNum(Roman As String) As Integer
  Dim nRoman As String
  Dim i As Integer
  Dim nRomanDigitValue As Integer
  Dim nRomanDigitValue2 As Integer
  Dim nNumber As Integer
  Dim nDigits As Collection
  Dim nTempValue As Integer
  
  Set nDigits = New Collection
  With nDigits
    .Add 1, "I"
    .Add 5, "V"
    .Add 10, "X"
    .Add 50, "L"
    .Add 100, "C"
    .Add 500, "D"
    .Add 1000, "M"
  End With
  nRoman = UCase$(Roman)
  On Error GoTo RomanToNum_Error
  For i = 1 To Len(nRoman) - 1
    nRomanDigitValue = nDigits(Mid$(nRoman, i, 1))
    nRomanDigitValue2 = nDigits(Mid$(nRoman, i + 1, 1))
    If nRomanDigitValue < nRomanDigitValue2 Then
      nTempValue = nTempValue + nRomanDigitValue
    Else
      If nTempValue Then
        nNumber = nNumber + (nRomanDigitValue - nTempValue)
        nTempValue = 0
      Else
        nNumber = nNumber + nRomanDigitValue
      End If
    End If
  Next 'i
  If nTempValue Then
    nNumber = nNumber + (nDigits(Mid$(nRoman, Len(nRoman), 1)) _
     - nTempValue)
  Else
    nNumber = nNumber + nDigits(Mid$(nRoman, Len(nRoman), 1))
  End If
  RomanToNum = nNumber
  Exit Function
  
RomanToNum_Error:
  Err.Raise romanErrInvalidRomanDigit, "modRomanNumbers.RomanToNum", _
   "Römische Zahl enthält ungültige Zeichen"
End Function

Die Funktionen NumToRoman konvertiert eine Integer-Zahl in eine römische Zahl, die Funktion RomanToNum eine römische Zahl in eine Integer-Zahl


Modul modRomanNumbers (modRomanNumbers.bas - ca. 3 KB)






Themen - Allgemeines
Themen - Entwicklungsumgebung (VB-IDE)
Themen - Forms
Themen - Steuerelemente (Controls)
Themen - Grafik
Themen - Dateien
Themen - UserControls
Themen - Einsteiger-Tipps
Themen - Wussten Sie...?

Übersicht nach Titeln in alphabetischer Reihenfolge
Übersicht nach Erscheinungsdatum

Schnellsuche



Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer