CLASSE POUR CONVERTIR LES BASES

Option Explicit

Public Function IsHexadecimal(ByVal strNumber As String) As Boolean

' Variable compteur pour la position de la lettre.
Dim lngCounter As Long
'
Dim bolResult As Boolean
' Variable de test d'un caractère.
Dim strTest As String * 1
'
For lngCounter = 1 To Len(strNumber)
    '
    strTest = Mid(strNumber, lngCounter, 1)
    '
    Select Case strTest
        '
        Case 0 To 9
            '
            bolResult = True
        '
        Case "A"
            '
            bolResult = True
        '
        Case "B"
            '
            bolResult = True
        '
        Case "C"
            '
            bolResult = True
        '
        Case "D"
            '
            bolResult = True
        '
        Case "E"
            '
            bolResult = True
        '
        Case "F"
            '
            bolResult = True
        '
        Case Else
            '
            bolResult = False
            '
            Exit For
    End Select
Next lngCounter
'
IsHexadecimal = bolResult

End Function
Public Function IsOctal(ByVal strNumber As String) As Boolean

'
Dim lngCounter As Long
'
Dim strTemp As String * 1
'
Dim bolResult As Boolean
'
For lngCounter = 1 To Len(strNumber)
    '
    strTemp = Mid(strNumber, lngCounter, 1)
    '
    Select Case strTemp
        '
        Case 0 To 7
            '
            bolResult = True
        '
        Case Else
            '
            bolResult = False
            '
            Exit For
    End Select
Next lngCounter
'
IsOctal = bolResult

End Function
Public Function IsBinary(ByVal strNumber As String) As Boolean

' Compteur de caractères
Dim lngCounter As Long
' Variable qui retourne le résultat.
Dim bolResult As Long
' De 1 à la taille de la chaîne,
For lngCounter = 1 To Len(strNumber)
    ' Si une des lettres est 0 ou 1,
    If Mid(strNumber, lngCounter, 1) = "0" Or Mid(strNumber, lngCounter, 1) = "1" Then
        ' Retourne vrai comme valeur.
        bolResult = True
    ' Sinon,
    Else
        ' Retourne faux comme valeur.
        bolResult = False
        ' Sort de la boucle.
        Exit For
    End If
Next lngCounter
' Retourne la valeur de bolResult.
IsBinary = bolResult

End Function

Public Function IsDecimal(ByVal strNumber As String) As Boolean

'
Dim lngCounter As Long
'
Dim strTemp As String * 1
'
Dim bolResult As Boolean
'
For lngCounter = 1 To Len(strNumber)
    '
    strTemp = Mid(strNumber, lngCounter, 1)
    '
    Select Case strTemp
        '
        Case 0 To 9
            '
            bolResult = True
        '
        Case Else
            '
            bolResult = False
            '
            Exit For
    End Select
Next lngCounter
'
IsDecimal = bolResult

End Function
Public Function DecToBin(ByVal curNumber As Currency) As String

' Variable des résultats.
Dim curResult As Currency
' Variable des résultats temporaires.
Dim curTempResult As Currency
' Variable temporaire.
Dim curTemp As Currency
' Variable des résultats en hexadécimal.
Dim strTemp As String
' Mettre la valeur de lngNumber dans lngResult.
curResult = curNumber
' Faire,
Do
    ' Mettre e résultat dans la variable des résultats temporaires.
    curTempResult = curResult
    ' Diviser le nombre par 16 et prendre la partie entière.
    curResult = Int(curResult / 2)
    ' Le résultat moins curResult fois 16
    curTemp = (curTempResult - (curResult * 2))
    '
    If curTemp = 0 Then
        '
        strTemp = strTemp & "0"
    '
    ElseIf curTemp = 1 Then
        '
        strTemp = strTemp & "1"
    End If
Loop Until curResult = 0
'
DecToBin = strTemp

End Function

Public Function DecToOct(ByVal curNumber As Currency) As Currency

' Variable des résultats.
Dim curResult As Currency
' Variable des résultats temporaires.
Dim curTempResult As Currency
' Variable temporaire.
Dim curTemp As Currency
'
Dim strTemp As String
' Mettre la valeur de lngNumber dans lngResult.
curResult = curNumber
' Faire,
Do
    ' Mettre e résultat dans la variable des résultats temporaires.
    curTempResult = curResult
    ' Diviser le nombre par 8 et prendre la partie entière.
    curResult = Int(curResult / 8)
    ' Le résultat moins curResult fois 16
    curTemp = (curTempResult - (curResult * 8))
    '
    Select Case curTemp
        '
        Case 0 To 7
            '
            strTemp = strTemp & curTemp
    End Select
Loop Until curResult = 0
'
DecToOct = strTemp

End Function
Public Function BinToDec(ByVal strNumber As String) As Currency

' Variable compteur pour la position de la lettre.
Dim lngCounter As Long
' Variable du résultat finale.
Dim curFinal As Currency
' Variable pour le nombre de chaque position.
Dim curNumber As Currency
' Tableau des sommes des résultats.
Dim curResults() As Currency
' Variable de test d'un caractère.
Dim strTest As String * 1
'
For lngCounter = 0 To Len(strNumber) - 1
    '
    strTest = Mid(strNumber, lngCounter + 1, 1)
    '
    Select Case strTest
        '
        Case 0 To 1
            '
            curNumber = strTest
    End Select
    ' Redimenssionner le tableau de résultats.
    ReDim Preserve curResults(lngCounter)
    '
    curResults(lngCounter) = curNumber * (2 ^ lngCounter)
Next lngCounter
'
For lngCounter = 0 To UBound(curResults())
    '
    curFinal = curFinal + curResults(lngCounter)
Next lngCounter

BinToDec = curFinal

End Function

Public Function OctToDec(ByVal strNumber As String) As Currency

' Variable compteur pour la position de la lettre.
Dim lngCounter As Long
' Variable du résultat finale.
Dim curFinal As Currency
' Variable pour le nombre de chaque position.
Dim curNumber As Currency
' Tableau des sommes des résultats.
Dim curResults() As Currency
' Variable de test d'un caractère.
Dim strTest As String * 1
'
For lngCounter = 0 To Len(strNumber) - 1
    '
    strTest = Mid(strNumber, lngCounter + 1, 1)
    '
    Select Case strTest
        '
        Case 0 To 7
            '
            curNumber = strTest
    End Select
    ' Redimenssionner le tableau de résultats.
    ReDim Preserve curResults(lngCounter)
    '
    curResults(lngCounter) = curNumber * (8 ^ lngCounter)
Next lngCounter
'
For lngCounter = 0 To UBound(curResults())
    '
    curFinal = curFinal + curResults(lngCounter)
Next lngCounter

OctToDec = curFinal

End Function
Public Function DecToHex(ByVal curNumber As Currency) As String

' Variable des résultats.
Dim curResult As Currency
' Variable des résultats temporaires.
Dim curTempResult As Currency
' Variable temporaire.
Dim curTemp As Currency
' Variable des résultats en hexadécimal.
Dim strTemp As String
' Mettre la valeur de lngNumber dans lngResult.
curResult = curNumber
' Faire,
Do
    ' Mettre e résultat dans la variable des résultats temporaires.
    curTempResult = curResult
    ' Diviser le nombre par 16 et prendre la partie entière.
    curResult = Int(curResult / 16)
    '
    If curResult = 0 Then
        '
        curTemp = curTempResult
    '
    Else
        ' Le résultat moins curResult fois 16
        curTemp = (curTempResult - (curResult * 16))
    End If
        '
        Select Case curTemp
            '
            Case 0 To 9
                '
                strTemp = strTemp & curTemp
            '
            Case 10
                '
                strTemp = strTemp & "A"
            '
            Case 11
                '
                strTemp = strTemp & "B"
            '
            Case 12
                '
                strTemp = strTemp & "C"
            '
            Case 13
                '
                strTemp = strTemp & "D"
            '
            Case 14
                '
                strTemp = strTemp & "E"
            '
            Case 15
                '
                strTemp = strTemp & "F"
        End Select
Loop Until curResult = 0
' Retourne le nombre en hexadecimal
DecToHex = strTemp

End Function

Public Function HexToDec(ByVal strNumber As String) As Currency

' Variable compteur pour la position de la lettre.
Dim lngCounter As Long
' Variable du résultat finale.
Dim curFinal As Currency
' Variable pour le nombre de chaque position.
Dim curNumber As Currency
' Tableau des sommes des résultats.
Dim curResults() As Currency
' Variable de test d'un caractère.
Dim strTest As String * 1
'
For lngCounter = 0 To Len(strNumber) - 1
    '
    strTest = Mid(strNumber, lngCounter + 1, 1)
    '
    Select Case strTest
        '
        Case 0 To 9
            '
            curNumber = strTest
        '
        Case "A"
            '
            curNumber = 10
        '
        Case "B"
            '
            curNumber = 11
        '
        Case "C"
            '
            curNumber = 12
        '
        Case "D"
            '
            curNumber = 13
        '
        Case "E"
            '
            curNumber = 14
        '
        Case "F"
            '
            curNumber = 15
    End Select
    ' Redimenssionner le tableau de résultats.
    ReDim Preserve curResults(lngCounter)
    '
    curResults(lngCounter) = curNumber * (16 ^ lngCounter)
Next lngCounter
'
For lngCounter = 0 To UBound(curResults())
    '
    curFinal = curFinal + curResults(lngCounter)
Next lngCounter

HexToDec = curFinal

End Function

Public Function BinToOct(ByVal strNumber As String) As Currency

'
Dim curResult1 As Currency
'
Dim curResult2 As Currency
'
curResult1 = Me.BinToDec(strNumber)
'
curResult2 = Me.DecToOct(curResult1)
'
BinToOct = curResult2

End Function

Public Function BinToHex(ByVal strNumber As String) As String

'
'
Dim curResult1 As Currency
'
Dim curResult2 As String
'
curResult1 = Me.BinToDec(strNumber)
'
curResult2 = Me.DecToHex(curResult1)
'
BinToHex = curResult2

End Function

Public Function OctToBin(ByVal curNumber As Currency) As String

'
Dim curResult1 As Currency
'
Dim curResult2 As String
'
curResult1 = Me.OctToDec(curNumber)
'
curResult2 = Me.DecToBin(curResult1)
'
OctToBin = curResult2

End Function

Public Function OctToHex(ByVal curNumber As Currency) As String

'
Dim curResult1 As Currency
'
Dim curResult2 As String
'
curResult1 = Me.OctToDec(curNumber)
'
curResult2 = Me.DecToHex(curResult1)
'
OctToHex = curResult2

End Function

Public Function HexToBin(ByVal strNumber As String) As String

'
Dim curResult1 As Currency
'
Dim curResult2 As String
'
curResult1 = Me.HexToDec(strNumber)
'
curResult2 = Me.DecToBin(curResult1)
'
HexToBin = curResult2

End Function

Public Function HexToOct(ByVal strNumber As String) As Currency

'
Dim curResult1 As Currency
'
Dim curResult2 As Currency
'
curResult1 = Me.HexToDec(strNumber)
'
curResult2 = Me.DecToOct(curResult1)
'
HexToOct = curResult2

End Function