Alors, ce code envoie un son de 16 khz pendant 2 secondes, puis il monte de 100 en 100 hz pour s'arreter a 20 khz. Cela dure environ 1minute 26 secondes.
Ensuite il s'arrete pendant 3 minutes puis recommence et ainsi de suite.
Le code n'est pas bien lisible et ya des choses ou je suis sur que l'on peut modifier pour faciliter le tout !
Mais bon, la hatise m'a dépassé ;)
Bon, je vous laisse faire une ptite sieste sans moustics.
Si vous ne comprenez pas pk sa chasse les moustics, c écrit ds le bouton Nfo :)
vala !
Source / Exemple :
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function DlPortReadPortUchar Lib "dlportio.dll" _
(ByVal Port As Long) As Byte
Private Declare Sub DlPortWritePortUchar Lib "dlportio.dll" _
(ByVal Port As Long, _
ByVal Value As Byte)
Dim ActifSon As Boolean
Public freq
Private Sub CmdPlay_Click()
If cmdplay.Caption = "Démarrer" Then
freq = Empty
freq = 15900
Form1.WindowState = 1
Timer1.Enabled = True
cmdplay.Caption = "Arreter"
ElseIf cmdplay.Caption = "Arreter" Then
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
cmdplay.Caption = "Démarrer"
End If
End Sub
Private Sub PlayHP(Frequence As Long, Durée As Long)
Dim OctetBas As Integer
Dim OctetHaut As Integer
Dim Periode As Integer
Dim EtatHP As Integer
'Calcul des valeurs Haute et Basse du timer du HP
Periode = CInt(1193280 / Frequence)
OctetBas = Periode And &HFF
OctetHaut = Periode \ 256
'Prépare le timer du HP pour la réception de Data
DlPortWritePortUchar 67, 182
'Envoie les données au timer du HP
DlPortWritePortUchar 66, OctetBas
DlPortWritePortUchar 66, OctetHaut
'Activation du Timer en activant le deux bits de poids faible
EtatHP = DlPortReadPortUchar(97) Or &H3
DlPortWritePortUchar 97, EtatHP
'Gestion de la durée
'Positionne le flag de contrôle d'état
ActifSon = True
'Active le timer
TimerPlay.Interval = Durée
TimerPlay.Enabled = True
Do While ActifSon
DoEvents
Loop
'Désactivation du Timer en désactivant le deux bits de poids faible '
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
End Sub
Private Sub Command1_Click()
MsgBox "Anti-Moustic V1.0" & vbCrLf & "Ce programme chasse les moustics en émettant un ultrason." & vbCrLf & "Ce sont les femelles moustics qui piquent car elle veulent alimenter leur enfants de protéines, contenues dans votre sang. Pendant cette période, ces moustics femelles évitent les mâles, et comme tout insectes, les mâles émettent un ultrason au battement de leur ailes." & vbCrLf & "Anti-Moustic V1.0 va émettre l'ultrason que font les mâles pour faire fuires les femelles moustics." & vbCrLf & "L'ultrason émit démarre a 16 Khz, monte de 100 hz en 100 hz pendant 1 minute 26 secondes, pour finir a 20 khz, car certaines races de moustics réagissent avec un son différent." & vbCrLf & "Ensuite, le programme arretera l'émission d'ultrason pendant 3 minutes puis recommencera !" & vbCrLf & "Bonne sieste :)" & vbCrLf & "CodeFalse", vbOKOnly + vbInformation, "Information"
End Sub
Private Sub Command2_Click()
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
End
End Sub
Private Sub Form_Load()
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
Label1.Caption = "Anti-Moustic V1.0" & vbCrLf & "Ce programme chasse les moustics en émettant un ultrason." & vbCrLf & "Cliquez sur le bouton " & Chr(34) & "NFO" & Chr(34) & " pour plus d'info !"
End Sub
Private Sub Timer1_Timer()
freq = freq + 100
If freq < "20001" Then
PlayHP CDbl(freq), CDbl(2000)
ElseIf freq >= "20000" Then
EtatHP = DlPortReadPortUchar(97) And &HFC
DlPortWritePortUchar 97, EtatHP
If freq = 18000 Then
freq = 15900
End If
End If
End Sub
Private Sub TimerPlay_Timer()
ActifSon = False
TimerPlay.Enabled = False
End Sub
Conclusion :
Je remercie énormément FredLynx qui sans son chti code qui émet les son, je n'aurai rien pu faire.
Bon, ct pour le délire, c'est fait now, je tiens a remiercier Nitric, FredLynx, Zmc, TotoBest, TheSaib, PsycoMaxter et tout ceux du channel pour leur aide et leur délire ;)
ouéh au fait, ds la form vous mettez 3 bouton :
command1
command2
cmdplay
timer1
TimerPlay
label1
et rulez :)
Ps ( scuzez les fotes d'ortografes )
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.