CONVERTISSEUR

Commentaire de tototh le 05/02/2008 22:29:53

Vite fait:
Suppression des GOTO.
Indentation.
Renommage des valeurs (pas toutes)
une Sub par type de convertion (Plus tard, ecrire de simples fonctions)
et 2 ou 3 bricoles.
------------------------------------------------------------------------
Option Explicit
Dim BclFor, Car, c, n, a, b

Sub BinDec()
Dim a
    ' teste si la chaine de caractere en entré est propice à etre convertie
    For BclFor = 1 To Len(Text1.Text)
        Car = Mid(Text1.Text, BclFor, 1)
        If Car <> "0" And Car <> "1" Then
            MsgBox ("Que des '0' ou des '1'!!!")
            Exit Sub
        End If
    Next BclFor
    ' -Fin du test de la chaine
    
    c = 0
    For BclFor = 1 To Len(Text1.Text)
        Car = Mid(Text1.Text, BclFor, 1)
        If Car = 1 Then
            c = c + 2 ^ ((Len(Text1.Text) - BclFor))
        End If
    Next BclFor
    Text2.Text = c
End Sub

Sub DecBin()
Dim ValBin
    ValBin = ""
    ' teste si la chaine de caractere en entré est propice à etre convertie
    For BclFor = 1 To Len(Text1.Text)
        Car = Mid(Text1.Text, BclFor, 1)
        If IsNumeric(Car) = False Then
            MsgBox ("""  Car  """ & "  n'est pas un chiffre")
            Exit Sub
        End If
    Next BclFor
    ' -Fin du test de la chaine
    n = Val(Text1.Text)
    Do
        If n Mod 2 = 0 Then
           ValBin = ValBin & 0
        Else
           ValBin = ValBin & 1
        End If
        n = n \ 2
    Loop Until n <= 1
    Text2.Text = StrReverse(ValBin & 1)
End Sub

Sub HexDec()
    ' teste si la chaine de caractere en entré est propice à etre convertie
    c = 0
    a = Text1.Text
    For BclFor = 1 To Len(Text1.Text)
        Car = UCase(Mid(Text1.Text, BclFor, 1))  '48 - 57 = chiffre    65 - 70 = a -> F
        If Asc(Car) < 48 And Asc(Car) > 57 And Asc(Car) < 65 And Asc(Car) > 70 Then
            MsgBox ("""  Car  """ & " Chiffre en base 16 non valide!!!")
            Exit Sub
        End If
        If Asc(Car) > 64 And Asc(Car) < 71 Then
            n = Asc(Car) - 55
        End If
        c = c + n * 16 ^ ((Len(Text1.Text) - BclFor))
    Next BclFor
    Text2.Text = c
End Sub

Sub DecHex()
    ' teste si la chaine de caractere en entré est propice à etre convertie
    For BclFor = 1 To Len(Text1.Text)
        Car = Mid(Text1.Text, BclFor, 1)
        If IsNumeric(Car) = False Then
            MsgBox ("""  Car  """ & "  n'est pas un chiffre")
            Exit Sub
        End If
    Next BclFor
    ' -Fin du test de la chaine
    n = Text1.Text
    Car = Hex$(n)
    Text2.Text = Car
End Sub


Private Sub Command2_Click()
    Text1.Text = Replace(Trim(Text1.Text), " ", "")  ' Commun au quatres convertisseur
    
    If Option1.Value = True Then BinDec
    If Option2.Value = True Then DecBin
    If Option3.Value = True Then HexDec
    If Option4.Value = True Then DecHex
End Sub