1) CREER UN NOUVEAU PROJET
2) AJOUTE UN CONTROLE TIMER SUR TA FORM
3) CREER UN NOUVEAU MODULE
4)COLLE CE CODE DANS TA FORM
Private Sub Form_Initialize()
'RECUPERER LES ARGUMENTS AJOUTER APRES L'EXE
'DANS NOTRE CAS: monexe.exe /hide
Dim rtArgument As String
rtArgument = Command
If UCase(rtArgument) = "/HIDE" Then
Me.Hide
Else
Me.Show
End If
End Sub
Private Sub Form_Load()
'ON AJOUTE NOS FILTRES DE CLASSNAME
Module1.AjouterClassFiltre "IEFrame"
Module1.AjouterClassFiltre "MozillaUIWindowClass"
'DEMARRE LE TIMER POUR ATTRAPER
'L APPLICATION FOCUSED TOUTE LES 5 sec
Timer1.Interval = 5000
Timer1.Enabled = True
DoEvents
End Sub
Private Sub Timer1_Timer()
Dim rtClassNameOK As String
'Si l'application active fait pas parti de mes filtres, on sort
rtClassNameOK = Module1.TargetIsActive
If rtClassNameOK = "" Then Exit Sub
'On désactive le timer le temps de faire ses trucs
Timer1.Enabled = False
'Sinon, on fait ski ya a faire
Select Case rtClassNameOK
Case "IEFrame"
Debug.Print "FOCUS INTERNET EXPLORER: " & Now
Case "MozillaUIWindowClass"
Debug.Print "FOCUS FIREFOX: " & Now
End Select
'On réactive le timer une fois ses trucs fini
Timer1.Enabled = True
End Sub
5)COLLE CE CODE DANS TON MODULE
Private Declare Function GetActiveWindow Lib "User32" () As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "User32" () As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'INFORMATION APPLCATION ONTOP
Private Type InfoActiveAPP
Titre As String
Class As String
End Type
Private CurrentFocusApp As InfoActiveAPP
'MES FILTRES DE CLASS
Private CurrentFiltres() As String
Private curEntry As Integer
'L APPLICATION ACTIVE FAIT PARTI DE MES FILTRES DE CLASSNAME ?
Private Function ClassPremierPlan() As Boolean
Dim i As Integer
Dim rtFunc As Boolean
rtFunc = False
For i = 0 To curEntry - 1
If UCase(CurrentFiltres(i)) = UCase(CurrentFocusApp.Class) Then
rtFunc = True
Exit For
End If
Next i
ClassPremierPlan = rtFunc
End Function
Public Sub AjouterClassFiltre(ByVal ClassName As String)
If ClassName = "" Then
MsgBox "Le filtre ne peut etre vide !", vbExclamation
Exit Sub
End If
ReDim Preserve CurrentFiltres(curEntry)
CurrentFiltres(curEntry) = ClassName
curEntry = curEntry + 1
End Sub
Private Sub MemoriserApplicationActive(ByVal TitreFenetre As String, ByVal ClassName As String)
CurrentFocusApp.Titre = TitreFenetre
CurrentFocusApp.Class = ClassName
End Sub
Public Function TargetIsActive() As String
Dim lWnd As Long
Dim strName As String
Dim strClass As String
lWnd = GetActiveWindow
If lWnd 0 Then lWnd GetForegroundWindow
strName = String(GetWindowTextLength(lWnd) + 1, Chr$(0))
strClass = String(100, Chr(0))
GetWindowText lWnd, strName, Len(strName)
GetClassName lWnd, strClass, 255
strClass = Replace(strClass, Chr(0), "")
Call MemoriserApplicationActive(strName, strClass)
If ClassPremierPlan = True Then
TargetIsActive = CurrentFocusApp.Class
Else
TargetIsActive = ""
End If
End Function