VII. Exemples▲
VII-A. Présentation▲
Nous allons dans cet exemple illustrer l'utilisation d'un Hook souris
local, d'un Hook souris global et d'un filtre de messages.
Une interface nous permettra de mettre en évidence le fonctionnement
de chaque type de Hook et nous créerons également un "trou de souris"
pour chaque type de Hook (par "trou de souris", j'entends un zone
qui empêche la détection de l'activité de la souris).
VII-B. Conception▲
Les classes gérant nos 3 types de Hook souris (je considère ici que le Prefilter peut être vu comme une sorte de Hook), devrons respecter les règles suivantes :
- Le Hook est posé le plus tard possible,
- Le Hook est retiré le plus tôt possible.
Pour ce faire, nous gérerons des "abonnements" à un événement
"Activité de la souris" :
le Hook sera posé au premier abonnement et
retiré lors du dernier désabonnement à l'événement.
Comme on ne peut forcer l'utilisation du désabonnement à cet événement
dans les objets qui utiliseront le Hook, nous imposerons à ces objets
d'implémenter un événement informant le Hook de leur destruction.
Nos classes de gestion de Hook devront également lors de leur
destruction effectuer le nettoyage nécessaire, à savoir, au minimum
retirer le Hook (ou le Filtre) posé.
Dans un but d'illustration, ces classes mettront également à disposition
un événement de Log qui permettra de tracer leur fonctionnement.
Les trois types de Hook ayant donc ces fonctions communes, nous allons
créer une classe de base qui gérera celles-ci.
Les Hook à base d'API nécessitant un ensemble de déclarations communes
(dont les API !), nous utiliserons également une classe de base qui
héritera de la classe précédente et mettra ces déclarations à disposition.
Pour finir, chacune des classes de gestion de l'un des types de Hook
sera un singleton afin d'éviter, pour une même application,
la création de plusieurs Hooks de même type.
C'est en effet complètement inutile dans notre exemple vu le mode
de fonctionnement par abonnement à l'événement d'activité souris :
un objet devant récupérer l'activité de la souris pourra tout
simplement s'abonner à l'événement sans créer une nouvelle instance
de la classe gestion du Hook.
VII-C. Développement▲
VII-C-1. Création de la classe de base des Hooks souris▲
Notre classe de base par définition n'est pas instanciable
(MustInherit Class).
Elle effectue les fonctions suivantes :
1) Déclarations communes aux différents types de Hooks
C'est l'ensemble des constantes décrivant les messages de la souris.
2) Procédures communes aux différents types de Hooks
Tout Hook, quel que soit son type, doit être posé et retiré.
Nous forçons donc les classes qui héritent de notre classe de base
à mettre à disposition ces procédures (en utilisant des
Protected MustOverride Sub).
3) Gestion des abonnements
Notre classe met à disposition un événement MouseActivity qui
sera levé à chaque détection de l'activité de la souris.
Pour gérer les abonnements à cet événement, nous utilisons
un événement personnalisé (Custom Event) qui nous permet de
respecter les règles de pose du Hook au plus tard et de
retirement au plus tôt.
L'abonnement à cet événement n'est autorisé que pour les objets
implémentant IComponent car ceux-ci lèvent un événement Disposed
lors de leur destruction (en l'absence de surcharge de la
méthode Dispose).
La destruction d'un objet abonné à l'événement entraîne
son désabonnement d'office.
4) Nettoyage
C'est l'implémentation de IDisposable et la gestion du
retirement du Hook lors de la destruction de l'instance.
Option
Explicit
On
Option
Strict
On
Imports
System.Windows.Forms
Public
Delegate
Sub
MouseActivityEventHandler
(
ByVal
e As
MouseEventArgs)
Public
Enum
eMouseHookType
LocalMouseHook =
1
GlobalMouseHook =
2
PreFilterMouseHook =
3
End
Enum
Public
MustInherit
Class
CLFWAddHookBase
Implements
IDisposable
#Region
"Dispose"
Public
Overloads
Sub
Dispose
(
) Implements
IDisposable.Dispose
Dispose
(
True
)
GC.SuppressFinalize
(
Me
)
End
Sub
Private
Disposed As
Boolean
=
False
Private
Overloads
Sub
Dispose
(
ByVal
disposing As
Boolean
)
If
Not
Me
.Disposed
Then
If
disposing Then
' Pas de ressource managé à disposer
End
If
RaiseEvent
MouseLog
(
"Dispose de la class Hook"
)
StopHookingInternal
(
)
End
If
Disposed =
True
GC.SuppressFinalize
(
Me
)
End
Sub
Protected
Overrides
Sub
Finalize
(
)
Dispose
(
False
)
MyBase
.Finalize
(
)
End
Sub
#End
Region
#Region
"Declaration constantes"
' Type de messages souris
' -- Déplacement
Protected
Const
WM_MOUSEMOVE As
Integer
=
&H200
' -- Bouton gauche
' ---- Zone cliente
Protected
Const
WM_LBUTTONDOWN As
Integer
=
&H201
Protected
Const
WM_LBUTTONUP As
Integer
=
&H202
Protected
Const
WM_LBUTTONDBLCLK As
Integer
=
&H203
' ---- Zone non cliente
Protected
Const
WM_NCLBUTTONDBLCLK As
Integer
=
&HA3
Protected
Const
WM_NCLBUTTONDOWN As
Integer
=
&HA1
Protected
Const
WM_NCLBUTTONUP As
Integer
=
&HA2
' -- Bouton droit
' ---- Zone cliente
Protected
Const
WM_RBUTTONDOWN As
Integer
=
&H204
Protected
Const
WM_RBUTTONUP As
Integer
=
&H205
Protected
Const
WM_RBUTTONDBLCLK As
Integer
=
&H206
' ---- Zone non cliente
Protected
Const
WM_NCRBUTTONDBLCLK As
Integer
=
&HA6
Protected
Const
WM_NCRBUTTONDOWN As
Integer
=
&HA4
Protected
Const
WM_NCRBUTTONUP As
Integer
=
&HA5
' -- Bouton central
' ---- Zone cliente
Protected
Const
WM_MBUTTONDOWN As
Integer
=
&H207
Protected
Const
WM_MBUTTONUP As
Integer
=
&H208
Protected
Const
WM_MBUTTONDBLCLK As
Integer
=
&H209
' ---- Zone non cliente
Protected
Const
WM_NCMBUTTONDBLCLK As
Integer
=
&HA9
Protected
Const
WM_NCMBUTTONDOWN As
Integer
=
&HA7
Protected
Const
WM_NCMBUTTONUP As
Integer
=
&HA8
' -- X Bouton
' ---- Zone cliente
Protected
Const
WM_XBUTTONDOWN As
Integer
=
&H20B
Protected
Const
WM_XBUTTONUP As
Integer
=
&H20C
Protected
Const
WM_XBUTTONDBLCLK As
Integer
=
&H20D
' ---- Zone non cliente
Protected
Const
WM_NCXBUTTONDOWN As
Integer
=
&HAB
Protected
Const
WM_NCXBUTTONUP As
Integer
=
&HAC
Protected
Const
WM_NCXBUTTONDBLCLK As
Integer
=
&HAD
' Molette
Protected
Const
WM_MOUSEWHEEL As
Integer
=
&H20A
Protected
Const
WM_MOUSEHWHEEL As
Integer
=
&H20E
#End
Region
#Region
"Activité souris"
Protected
MouseActivityEventHandlerList As
New
ArrayList
Public
Custom
Event
MouseActivity As
MouseActivityEventHandler
AddHandler
(
ByVal
value As
MouseActivityEventHandler)
If
Not
MouseActivityEventHandlerList.Contains
(
value) Then
' Gestion des objets de type IComponent disposant de l'event Disposed
If
GetType
(
System.ComponentModel.IComponent
).IsAssignableFrom
(
_
value.Target.GetType
) Then
Dim
c As
System.ComponentModel.IComponent
=
CType
(
value.Target
, _
System.ComponentModel.IComponent
)
AddHandler
c.Disposed
, AddressOf
RemoveDisposedComponent
RaiseEvent
MouseLog
(
"Type IComponent détecté pour : "
&
_
value.Target.GetHashCode
)
End
If
AddMouseActivityEventHandler
(
value)
End
If
End
AddHandler
RemoveHandler
(
ByVal
value As
MouseActivityEventHandler)
If
MouseActivityEventHandlerList.Contains
(
value) Then
RemoveMouseActivityEventHandler
(
value)
End
If
End
RemoveHandler
RaiseEvent
(
ByVal
e As
System.Windows.Forms.MouseEventArgs
)
For
i As
Integer
=
0
To
MouseActivityEventHandlerList.Count
-
1
Dim
handler As
MouseActivityEventHandler =
_
CType
(
MouseActivityEventHandlerList
(
i), MouseActivityEventHandler)
If
handler IsNot
Nothing
Then
handler.Invoke
(
e)
End
If
Next
End
RaiseEvent
End
Event
Private
Sub
RemoveDisposedComponent
(
ByVal
sender As
Object
, ByVal
e As
EventArgs)
For
i As
Integer
=
0
To
MouseActivityEventHandlerList.Count
-
1
If
CType
(
MouseActivityEventHandlerList
(
i), MouseActivityEventHandler).Target
_
Is
sender Then
RemoveMouseActivityEventHandler
(
CType
(
MouseActivityEventHandlerList
(
i), _
MouseActivityEventHandler))
Exit
Sub
End
If
Next
End
Sub
Private
Sub
AddMouseActivityEventHandler
(
ByVal
value As
MouseActivityEventHandler)
' Premiére demande d'abonnement, on positionne le hook
If
MouseActivityEventHandlerList.Count
=
0
Then
RaiseEvent
MouseLog
(
"Start demandé par : "
&
value.Target.GetHashCode
)
StartHookingInternal
(
)
End
If
RaiseEvent
MouseLog
(
"Abonnement pour : "
&
value.Target.GetHashCode
)
MouseActivityEventHandlerList.Add
(
value)
End
Sub
Private
Sub
RemoveMouseActivityEventHandler
(
ByVal
value As
MouseActivityEventHandler)
' Derniére demande de désabonnement, on supprime le hook
MouseActivityEventHandlerList.Remove
(
value)
RaiseEvent
MouseLog
(
"Désabonnement pour : "
&
value.Target.GetHashCode
)
If
MouseActivityEventHandlerList.Count
=
0
Then
RaiseEvent
MouseLog
(
"Stop demandé par : "
&
value.Target.GetHashCode
)
StopHookingInternal
(
)
End
If
End
Sub
Protected
Sub
OnMouseActivity
(
ByVal
e As
MouseEventArgs)
RaiseEvent
MouseActivity
(
e)
End
Sub
#End
Region
#Region
"Log"
Public
Event
MouseLog
(
ByVal
Text
As
String
)
Protected
Sub
OnMouseLog
(
ByVal
Text
As
String
)
RaiseEvent
MouseLog
(
Text
)
End
Sub
#End
Region
#Region
"Gestion du Hook"
Protected
MustOverride
Sub
StartHookingInternal
(
)
Protected
MustOverride
Sub
StopHookingInternal
(
)
#End
Region
End
Class
VII-C-2. Création de la classe de base des Hooks souris via API▲
Cette classe de base hérite de la classe de base des Hooks souris.
Elle est également par définition non instanciable (MustInherit Class).
Son seul but est de mutualiser l'ensemble des déclarations communes
aux types de Hook souris via API : déclaration des API ainsi que des
structures et constantes qu'elles utilisent.
Option
Explicit
On
Option
Strict
On
Imports
System.Runtime.InteropServices
Imports
System.Windows.Forms
Public
MustInherit
Class
CLFWAddMouseHookBase
Inherits
CLFWAddHookBase
Public
Delegate
Function
HookProc
(
ByVal
nCode As
Integer
, _
ByVal
wParam As
Integer
, ByVal
lParam As
IntPtr) As
Integer
Protected
hMouseHook As
Integer
Protected
MouseHookProcedure As
HookProc
<
DllImport
(
"user32"
)>
_
Public
Shared
Function
CallNextHookEx
(
ByVal
hhk As
Integer
, _
ByVal
nCode As
Integer
, ByVal
wParam As
Integer
, ByVal
lParam As
IntPtr) As
Integer
End
Function
<
DllImport
(
"user32"
)>
_
Public
Shared
Function
SetWindowsHookEx
(
ByVal
idHook As
Integer
, _
ByVal
lpfn As
HookProc, ByVal
hMod As
IntPtr, ByVal
dwThreadId As
Integer
) As
Integer
End
Function
<
DllImport
(
"user32"
)>
_
Public
Shared
Function
UnhookWindowsHookEx
(
ByVal
hhk As
Integer
) As
Boolean
End
Function
<
DllImport
(
"kernel32"
)>
_
Public
Shared
Function
GetLastError
(
) As
Integer
End
Function
<
DllImport
(
"kernel32"
)>
_
Public
Shared
Function
GetCurrentThreadId
(
) As
Integer
End
Function
#Region
"Declaration constantes"
Protected
Const
HC_ACTION As
Integer
=
0
Protected
Const
HC_NOREMOVE As
Integer
=
3
' Type de Hooks souris
Protected
Const
WH_MOUSE As
Integer
=
7
Protected
Const
WH_MOUSE_LL As
Integer
=
14
#End
Region
#Region
"Structures"
<
StructLayout
(
LayoutKind.Sequential
)>
_
Protected
Class
PointMHS
Public
x As
Integer
Public
y As
Integer
End
Class
#End
Region
End
Class
VII-C-3. Création des classes de Hook souris▲
Il s'agit des classes permettant l'utilisation des 3 types de Hooks souris.
VII-C-3-a. Hook souris local▲
C'est une classe singleton qui hérite de la classe de base
des Hooks via API. Elle gère les spécificités d'un Hook local
quand à la pose et au retirement du Hook et surtout quand à
la procédure déléguée utilisée pour traiter le message
(notamment l'utilisation de la structure MOUSEHOOKSTRUCTEX).
Option
Explicit
On
Option
Strict
On
Imports
System.Runtime.InteropServices
Imports
System.Windows.Forms
Public
NotInheritable
Class
CLFWAddMouseHookLocal
Inherits
CLFWAddMouseHookBase
#Region
"Singleton"
Public
Shared
ReadOnly
Property
Instance
(
) As
CLFWAddMouseHookLocal
Get
Return
Internal.instance
End
Get
End
Property
Private
Class
Internal
Friend
Shared
ReadOnly
instance As
CLFWAddMouseHookLocal =
_
New
CLFWAddMouseHookLocal
End
Class
Private
Sub
New
(
)
End
Sub
#End
Region
#Region
"Structures"
<
StructLayout
(
LayoutKind.Sequential
)>
_
Private
Class
MOUSEHOOKSTRUCTEX
Public
pt As
PointMHS
Public
hwnd As
Integer
Public
wHitTestCode As
Integer
Public
dwExtraInfo As
Integer
Public
mouseData As
Integer
End
Class
#End
Region
Protected
Overrides
Sub
StartHookingInternal
(
)
' Evite le CallbackOnCollectedDelegate
' Lors du passage de délégués à du code non managé,
' ils doivent être maintenus actifs par l'application managée
' jusqu'à ce qu'il soit garanti qu'ils ne seront jamais appelés.
MouseHookProcedure =
New
HookProc
(
AddressOf
MouseHookProc)
hMouseHook =
SetWindowsHookEx
(
WH_MOUSE, MouseHookProcedure, _
IntPtr.Zero
, _
GetCurrentThreadId)
If
hMouseHook =
0
Then
MyBase
.OnMouseLog
(
"Echec de l'installation du hook : "
&
GetLastError
(
))
Else
MyBase
.OnMouseLog
(
"Start effectué - Thread = "
&
_
System.Threading.Thread.CurrentThread.ManagedThreadId
)
End
If
End
Sub
Protected
Overrides
Sub
StopHookingInternal
(
)
Dim
blnUH As
Boolean
=
True
blnUH =
UnhookWindowsHookEx
(
hMouseHook)
MyBase
.OnMouseLog
(
"Stop effectué"
)
End
Sub
Private
Function
MouseHookProc
(
ByVal
nCode As
Integer
, ByVal
wParam As
Integer
, _
ByVal
lParam As
IntPtr) As
Integer
If
nCode =
HC_ACTION Then
Dim
mbMouseButton As
MouseButtons =
MouseButtons.None
Dim
intClick As
Integer
Select
Case
wParam
Case
WM_LBUTTONDBLCLK, WM_NCLBUTTONDBLCLK
mbMouseButton =
MouseButtons.Left
intClick =
2
Case
WM_RBUTTONDBLCLK, WM_NCRBUTTONDBLCLK
mbMouseButton =
MouseButtons.Right
intClick =
2
Case
WM_LBUTTONDOWN, WM_NCLBUTTONDOWN
mbMouseButton =
MouseButtons.Left
intClick =
1
Case
WM_RBUTTONDOWN, WM_NCRBUTTONDOWN
mbMouseButton =
MouseButtons.Right
intClick =
1
End
Select
If
mbMouseButton <>
MouseButtons.None
Then
Dim
mhs As
MOUSEHOOKSTRUCTEX =
CType
(
Marshal.PtrToStructure
_
(
lParam, GetType
(
MOUSEHOOKSTRUCTEX)), MOUSEHOOKSTRUCTEX)
Dim
meaArgs As
New
MouseEventArgs
(
mbMouseButton, intClick, _
mhs.pt.x
, mhs.pt.y
, 0
)
' On ne léve l'event que si des abonnements existent
' il s'agit ici de gérer l'absence d'appel à StopHooking
If
MouseActivityEventHandlerList.Count
>
0
Then
MyBase
.OnMouseLog
(
"Event MouseActivity levé pour "
&
_
MouseActivityEventHandlerList.Count.ToString
&
" abonnements"
)
MyBase
.OnMouseActivity
(
meaArgs)
Else
MyBase
.OnMouseLog
(
"Event MouseActivity NON levé"
)
End
If
End
If
End
If
Return
CallNextHookEx
(
hMouseHook, nCode, wParam, lParam)
End
Function
End
Class
VII-C-3-b. Hook souris global▲
C'est une classe singleton qui hérite de la classe de base
des Hooks via API. Elle gère les spécificités d'un Hook Global
quand à la pose et au retirement du Hook et surtout quand à
la procédure déléguée utilisée pour traiter le message
(notamment l'utilisation de la structure MSLLHOOKSTRUCT
et l'absence de message de type NC).
Option
Explicit
On
Option
Strict
On
Imports
System.Runtime.InteropServices
Imports
System.Windows.Forms
Public
NotInheritable
Class
CLFWAddMouseHookGlobal
Inherits
CLFWAddMouseHookBase
#Region
"Singleton"
Public
Shared
ReadOnly
Property
Instance
(
) As
CLFWAddMouseHookGlobal
Get
Return
Internal.instance
End
Get
End
Property
Private
Class
Internal
Friend
Shared
ReadOnly
instance As
CLFWAddMouseHookGlobal =
_
New
CLFWAddMouseHookGlobal
End
Class
Private
Sub
New
(
)
End
Sub
#End
Region
#Region
"Structures"
<
StructLayout
(
LayoutKind.Sequential
)>
_
Private
Class
MSLLHOOKSTRUCT
Public
pt As
PointMHS
Public
mouseData As
Integer
Public
flags As
Integer
Public
time
As
Integer
Public
dwExtraInfo As
Integer
End
Class
#End
Region
Protected
Overrides
Sub
StartHookingInternal
(
)
' Evite le CallbackOnCollectedDelegate
' Lors du passage de délégués à du code non managé,
' ils doivent être maintenus actifs par l'application managée
' jusqu'à ce qu'il soit garanti qu'ils ne seront jamais appelés.
MouseHookProcedure =
New
HookProc
(
AddressOf
MouseHookProc)
hMouseHook =
SetWindowsHookEx
(
WH_MOUSE_LL, MouseHookProcedure, _
IntPtr.Zero
, 0
)
If
hMouseHook =
0
Then
MyBase
.OnMouseLog
(
"Echec de l'installation du hook : "
&
GetLastError
(
))
Else
MyBase
.OnMouseLog
(
"Start effectué"
)
End
If
End
Sub
Protected
Overrides
Sub
StopHookingInternal
(
)
Dim
blnUH As
Boolean
=
True
blnUH =
UnhookWindowsHookEx
(
hMouseHook)
MyBase
.OnMouseLog
(
"Stop effectué"
)
End
Sub
Private
Function
MouseHookProc
(
ByVal
nCode As
Integer
, ByVal
wParam As
Integer
, _
ByVal
lParam As
IntPtr) As
Integer
If
nCode =
HC_ACTION Then
Dim
mbMouseButton As
MouseButtons =
MouseButtons.None
Select
Case
wParam
Case
WM_LBUTTONDOWN
mbMouseButton =
MouseButtons.Left
Case
WM_RBUTTONDOWN
mbMouseButton =
MouseButtons.Right
End
Select
If
mbMouseButton <>
MouseButtons.None
Then
Dim
mhs As
MSLLHOOKSTRUCT =
CType
(
Marshal.PtrToStructure
_
(
lParam, GetType
(
MSLLHOOKSTRUCT)), MSLLHOOKSTRUCT)
Dim
meaArgs As
New
MouseEventArgs
(
mbMouseButton, 1
, mhs.pt.x
, _
mhs.pt.y
, 0
)
' On ne léve l'event que si des abonnements existent
' il s'agit ici de gérer l'absence d'appel à StopHooking
If
MouseActivityEventHandlerList.Count
>
0
Then
MyBase
.OnMouseLog
(
"Event MouseActivity levé pour "
&
_
MouseActivityEventHandlerList.Count.ToString
&
" abonnements"
)
MyBase
.OnMouseActivity
(
meaArgs)
Else
MyBase
.OnMouseLog
(
"Event MouseActivity NON levé"
)
End
If
End
If
End
If
Return
CallNextHookEx
(
hMouseHook, nCode, wParam, lParam)
End
Function
End
Class
VII-C-3-c. "Hook" via PreFilter▲
C'est une classe singleton qui hérite de la classe de base
des Hooks souris (car elle n'a aucun besoin des déclarations
nécessaires à l'utilisation des API).
Option
Explicit
On
Option
Strict
On
Imports
System.Windows.Forms
Public
NotInheritable
Class
CLFWAddPreFilter
Inherits
CLFWAddHookBase
Implements
Windows.Forms.IMessageFilter
#Region
"Singleton"
Public
Shared
ReadOnly
Property
Instance
(
) As
CLFWAddPreFilter
Get
Return
Internal.instance
End
Get
End
Property
Private
Class
Internal
Friend
Shared
ReadOnly
instance As
CLFWAddPreFilter =
New
CLFWAddPreFilter
End
Class
Private
Sub
New
(
)
End
Sub
#End
Region
Public
Function
PreFilterMessage
(
ByRef
m As
System.Windows.Forms.Message
) _
As
Boolean
Implements
System.Windows.Forms.IMessageFilter.PreFilterMessage
Dim
mbMouseButton As
MouseButtons =
MouseButtons.None
Dim
intClick As
Integer
Select
Case
m.Msg
Case
WM_LBUTTONDBLCLK, WM_NCLBUTTONDBLCLK
mbMouseButton =
MouseButtons.Left
intClick =
2
Case
WM_RBUTTONDBLCLK, WM_NCRBUTTONDBLCLK
mbMouseButton =
MouseButtons.Right
intClick =
2
Case
WM_LBUTTONDOWN, WM_NCLBUTTONDOWN
mbMouseButton =
MouseButtons.Left
intClick =
1
Case
WM_RBUTTONDOWN, WM_NCRBUTTONDOWN
mbMouseButton =
MouseButtons.Right
intClick =
1
End
Select
If
mbMouseButton <>
MouseButtons.None
Then
Dim
meaArgs As
New
MouseEventArgs
(
mbMouseButton, intClick, _
Control.MousePosition.X
, Control.MousePosition.Y
, 0
)
MyBase
.OnMouseLog
(
"Event MouseActivity levé pour "
&
_
MouseActivityEventHandlerList.Count.ToString
&
" abonnements"
)
MyBase
.OnMouseActivity
(
meaArgs)
End
If
Return
False
End
Function
Protected
Overrides
Sub
StartHookingInternal
(
)
Application.AddMessageFilter
(
Me
)
MyBase
.OnMouseLog
(
"Start effectué"
)
End
Sub
Protected
Overrides
Sub
StopHookingInternal
(
)
Application.RemoveMessageFilter
(
Me
)
MyBase
.OnMouseLog
(
"Stop effectué"
)
End
Sub
End
Class
VII-D. Utilisation▲
Nous allons maintenant utiliser ces classes dans une petite application
qui met en évidence leur fonctionnement.
Je ne commenterais pas l'ensemble du code de cette application, mais :
Le source est disponible ici : UseMouseHooking.zip
Au démarrage, la form principale se décompose en 4 parties :
- Un cadre dédié au Prefilter,
- Un cadre dédié au Hook Local,
- Un cadre dédié au Hook Global,
- Un bouton [trou de souris].
Chaque cadre met à disposition :
- Un bouton [Actif/Inactif] qui permet de démarrer le Hook du type concerné et de tracer l'activité de la souris remontée par ce type de Hook,
- Une liste "Log" de l'activité de la souris détectée par ce type de Hook,
- Un bouton [Test] qui déclenche l'ouverture d'un formulaire permettant de valider la gestion des abonnements/désabonnements à ce Hook (la fermeture du formulaire entraîne le désabonnement de l'ensemble des HookButtons activés par exemple).
Le bouton [Trou de souris] déclenche l'ouverture d'un formulaire "Trou de souris" composé de trois MouseHoleControl, le MouseHoleControl étant un composant personnalisé qui pose un hook local, global ou via PreFilter en bloquant le message une fois celui-ci traité :
- Pas d'appel à CallNextHookEx pour le Hook Local et le Hook Global,
- Renvoi de true (message traité) dans le PreFilter.
Faites quelques tests est vous constaterez que :
- Lorsque l'on ouvre le formulaire "Trou de souris" avant d'installer un Hook Local (donc via les API), le Hook du formulaire principal fonctionne correctement lorsque l'on clique sur le trou de souris "Local Hole",
- Lorsque l'on ouvre le formulaire "Trou de souris" après avoir installer un Hook Local, le Hook du formulaire principal ne fonctionne pas lorsque l'on clique sur le trou de souris "Local Hole".
Le même comportement est observé pour le Hook Global.
Ceci est normal puisque les Hooks via API sont toujours installés
en début de chaîne.
- Lorsque l'on ouvre le formulaire "Trou de souris" avant d'installer un Prefilter, le PreFilter du formulaire principal ne fonctionne pas lorsque l'on clique sur le trou de souris "PreFilter Hole",
- Lorsque l'on ouvre le formulaire "Trou de souris" après avoir installer un Prefilter, le PreFilter du formulaire principal fonctionne correctement lorsque l'on clique sur le trou de souris "PreFilter Hole".
C'est également normal car les filtres de messages d'application sont utilisés dans l'ordre de leur positionnement.
VII-E. Utilisation dans le cadre d'un Popup▲
Cet exemple illustre l'utilisation du Prefilter dans le cadre de la gestion
de la fermeture d'un Popup.
Nous allons modifier la classe UltraBasicPopup présentée dans l'article précédent
Création d'un popup
pour que le Popup se ferme lors d'un clic sur un élément de l'application
(mais en dehors de la Region du Popup).
Nous ajoutons également la gestion de la désactivation du formulaire contenant le
Control ayant levé le Popup.
Option
Explicit
On
Option
Strict
On
Public
Class
UltraBasicPopup
Inherits
Button
#Region
"Constantes"
Private
Const
WS_EX_TOOLWINDOW As
Integer
=
&H80
Private
Const
SW_SHOWNOACTIVATE As
Integer
=
4
#End
Region
Protected
Overrides
ReadOnly
Property
CreateParams
(
) _
As
System.Windows.Forms.CreateParams
Get
Dim
p As
CreateParams =
MyBase
.CreateParams
p.ExStyle
=
WS_EX_TOOLWINDOW
p.Parent
=
IntPtr.Zero
Return
p
End
Get
End
Property
Private
Declare
Function
SetParent Lib
"user32"
(
_
ByVal
hWndChild As
IntPtr, _
ByVal
hWndNewParent As
IntPtr) As
Integer
Private
Declare
Function
ShowWindow Lib
"user32"
(
_
ByVal
hWnd As
IntPtr, _
ByVal
nCmdShow As
Integer
) As
Integer
Private
Declare
Function
DestroyWindow Lib
"user32.dll"
(
_
ByVal
hWnd As
IntPtr) As
Boolean
#Region
"declaration"
Private
cControlParent As
Control
Private
blnOpened As
Boolean
#End
Region
#Region
"Propriétés"
Public
ReadOnly
Property
Opened
(
) As
Boolean
Get
Return
blnOpened
End
Get
End
Property
#End
Region
Private
Sub
ClosePopupOnDeactivate
(
ByVal
sender As
Object
, ByVal
e As
EventArgs)
ClosePopup
(
)
End
Sub
Private
Sub
ClosePopup
(
)
Dim
f As
Form =
cControlParent.FindForm
RemoveHandler
f.Deactivate
, AddressOf
ClosePopupOnDeactivate
RemoveHandler
CLFWAddPreFilter.Instance.MouseActivity
, _
AddressOf
HPreFilterMouseActivityProc
DestroyWindow
(
MyBase
.Handle
)
blnOpened =
False
End
Sub
Private
Sub
OpenPopup
(
)
' Gestion de la désactivation de la form parente du control ayant
' créé le popup
Dim
f As
Form =
cControlParent.FindForm
AddHandler
f.Deactivate
, AddressOf
ClosePopupOnDeactivate
' Gestion du clic au sein de l'application
AddHandler
CLFWAddPreFilter.Instance.MouseActivity
, _
AddressOf
HPreFilterMouseActivityProc
SetParent
(
MyBase
.Handle
, IntPtr.Zero
)
' Affichage
ShowWindow
(
MyBase
.Handle
, SW_SHOWNOACTIVATE)
blnOpened =
True
End
Sub
Private
Sub
HPreFilterMouseActivityProc
(
ByVal
e As
MouseEventArgs)
If
(Not
Me
.Bounds.Contains
(
e.Location
)) Then
ClosePopup
(
)
End
If
End
Sub
Public
Sub
ShowPopup
(
ByVal
IControlParent As
Control)
cControlParent =
IControlParent
Me
.SetLocation
(
)
Me
.Size
=
New
Size
(
150
, 30
)
Me
.Region
=
New
Region
(
_
New
Rectangle
(
3
, 3
, Me
.Size.Width
-
6
, Me
.Size.Height
-
6
))
Me
.Text
=
"Youpi quel beau popup !"
Me
.OpenPopup
(
)
End
Sub
Public
Sub
HidePopup
(
)
Me
.ClosePopup
(
)
End
Sub
Private
Sub
SetLocation
(
)
Dim
rParent As
Rectangle =
_
Me
.cControlParent.RectangleToScreen
(
Me
.cControlParent.ClientRectangle
)
Dim
ptLocation As
New
Point
(
_
rParent.X
+
rParent.Width
+
10
, _
rParent.Y
+
rParent.Height
+
10
)
Me
.Location
=
ptLocation
End
Sub
Private
cColor1 As
Color =
Color.Transparent
Private
cColor2 As
Color =
Color.Red
Protected
Overrides
Sub
OnClick
(
_
ByVal
e As
EventArgs)
MyBase
.OnClick
(
e)
Dim
f As
Form =
cControlParent.FindForm
If
f Is
Nothing
Then
Exit
Sub
Dim
c As
Color =
f.BackColor
If
c =
cColor1 Or
cColor1 =
Color.Transparent
Then
cColor1 =
f.BackColor
f.BackColor
=
cColor2
Else
f.BackColor
=
cColor1
End
If
End
Sub
End
Class
La source complète de l'exemple est disponible ici : UltraBasicPopupWithPreFilter.zip