Accueil > > > RÉSISTANCE PROG
RÉSISTANCE PROG
Information sur la source
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
- '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
- ' 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)
- '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-='
-
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' 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.
Fichier Zip
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
GESTION D'EXCEPTION AVEC LES TASKSGESTION D'EXCEPTION AVEC LES TASKS par richardc
Nous avons vu dans un précédent article comment utiliser Task pour effectuer des opérations dans un autre thread.
Malheureusement, comme tout le monde n'est pas parfait, il se peut que cette exécution se passe mal et qu'une exception se produise.
La...
Cliquez pour lire la suite de l'article par richardc DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|