Resist calc - calculateur de résistance

Soyez le premier à donner votre avis sur cette source.

Vue 23 372 fois - Téléchargée 1 562 fois

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

Ajouter un commentaire

Commentaires

eric30eric
Messages postés
8
Date d'inscription
mardi 14 janvier 2003
Statut
Membre
Dernière intervention
6 octobre 2003

sa a tout bogué mon bo Palm Zire 71.. une chance que je venait tout juste de syncroniser :)
peut etre j'ai instaler le mauvais fichier? ==> résistance-clac-install.prc
Cyberdevil
Messages postés
483
Date d'inscription
mardi 10 juillet 2001
Statut
Membre
Dernière intervention
12 juillet 2006

ouais ct ça.... bizzar... essaie de recompiler (télécharge sourceforge...)
++
eric30eric
Messages postés
8
Date d'inscription
mardi 14 janvier 2003
Statut
Membre
Dernière intervention
6 octobre 2003

ouais mais j'ai rien compiler j'ai prit le fichier .prc parce que je ne pas asser d'argent pour acheter AppForge lol!
Cyberdevil
Messages postés
483
Date d'inscription
mardi 10 juillet 2001
Statut
Membre
Dernière intervention
12 juillet 2006

non mais ya une version gratuite a télécharger (valable 30j)... aufaite sur ton palm tuas quel OS ? (si ce le 5 c normal que ça marche pas)
eric30eric
Messages postés
8
Date d'inscription
mardi 14 janvier 2003
Statut
Membre
Dernière intervention
6 octobre 2003

ouais c le 5

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.