Resist calc - calculateur de résistance

Description

Ce ptit prog permet de savoir la valeur d'une résistance en lûi donnant ses couleurs et vicevers ça... les puissance -1 et -2 lors de la convertion valeur->couleur n'est pas encore implémentée... Le programme a été fait sous vb 6 avec appforge (www.appforge.com)

Source / Exemple :


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

Conclusion :


http://jetforce.xwaves.net

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.