Anti moustics ( sisi, c vrai :)))) )

Soyez le premier à donner votre avis sur cette source.

Vue 7 716 fois - Téléchargée 616 fois

Description

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 )

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Messages postés
1123
Date d'inscription
mardi 8 janvier 2002
Statut
Modérateur
Dernière intervention
21 avril 2009
1
euh t'a vu la date de publication ?
.net à l'époque, c'était le robot que tu a à coté de toi qui te parle et réagis bien .... ah c'est pas encore pour maintenant ;)

C'était codé en vb6 quand meme :p
Ya pas mal d'eau qu'à coulé sous mais aussi sur les ponts depuis :p
Messages postés
7
Date d'inscription
vendredi 11 avril 2003
Statut
Membre
Dernière intervention
25 février 2009

Tiens, bizarre, ton programme ne fonctionne pas :-)
Messages postés
3
Date d'inscription
lundi 21 août 2006
Statut
Membre
Dernière intervention
21 août 2006

ca marche pas sous windows xp
Messages postés
3
Date d'inscription
lundi 21 août 2006
Statut
Membre
Dernière intervention
21 août 2006

bien venu a vous tous
Messages postés
3
Date d'inscription
lundi 21 août 2006
Statut
Membre
Dernière intervention
21 août 2006

pour le moment aucun commentaire merci a vous tous
Afficher les 30 commentaires

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.