Résistance prog

Télécharger le projet
Commenter

Description

Dédié à tout les électroniciens.
Ce programme interractif est destiné aux jeunes étudiants d'électronique et électrotechnique ... Désormais il ne se casseront plus la tête avec le code couleur des résistances ;-).
Facile à utiliser, l'utilisateur n'utilsera pas le clavier, seule la souris fera l'affaire : Les couleurs sont choisis par glisser-déposer ou par le biai d'un menu contextuel ..
Cliquez sur l'aperçu pour l'interface ..
Appil (Golden-X)

Source / Exemple : 


'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'    Micro programme réalisé par Appil - Avril 2002     
'                 appil@everyday.com                    
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' Mise à jour du 17/04/2002

Option Explicit

Dim IndexAppelant As Integer
Dim IndexCouleur As Integer

Private Sub CmdAstuce_Click()
MsgBox "  C vrai ke je me suis convertit en informaticien il y a 3 ou 4 ans, mais  l'électronique m'interesse toujours ..." & vbCrLf & "  Là je vous donne l'astuce qu'on utilisait pour se rappellé du code des couleurs : tt simplement une phrase dont chaque mot commence par la lettre de la couleur en ordre : " & vbCrLf & "  0 : Noir - 1 : Marron - 2 : Rouge - 3 : Orange - 4 : Jaune - 5 : Vert - 6 : Bleu - 7 : Violet - 8 : Gris - 9 : Blanc." & vbCrLf & "  Voici 2 phrases : " & vbCrLf & "  Ne Manger Rien Ou Jeuner Voila Bien Votre Grande Bêtise." & vbCrLf & "  ou" & vbCrLf & "  Ne Mangez Rien Ou Je Vais Briser Votre Grand Bec." & vbCrLf & "  Si vous en avez d'autres, envoyez les moi à appil@everyday.com, Merci ;-)", vbInformation, "Astuce Astuce Astuce Astuce Astuce Astuce Astuce Astuce Astuce Astuce Astuce Astuce"
End Sub

Private Sub CmdComment_Click()
mComment_Click
End Sub

Private Sub CmdQuitter_Click()
Unload Me
End Sub

Private Sub Form_Load()
frmResistancePrincipale.Caption = "Résistance Prog - Version " & App.Major & " - Par Appil (Golden-X)."
mComment_Click
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim Rep As VbMsgBoxResult
Rep = MsgBox("Vous êtes sûr de vouloir quitter ?", vbQuestion + vbYesNo, "Confirmation de sortie")
If Rep = vbNo Then
    Cancel = 1
Else
    Cancel = 0
    frmLogoCode.Show
End If
End Sub

Private Sub lblColor_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
Dim ValeurEnOhm As Double
Dim Msg As String

lblColor(Index).BackColor = Source.BackColor
lblN(Index).Caption = Source.Index
lblColor(Index).Caption = ""
If lblN(0).Caption <> "#" And lblN(1).Caption <> "#" And lblN(2).Caption <> "#" Then
    ValeurEnOhm = (Val(lblN(0)) * 10 + Val(lblN(1))) * (10 ^ Val(lblN(2)))
    lblVal = "La valeur de cette résistance est : "
    Select Case ValeurEnOhm
        Case 0
            lblVal = "Ce n'est pas une résistance ça, c'est un super-conducteur !!!"
            Msg = ""
        Case 1 To 999
            Msg = Format(ValeurEnOhm, "00.00") & " Ohm"
        Case 1000 To 999999
            Msg = Format(ValeurEnOhm / 1000, "00.00") & " KOhm"
        Case 1000000 To 999999999
            Msg = Format(ValeurEnOhm / 1000000, "00.00") & " MOhm"
        Case Else
            Msg = Format(ValeurEnOhm / 1000000000, "00.00") & " GOhm"
    End Select
    lblVal = lblVal & Msg
End If
End Sub

Private Sub lblColor_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ValeurEnOhm As Double
Dim Msg As String
If Button = 2 Then
    IndexAppelant = Index
    IndexCouleur = 99
    PopupMenu mColorMenu
    If IndexCouleur <> 99 Then
        lblN(Index) = IndexCouleur
        If lblN(0).Caption <> "#" And lblN(1).Caption <> "#" And lblN(2).Caption <> "#" Then
            ValeurEnOhm = (Val(lblN(0)) * 10 + Val(lblN(1))) * (10 ^ Val(lblN(2)))
            lblVal = "La valeur de cette résistance est : "
            Select Case ValeurEnOhm
                Case 0
                    lblVal = "Ce n'est pas une résistance ça, c'est un super-conducteur !!!"
                    Msg = ""
                Case 1 To 999
                    Msg = Format(ValeurEnOhm, "00.00") & " Ohm"
                Case 1000 To 999999
                    Msg = Format(ValeurEnOhm / 1000, "00.00") & " KOhm"
                Case 1000000 To 999999999
                    Msg = Format(ValeurEnOhm / 1000000, "00.00") & " MOhm"
                Case Else
                    Msg = Format(ValeurEnOhm / 1000000000, "00.00") & " GOhm"
            End Select
            lblVal = lblVal & Msg
        End If
    End If
End If
End Sub

Private Sub lblN_Change(Index As Integer)
If (Index = 0 Or Index = 2) And lblN(Index) = "0" Then
    lblN(Index) = ""
End If
End Sub

Private Sub mAbout_Click()
frmAbout.Show vbModal
End Sub

Private Sub mAstuce_Click()
    CmdAstuce_Click
End Sub

Private Sub mColor_Click(Index As Integer)
Select Case Index
    Case 0
        ' Noir
        lblColor(IndexAppelant).BackColor = vbBlack
    Case 1
        'Marron
        lblColor(IndexAppelant).BackColor = RGB(128, 64, 64)
    Case 2
        ' Rouge
        lblColor(IndexAppelant).BackColor = vbRed
    Case 3
        ' Orange
        lblColor(IndexAppelant).BackColor = RGB(255, 128, 0)
    Case 4
        ' Jaune
        lblColor(IndexAppelant).BackColor = vbYellow
    Case 5
        ' Vert
        lblColor(IndexAppelant).BackColor = RGB(0, 128, 0)
    Case 6
        ' Bleu
        lblColor(IndexAppelant).BackColor = RGB(0, 0, 128)
    Case 7
        ' Violet
        lblColor(IndexAppelant).BackColor = RGB(64, 0, 128)
    Case 8
        ' Gris
        lblColor(IndexAppelant).BackColor = RGB(128, 128, 128)
    Case 9
        ' Blanc
        lblColor(IndexAppelant).BackColor = vbWhite
End Select
IndexCouleur = Index
lblColor(IndexAppelant).Caption = ""
End Sub

Private Sub mComment_Click()
MsgBox "Pour calculer la valeur de votre résistance, vous n'avez qu'à reproduire ses couleurs sur le model du programme sois par Glisser-Déposer ou par le menu contextuel ..." & vbCrLf & "Petit rapel :  R = U / I. (Merci <Raptor>)", vbInformation, "Comment procéder ? c simple ..."
End Sub

Private Sub mQuitter_Click()
CmdQuitter_Click
End Sub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-='
'                         Fin.                          
'                   et à la prochaine                   
'                    Appil (Golden-X)                   
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-='

Conclusion :


Voila Raptor, l'erreur est courigée : R = U/I. Merci pour la remarque.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_Appil)