RÉSISTANCE PROG

'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'    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)                   
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-='
 

Télécharger le zip