Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

VB6 - API - Maintenir une fenêtre en avant-plan et avec le focus

4 réponses
Avatar
teddy
Bonjour à tous,
Je cherche à créer un petit outil en VB6 qui me maintiendrait une fenêtre
choisie (par exemple celle d'une instance d'Internet Explorer) en avant-plan
et avec le focus à la demande.

J'ai créé une fonction exploitant 2 API dont voici le corps :

' Recherche de la fenêtre selon paramètre -> WindowName
Dim xhWnd As Long
xhWnd = FindWindow(vbNullString, WindowName)

' Maintien en avant-plan ou pas selon paramètre -> SetOnTop
If SetOnTop = True And xhWnd <> 0 Then
Ret = SetWindowPos(xhWnd, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE)
Else
Ret = SetWindowPos(xhWnd, HWND_NOTOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE)
End If

Dans le module, je déclare :

Public Const WM_CLOSE = &H10
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal
lpClassName As String, ByVal lpWindowName As String)
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"
(ByVal xhWnd1 As Long, ByVal xhWnd2 As Long, ByVal lpsz1 As String, ByVal
lpsz2 As String) As Long

Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_ACTIVATE = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const Flags = SWP_ACTIVATE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW Or
SWP_NOMOVE Or SWP_NOSIZE
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal
hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long,
ByVal cy As Long, ByVal wFlags As Long) As Long


Ma fenêtre désignée par WindowName est bien maintenue en avant-plan (j'ai
essayé avec une fenêtre Internet Explorer 6) mais je voudrais en plus en
maintenir le focus.

Auriez-vous une idée ?
Merci pour vos suggestions.
Teddy

4 réponses

Avatar
Patrice Henrio
Peut-être en écrivant un setfocus dans la méthode lost_focus

Private Sub Form_LostFocus()
Me.setFocus
End Sub

(non testé)

" teddy" a écrit dans le message de news:

Bonjour à tous,
Je cherche à créer un petit outil en VB6 qui me maintiendrait une fenêtre
choisie (par exemple celle d'une instance d'Internet Explorer) en
avant-plan et avec le focus à la demande.

J'ai créé une fonction exploitant 2 API dont voici le corps :

' Recherche de la fenêtre selon paramètre -> WindowName
Dim xhWnd As Long
xhWnd = FindWindow(vbNullString, WindowName)

' Maintien en avant-plan ou pas selon paramètre -> SetOnTop
If SetOnTop = True And xhWnd <> 0 Then
Ret = SetWindowPos(xhWnd, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE)
Else
Ret = SetWindowPos(xhWnd, HWND_NOTOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE)
End If

Dans le module, je déclare :

Public Const WM_CLOSE = &H10
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String)
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"
(ByVal xhWnd1 As Long, ByVal xhWnd2 As Long, ByVal lpsz1 As String, ByVal
lpsz2 As String) As Long

Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_ACTIVATE = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const Flags = SWP_ACTIVATE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW Or
SWP_NOMOVE Or SWP_NOSIZE
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long,
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx
As Long, ByVal cy As Long, ByVal wFlags As Long) As Long


Ma fenêtre désignée par WindowName est bien maintenue en avant-plan (j'ai
essayé avec une fenêtre Internet Explorer 6) mais je voudrais en plus en
maintenir le focus.

Auriez-vous une idée ?
Merci pour vos suggestions.
Teddy




--------------------------------------------------------------------------------
J'utilise la version gratuite de SPAMfighter pour utilisateurs privés.
300 e-mails spam ont été bloqués jusqu'à maintenant.
Les utilisateurs payant n'ont pas ce message dans leurs e-mails.
Essayez SPAMfighter gratuitement maintenant!
Avatar
teddy
Me.SetFocus donne le focus à la fenêtre VB6 courante.
Moi, ce que je cherche, c'est de maintenir le focus sur une fenêtre externe
(IE6 par exemple) à mon appli VB6.

Ted

"Patrice Henrio" a écrit dans le message de
news: %23wx0Rt$
Peut-être en écrivant un setfocus dans la méthode lost_focus

Private Sub Form_LostFocus()
Me.setFocus
End Sub

(non testé)

" teddy" a écrit dans le message de news:

Bonjour à tous,
Je cherche à créer un petit outil en VB6 qui me maintiendrait une fenêtre
choisie (par exemple celle d'une instance d'Internet Explorer) en
avant-plan et avec le focus à la demande.

J'ai créé une fonction exploitant 2 API dont voici le corps :

' Recherche de la fenêtre selon paramètre -> WindowName
Dim xhWnd As Long
xhWnd = FindWindow(vbNullString, WindowName)

' Maintien en avant-plan ou pas selon paramètre -> SetOnTop
If SetOnTop = True And xhWnd <> 0 Then
Ret = SetWindowPos(xhWnd, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE)
Else
Ret = SetWindowPos(xhWnd, HWND_NOTOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE)
End If

Dans le module, je déclare :

Public Const WM_CLOSE = &H10
Public Declare Function FindWindow& Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As String, ByVal lpWindowName As String)
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA"
(ByVal xhWnd1 As Long, ByVal xhWnd2 As Long, ByVal lpsz1 As String, ByVal
lpsz2 As String) As Long

Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_ACTIVATE = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const Flags = SWP_ACTIVATE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW Or
SWP_NOMOVE Or SWP_NOSIZE
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long,
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx
As Long, ByVal cy As Long, ByVal wFlags As Long) As Long


Ma fenêtre désignée par WindowName est bien maintenue en avant-plan (j'ai
essayé avec une fenêtre Internet Explorer 6) mais je voudrais en plus en
maintenir le focus.

Auriez-vous une idée ?
Merci pour vos suggestions.
Teddy




--------------------------------------------------------------------------------
J'utilise la version gratuite de SPAMfighter pour utilisateurs privés.
300 e-mails spam ont été bloqués jusqu'à maintenant.
Les utilisateurs payant n'ont pas ce message dans leurs e-mails.
Essayez SPAMfighter gratuitement maintenant!




Avatar
Vincent Guichard
teddy a écrit :
Me.SetFocus donne le focus à la fenêtre VB6 courante.
Moi, ce que je cherche, c'est de maintenir le focus sur une fenêtre externe
(IE6 par exemple) à mon appli VB6.

Ted



Bonjour,

D'après ma doc d'API, il faut que la fenêtre à laquelle tu veux donner
le focus soit associée au thread appelant. Ci-dessous l'exemple que
donne l'API Guide.

Vincent Guichard

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As
Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal
hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long,
ByVal wCmd As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock
As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long)
As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess
As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal
hwnd As Long) As Long
Const GW_HWNDNEXT = 2
Dim mWnd As Long
Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
'Find the first window
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0
'Check if the window isn't a child
If GetParent(test_hwnd) = 0 Then
'Get the window's thread
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
'retrieve the next window
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail:
Dim Pid As Long
'Lock the window update
LockWindowUpdate GetDesktopWindow
'Execute notepad.Exe
Pid = Shell("c:windowsnotepad.exe", vbNormalFocus)
If Pid = 0 Then MsgBox "Error starting the app"
'retrieve the handle of the window
mWnd = InstanceToWnd(Pid)
'Set the notepad's parent
SetParent mWnd, Me.hwnd
'Put the focus on notepad
Putfocus mWnd
'Unlock windowupdate
LockWindowUpdate False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Unload notepad
DestroyWindow mWnd
'End this program
TerminateProcess GetCurrentProcess, 0
End Sub
Avatar
teddy
OK, je vais essayer ce code. Merci pour la suggestion.

En fait, j'ai une fenêtre Internet Explorer affichant la page d'accueil
(login) d'une application intranet à maintenir en arrière-plan et une autre
de la même appli à maintenir en avant-plan car elle contient un formulaire à
remplir.

La fenêtre en arrière plan a un défaut dans un script JavaScript ce qui la
fait passer en avant-plan de façon intempestive, c'est très pénible.

Je cherche donc par programme à empêcher ce "phénomène".

Teddy




"Vincent Guichard" a écrit dans le message de
news: 45e7df85$0$27415$
teddy a écrit :
Me.SetFocus donne le focus à la fenêtre VB6 courante.
Moi, ce que je cherche, c'est de maintenir le focus sur une fenêtre
externe (IE6 par exemple) à mon appli VB6.

Ted



Bonjour,

D'après ma doc d'API, il faut que la fenêtre à laquelle tu veux donner le
focus soit associée au thread appelant. Ci-dessous l'exemple que donne
l'API Guide.

Vincent Guichard

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
(ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As
Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long,
ByVal hWndNewParent As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd
As Long, lpdwProcessId As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal
wCmd As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As
Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long)
As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess
As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function Putfocus Lib "user32" Alias "SetFocus" (ByVal
hwnd As Long) As Long
Const GW_HWNDNEXT = 2
Dim mWnd As Long
Function InstanceToWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
'Find the first window
test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
Do While test_hwnd <> 0
'Check if the window isn't a child
If GetParent(test_hwnd) = 0 Then
'Get the window's thread
test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
If test_pid = target_pid Then
InstanceToWnd = test_hwnd
Exit Do
End If
End If
'retrieve the next window
test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
Loop
End Function
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail:
Dim Pid As Long
'Lock the window update
LockWindowUpdate GetDesktopWindow
'Execute notepad.Exe
Pid = Shell("c:windowsnotepad.exe", vbNormalFocus)
If Pid = 0 Then MsgBox "Error starting the app"
'retrieve the handle of the window
mWnd = InstanceToWnd(Pid)
'Set the notepad's parent
SetParent mWnd, Me.hwnd
'Put the focus on notepad
Putfocus mWnd
'Unlock windowupdate
LockWindowUpdate False
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Unload notepad
DestroyWindow mWnd
'End this program
TerminateProcess GetCurrentProcess, 0
End Sub