Tippseite

VB-Homepage Tipp 307

Umwandeln von Jahresangaben [Arabisch-Römisch]

Nicht für den alltäglichen Bedarf ist nachfolgender Tipp, aber mitunter sucht man eben auch mal nach ausgefallen Sachen und da kann es schon mal vorkommen, daß man nach einer Möglichkeit sucht, Jahresangaben in arabischer Schreibweise, also die die wir im Normalfall nutzen (wie 1998 oder 2000) in die Römische Schreibweise zu bringen (wie MCMXCVIII oder MM).

Und für all diejenigen gibt es hier diesen Tipp.

Dabei ist das ganze eher eine Fleißaufgabe, als ein mit APIs gespicktes Projekt.
Alles was Sie für ein Demoprojekt benötigen, ist eine Form auf der Sie eine Combobox (für arabische Jahresangaben), eine Textbox (für die Anzeige der
umgewandelten römischen Jahresangabe) und einen CommandButton, der die Umrechung auslößt. Was Sie dann noch zur Beschriftung und sonstigem benötigen, überlasse ich Ihnen.

Form_Load
Dim i As Integer

'füllt die Combobox mit den arab. Jahresangaben
For i = 1 To 2100
Combo1.AddItem i
Next i

'und zeigt das aktuelles Jahr in der Combobox an
Combo1.ListIndex = Val(Format(Date, "YYYY") - 1)

Dann benötigen wir noch die eigentliche Umrechnungsprozedur (-funktion)

Allgemein/RomanNumerals
Public Function RomanNumerals(n As Integer) As String

'Konvertiert n als arab. Jahresangabe in röm. Jahresangabe

Dim arabic(12) As Integer, roman(12) As String
Dim i As Integer, out As String

arabic(0) = 1000
arabic(1) = 900
arabic(2) = 500
arabic(3) = 400
arabic(4) = 100
arabic(5) = 90
arabic(6) = 50
arabic(7) = 40
arabic(8) = 10
arabic(9) = 9
arabic(10) = 5
arabic(11) = 4
arabic(12) = 1
roman(0) = "M"
roman(1) = "CM"
roman(2) = "D"
roman(3) = "CD"
roman(4) = "C"
roman(5) = "XC"
roman(6) = "L"
roman(7) = "XL"
roman(8) = "X"
roman(9) = "IX"
roman(10) = "V"
roman(11) = "IV"
roman(12) = "I"

i = 0

While n
While n >= arabic(i)
n = n - arabic(i)
out = out + roman(i)
Wend
i = i + 1
Wend

RomanNumerals = out

End Function

Und nun noch der Auslöser.

Command1_Click
'übergibt der Funktion den aktuellen Wert der Combobox zum umrechnen
Text1.Text = RomanNumerals(Combo1)

Cäsar wäre bestimmt begeistert !

Tipp-Download

Quelle :