Création de l'événement MouseWheel complètement dans Microsoft Access
AVERTISSEMENT : Si possible, vous devrez utiliser la méthode répertoriée dans la section « Création de l'événement MouseWheel à l'aide d'une DLL ActiveX de Visual Basic » figurant auparavant dans cet article. Vous ne pouvez utiliser la méthode présentée dans cette section que dans une situation où les utilisateurs de votre application ne chargeront pas Visual Basic Editor dans Microsoft Access, par exemple une application d'exécution de Microsoft Access. Si vous implémentez cette solution et vos utilisateurs ouvrent Visual Basic Editor, le code de cette section entraînera le bloquage de Microsoft Access. En outre, vous devez quitter et redémarrer Microsoft Access avant de tester ce code si vous avez chargé au moins une fois Visual Basic Editor pendant la session Microsoft Access. Microsoft vous recommande fortement d'enregistrer souvent votre travail et de garder des sauvegardes actualisées de votre base de données si vous utilisez cette approche.
L'approche présentée dans cette section indique comment faire pour utiliser un module de classe personnalisé en vue de créer un événement personnalisé nommé MouseWheelque vous pouvez utiliser dans vos formulaires pour détecter lorsque l'utilisateur a déplacé la roulette de la souris. Cet événement personnalisé expose un argument Cancel que vous pouvez utiliser pour empêcher le message relatif à la roulette de la roulette de la souris d'être intercepté par Microsoft Access, empêchant ainsi le défilement des enregistrements dans le formulaire.
Pour créer les procédures personnalisées, procédez comme suit : 1. ATTENTION : Si vous suivez la procédure donnée dans cet exemple, vous modifiez la base de donnée exemple Comptoirs.mdb. Vous pouvez vouloir sauvegarder le fichier Comptoirs.mdb et effectuer cette procédure sur une copie de la base de données.
2. Démarrez Microsoft Access.
3. Ouvrez la base de données exemple Comptoirs.mdb.
4. Dans le menu Insertion, cliquez sur Module pour créer un nouveau module dans Visual Basic Editor.
5. Ajoutez le code suivant au module :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
| Option Compare Database
Option Explicit
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = -4
Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long
Public CMouse As CMouseWheel
Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'Look at the message passed to the window. If it is
'a mouse wheel message, call the FireMouseWheel procedure
'in the CMouseWheel class, which in turn raises the MouseWheel
'event. If the Cancel argument in the form event procedure is
'set to False, then we process the message normally, otherwise
'we ignore it. If the message is something other than the mouse
'wheel, then process it normally
Select Case uMsg
Case WM_MouseWheel
CMouse.FireMouseWheel
If CMouse.MouseWheelCancel = False Then
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End If
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Select
End Function |
6. Dans le menu Fichier, cliquez sur Enregistrer <nom du projet>. Enregistrez le module sous basSubClassWindow.
7. Dans le menu Insertion, cliquez sur Module de classe.
8. Ajoutez le code suivant au module de classe :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
| Option Compare Database
Option Explicit
Private frm As Access.Form
Private intCancel As Integer
Public Event MouseWheel(Cancel As Integer)
Public Property Set Form(frmIn As Access.Form)
'Define Property procedure for the class which
'allows us to set the Form object we are
'using with it. This property is set from the
'form class module.
Set frm = frmIn
End Property
Public Property Get MouseWheelCancel() As Integer
'Define Property procedure for the class which
'allows us to retrieve whether or not the Form
'event procedure canceled the MouseWheel event.
'This property is retrieved by the WindowProc
'function in the standard basSubClassWindow
'module.
MouseWheelCancel = intCancel
End Property
Public Sub SubClassHookForm()
'Called from the form's OnOpen or OnLoad
'event. This procedure is what "hooks" or
'subclasses the form window. If you hook the
'the form window, you must unhook it when completed
'or Access will crash.
lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
Set CMouse = Me
End Sub
Public Sub SubClassUnHookForm()
'Called from the form's OnClose event.
'This procedure must be called to unhook the
'form window if the SubClassHookForm procedure
'has previously been called. Otherwise, Access will
'crash.
Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Public Sub FireMouseWheel()
'Called from the WindowProc function in the
'basSubClassWindow module. Used to raise the
'MouseWheel event when the WindowProc function
'intercepts a mouse wheel message.
RaiseEvent MouseWheel(intCancel)
End Sub |
9. Dans le menu Fichier, cliquez sur Enregistrer <nom du projet>. Enregistrez le module de classe sous CMouseWheel.
10. Ouvrez le formulaire Clients en mode Création.
11. Dans le menu Affichage, cliquez sur Code pour afficher le module de classe du formulaire.
12. Ajoutez le code suivant au module de classe du formulaire :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
| Option Compare Database
Option Explicit
Private WithEvents clsMouseWheel As MouseWheel.CMouseWheel
Private Sub Form_Load()
Set clsMouseWheel = New MouseWheel.CMouseWheel
Set clsMouseWheel.Form = Me
clsMouseWheel.SubClassHookForm
End Sub
Private Sub Form_Close()
clsMouseWheel.SubClassUnHookForm
Set clsMouseWheel.Form = Nothing
Set clsMouseWheel = Nothing
End Sub
Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
MsgBox "You cannot use the mouse wheel to scroll records."
Cancel = True
End Sub |
13. Dans le menu Fichier, cliquez sur Fermer et retourner à Microsoft Access.
14. Enregistrez le formulaire, puis fermez-le.
REMARQUE : N'ouvrez pas le formulaire en mode Formulaire pour le moment. Sinon, Microsoft Access cessera de répondre car Visual Basic Editor a été chargé.
15. Quittez Microsoft Access.
16. Redémarrez Microsoft Access, puis ouvrez la base de données exemple Comptoirs.mdb.
17. Ouvrez le formulaire Clients en mode Formulaire.
18. Déplacez la roulette de la souris.
Pb Molette de souris + Sous-Frm
Répondre avec citation
Partager