fenetre en premier plan

Question

salut les amis.
je souhaite avoir le code qui me donne le non ou l'identifiant de la fenêtre(processus) en premier plan.par exemple si je lance IE ,Firefox, et un document word et que la fenêtre IE possède le focus alors le programme me rend l'identifiant de IE.
mercis à l'avance.

Duke49 · Answer

Créeer un nouveau projet vierge, ajoute un controle timer a ta form.
Pis colle ce code:


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 Sub Form_Load()
  Timer1.Interval = 5000
  Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
Dim lWnd As Long
Dim strName As String

lWnd = GetActiveWindow
If lWnd 0 Then lWnd GetForegroundWindow

strName = String(GetWindowTextLength(lWnd) + 1, Chr$(0))
GetWindowText lWnd, strName, Len(strName)

Me.Caption = strName
End Sub

Duke49 · Answer

j'te programme un exemple, wait

Duke49 · Answer

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

Fenetre en premier plan

3 réponses

Votre réponse

Discussions similaires