Mit Hilfe der hier gezeigten Funktion können Sie ganz leicht zwischen Zahlensystemen umrechen. Neben den gängigen Zahlensystemen wie Dezimal (10), Hexadezimal (16), Oktal (8) und Binär (2), können Sie alle Zahlen der Basis 2-36 umrechnen. Und das alles mit nur einer Funktion und ganz ohne API-Funktionen.

Ihre Bewertung:   1 2 3 4 5

Bewertung dieses Tipps:

(bewertet von insgesamt 61 Besuchern)

Wenn Sie die folgende Funktion in ein Modul setzen, ist sie im gesamten Projekt nutzbar:

Function BaseConvert(NumIn As String, BaseIn As Byte, BaseOut As Byte) As String
   'Binär       = Basis 2
   'Oktal       = Basis 8
   'Dezimal     = Basis 10
   'Hexadezimal = Basis 16

   Dim i As Integer, CurrentCharacter As String, CharacterValue As Integer
   Dim PlaceValue As Integer, RunningTotal As Double, Remainder As Double
   Dim BaseOutDouble As Double, NumInCaps As String

   If NumIn = "" Or BaseIn < 2 Or BaseIn > 36 Or BaseOut < 1 Or BaseOut > 36 Then
      'Keine Angabe oder ungültiges Zahlensystem
      BaseConvert = "Error"
      Exit Function
   End If

   NumInCaps = UCase(NumIn)

   PlaceValue = Len(NumInCaps)

   For i = 1 To Len(NumInCaps)
      PlaceValue = PlaceValue - 1
      CurrentCharacter = Mid$(NumInCaps, i, 1)
      CharacterValue = 0
      If Asc(CurrentCharacter) > 64 And Asc(CurrentCharacter) < 91 Then
         CharacterValue = Asc(CurrentCharacter) - 55
      End If

      If CharacterValue = 0 Then
         If Asc(CurrentCharacter) < 48 Or Asc(CurrentCharacter) > 57 Then
            BaseConvert = "Error"
            Exit Function
         Else
            CharacterValue = Val(CurrentCharacter)
         End If
      End If

      If CharacterValue < 0 Or CharacterValue > BaseIn - 1 Then
         BaseConvert = "Error"
         Exit Function
      End If
      RunningTotal = RunningTotal + CharacterValue * (BaseIn ^ PlaceValue)
   Next i

   Do
      BaseOutDouble = CDbl(BaseOut)
      Remainder = RunningTotal - (Int(RunningTotal / BaseOutDouble) * BaseOutDouble)
      RunningTotal = (RunningTotal - Remainder) / BaseOut

      If Remainder >= 10 Then
         CurrentCharacter = Chr$(Remainder + 55)
      Else
         CurrentCharacter = Right$(Str$(Remainder), Len(Str$(Remainder)) - 1)
      End If
      BaseConvert = CurrentCharacter & BaseConvert
   Loop While RunningTotal > 0
End Function

Um nun eine Zahl umzuwandeln, gehen Sie wie bei folgendem Beispiel vor:

Dim Zahl As String
Dim Zahlensystem As Byte '0-255
Dim NeuesZahlensystem As Byte '0-255
Dim NeueZahl As String

Zahl = "0080FF"
Zahlensystem = 16 'Hexadezimal
NeuesZahlensystem = 10 'Dezimal
NeueZahl = BaseConvert(Zahl, Zahlensystem, NeuesZahlensystem)

Nach Ausführung dieses Beispiels enthält die Variable NeueZahl den Wert "33023". Tritt ein Fehler aufgrund ungültiger Angaben auf, so gibt die Funktion "Error" zurück.

Hier können Sie sich ein Beispielprojekt für Vb5 und Vb6 herunterladen, das vielleicht alles noch einmal etwas anschaulicher erklärt.

Projekt herunterladen

---

Quellen: SHADOWare.de Letzte Änderung: 07.08.2000

©2000 by SHADOWare, Thomas Bachem