Option Explicit
'bemerkung: alle funktionen sind ausgelegt für zahlensysteme zwischen 1 und 36 _
andere systeme funktionieren zwar prinzipiell auch, jedoch muss dann _
die gesamte ascii-bandbreite genutzt werden, wodurch das ergbnis nicht _
mehr so einfach lesbar sein wird.
'standard-umformung aus dem zehnersystem heraus
Public Function MutateStd$(ByVal Src&, ByVal DestZS As Byte)
'überprüfung auf besondere zahlensysteme
If DestZS = 1 Then
'Einer-System
MutateStd = String(Src, "0")
Exit Function
ElseIf DestZS = 0 Then
'Nuller-system gibt nicht
MutateStd = "#"
Exit Function
End If
'umformen
Do
'den rest der ganzzahl division als neues zeichen einfügen
If (Src Mod DestZS) >= 10 Then
MutateStd = Chr(Asc("A") - 10 + (Src Mod DestZS)) & MutateStd
Else
MutateStd = CStr(Src Mod DestZS) & MutateStd
End If
'reduzieren
Src = Src \ DestZS
Loop Until Src = 0
End Function
'umwandlung ins zehnersystem
Public Function To10&(ByVal Src$, ByVal SrcZS As Byte)
Dim I&
'überprüfung auf besondere zahlensysteme
If SrcZS = 1 Then
'im einersystem einfach die länge zurückgeben
To10 = Len(Src)
Exit Function
ElseIf SrcZS = 0 Then
'null nicht erlaubt
To10 = -1
Exit Function
End If
'falls nicht nur ziffern, sondern auch buchstaben vorkommen,
'alle großschreiben zur leichteren späteren verarbeitung:
Src = UCase(Src)
'umformen
For I = 1 To Len(Src)
If IsNumeric(Mid(Src, I, 1)) Then 'normale zahl
To10 = To10 + Mid(Src, I, 1) * SrcZS ^ (Len(Src) - I)
Else 'vom hexadezimalen umrechnen
To10 = To10 + (Asc(Mid(Src, I, 1)) - Asc("A") + 10) * SrcZS ^ (Len(Src) - I)
End If
Next
End Function
'umwandlung von einem bel. in ein anderes bel. zs
Public Function Mutate$(ByVal Src$, ByVal SrcZS As Byte, ByVal DestZS As Byte)
'kombination der beiden oberen funktionen
Mutate = MutateStd(To10(Src, SrcZS), DestZS)
End Function
