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
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.