RESIST CALC - CALCULATEUR DE RÉSISTANCE

Option Explicit
Dim ch1 As Integer, ch2 As Integer, ch3 As Integer
Dim mult As Double
Dim tol As Long
Dim temp As Integer

Private Sub AFTextBox1_Change()
    Dim lenombre As String
    Dim chiffresign As String
    Dim nbzero As Long
    Dim lechiffre As Double
    Dim lechiffrestr As String
    Dim lafin As String
    Dim c1 As Integer, c2 As Integer, c3 As Integer
    Dim i As Integer
    For i = 1 To Len(AFTextBox1.Text)
        If Asc(Mid(AFTextBox1.Text, i, 1)) > 57 Or Asc(Mid(AFTextBox1.Text, i, 1)) < 48 Then Exit Sub
    Next i
    If AFTextBox1.Text <> "" Then
        c1 = 0
        c2 = 0
        c3 = 0
        lechiffre = Round(CDbl(AFTextBox1.Text) * (10 ^ CDbl(unite.ListIndex * 3)), 0)
        If lechiffre > 9990000000# Then
            AFTextBox1.Text = "9.99"
            Exit Sub
        End If
        lechiffrestr = CStr(lechiffre)

        c1 = CInt(Left(lechiffrestr, 1))
        If bandes.ListIndex = 2 Then    '6
            If Len(lechiffrestr) = 2 Then
                c2 = CInt(Mid(lechiffrestr, 2, 1))
            ElseIf Len(lechiffrestr) = 3 Then
                c2 = CInt(Mid(lechiffrestr, 2, 1))
                c3 = CInt(Mid(lechiffrestr, 3, 1))
            ElseIf Len(lechiffrestr) > 3 Then
                c2 = CInt(Mid(lechiffrestr, 2, 1))
                c3 = CInt(Mid(lechiffrestr, 3, 1))
                lafin = Mid(lechiffrestr, 4)
                nbzero = Len(lafin)
            End If
            r_couleur1.BackColor = couleur1(c1).BackColor
            r_couleur2.BackColor = couleur2(c2).BackColor
            r_couleur3.BackColor = couleur3(c3).BackColor
        Else    '5 ou 4
            If Len(lechiffrestr) = 2 Then
                c2 = CInt(Mid(lechiffrestr, 2, 1))
            ElseIf Len(lechiffrestr) > 2 Then
                c2 = CInt(Mid(lechiffrestr, 2, 1))
                lafin = Mid(lechiffrestr, 3)
                nbzero = Len(lafin)
            End If
            r_couleur1.BackColor = couleur1(c1).BackColor
            r_couleur2.BackColor = couleur2(c2).BackColor
        End If
        If nbzero > 7 Then nbzero = 7
        r_couleur4.BackColor = couleur4(nbzero).BackColor
    End If
End Sub

Private Sub aide_apropos_Click()
    frmAbout.Show
    Me.Hide
End Sub

Private Sub aide_couleurs_Click()
    frmAide_Couleurs.Show
    Me.Hide
End Sub

Private Sub bandes_Change()
    Dim i As Integer
    If bandes.ListIndex = 0 Then    '4
        For i = 0 To 9
            couleur3(i).Visible = False
            couleur4(i).Left = 56
        Next i
        For i = 0 To 6
            ppm(i).Visible = False
        Next i
        r_couleur3.Visible = False
        r_couleur6.Visible = False
        ppcm.Visible = False
        AFLabel1.Visible = False
        r_couleur4.Left = 64
    ElseIf bandes.ListIndex = 1 Then    '5
        For i = 0 To 9
            couleur3(i).Visible = True
            couleur4(i).Left = 84
        Next i
        For i = 0 To 6
            ppm(i).Visible = False
        Next i
        r_couleur3.Visible = True
        r_couleur6.Visible = False
        ppcm.Visible = False
        AFLabel1.Visible = False
        r_couleur4.Left = 88
    ElseIf bandes.ListIndex = 2 Then    '6
        For i = 0 To 9
            couleur3(i).Visible = True
            couleur4(i).Left = 84
        Next i
        For i = 0 To 6
            ppm(i).Visible = True
        Next i
        r_couleur3.Visible = True
        r_couleur6.Visible = True
        ppcm.Visible = True
        AFLabel1.Visible = True
        r_couleur4.Left = 88
    End If
End Sub

Private Sub couleur1_Click(Index As Integer)
    r_couleur1.BackColor = couleur1(Index).BackColor
    ch1 = Index
    makeResult
End Sub

Private Sub couleur2_Click(Index As Integer)
    r_couleur2.BackColor = couleur2(Index).BackColor
    ch2 = Index
    makeResult
End Sub

Private Sub couleur3_Click(Index As Integer)
    r_couleur3.BackColor = couleur3(Index).BackColor
    ch3 = Index
    makeResult
End Sub

Private Sub couleur4_Click(Index As Integer)
    r_couleur4.BackColor = couleur4(Index).BackColor
    If Index = 8 Then
        mult = 10 ^ -2
    ElseIf Index = 9 Then
        mult = 10 ^ -1
    Else
        mult = 10 ^ Index
    End If
    makeResult
End Sub

Private Sub couleur5_Click(Index As Integer)
    r_couleur5.BackColor = couleur5(Index).BackColor
    tolerance.ListIndex = Index
End Sub



Private Sub Form_Load()
    unite.AddItem "Ohms"
    unite.AddItem "KOhms"
    unite.AddItem "MOhms"
    unite.AddItem "GOhms"
    unite.ListIndex = 0
    tolerance.AddItem "10%"
    tolerance.AddItem "5%"
    tolerance.AddItem "20%"
    tolerance.AddItem "1%"
    tolerance.AddItem "2%"
    tolerance.AddItem "0.50%"
    tolerance.AddItem "0.25%"
    tolerance.AddItem "0.10%"
    tolerance.AddItem "0.05%"
    tolerance.ListIndex = 1
    ppcm.AddItem "100"
    ppcm.AddItem "50"
    ppcm.AddItem "15"
    ppcm.AddItem "25"
    ppcm.AddItem "10"
    ppcm.AddItem "5"
    ppcm.AddItem "1"
    ppcm.ListIndex = 1
    bandes.AddItem "4"
    bandes.AddItem "5"
    bandes.AddItem "6"
    bandes.ListIndex = 2
    ch1 = 0
    ch2 = 0
    ch3 = 0
    mult = 10 ^ 0
    makeResult
End Sub

Private Sub ppcm_Change()
    r_couleur6.BackColor = ppm(ppcm.ListIndex).BackColor
    AFLabel1.ZOrder 0
End Sub

Private Sub ppcm_Click()
    AFLabel1.ZOrder 0
End Sub

Private Sub ppm_Click(Index As Integer)
    r_couleur6.BackColor = ppm(Index).BackColor
    ppcm.ListIndex = Index
    AFLabel1.ZOrder 0
End Sub

Private Sub tolerance_Change()
    r_couleur5.BackColor = couleur5(tolerance.ListIndex).BackColor
End Sub

Private Sub makeResult()
    Dim lechiffre As Double
    If bandes.ListIndex = 2 Then    '6
        lechiffre = CDbl(CStr(ch1) & CStr(ch2) & CStr(ch3)) * mult
    Else    '5 ou 4
        lechiffre = CDbl(CStr(ch1) & CStr(ch2)) * mult
    End If
    lechiffre = Round(lechiffre, 2)
    If lechiffre >= 10 ^ 9 Then
        unite.ListIndex = 3
        lechiffre = lechiffre / (10 ^ 9)
    ElseIf lechiffre >= 10 ^ 6 Then
        unite.ListIndex = 2
        lechiffre = lechiffre / (10 ^ 6)
    ElseIf lechiffre >= 10 ^ 3 Then
        unite.ListIndex = 1
        lechiffre = lechiffre / (10 ^ 3)
    Else
        unite.ListIndex = 0
    End If
    AFTextBox1.Text = lechiffre
End Sub

Private Sub unite_Change()
    Call AFTextBox1_Change
End Sub

Télécharger le zip