Re: Anti-moustiques

Publié par Gerome le 17/09/2008 01:32:05
Bonjour,

Pour ceux qui ont FBSL d'installés sur leur postes, voici une version anti-moustique codée avec mon langage :

#Option Strict
#Uses "@|WIN32"

Static g_Flag = FALSE

Begin Enum
    IT_1 = 1001
    IB_1
End Enum

FBSL_SetText(Me, "-==:: Anti Mosquito by GEG 1.0 ::==-" )
Style_Remove(ME, WS_MAXIMIZEBOX + WS_SIZEBOX + WS_SYSMENU)
Dim %hButton = FBSL_Control( "button", Me, "&Quit", IB_1, 300, 16, 42, 20, WS_CHILD + BS_FLAT + WS_VISIBLE, 0 )
Resize(Me, 0, 0, 360, 80): Center(Me): SetTimer(Me, IT_1, 5000)
Hide(hButton): Show(Me): AntiMosquito(): Show(hButton)

Begin Events
    Select Case CBMSG
        Case WM_CLOSE
            KillTimer(Me, IT_1)
            ExitProgram(0)
        Case WM_COMMAND
            If CBCTLMSG = BN_CLICKED  AndAlso CBCTL = IB_1 Then SendMessage(Me, WM_CLOSE, 0, 0)
        Case WM_TIMER
            If CBCTL = 1001 And g_Flag = FALSE Then AntiMosquito()
    End Select
End Events

Sub AntiMosquito()
    g_Flag = TRUE
    Dim dc = GetDC(Me), str
    Fbsl_SetFormColor(Me, Rgb(0xFF,0x0,0x0))
    For Dim i = 32800 To 40000 Step 10 '// Ultra sons
        DoEvents
        ApiCall( "Beep", "kernel32", i, 500 )
        str = "-=:: Emitting sound at " & $i & " Hz ::=-"
        TextOut( dc, 42, 18, str, strLen(str) )
        DoEvents
    Next: ReleaseDC(Me, dc)
    Fbsl_SetFormColor(Me, Rgb(0x0,0x0,0xFF))
    g_Flag = FALSE
End Sub


Pour celles et ceux qui veulent tester une version compilée de ce programme, je vous invite à vous rendre ici :
http://gedd123.free.fr/Radio/anti-moustiques.7z

Merci pour vos feed-back!

Cette contribution était de : http://www.gratilog.net/xoops/newbb/viewtopic.php?forum=2&topic_id=3886&post_id=112920