Integration automatique de la roulette/molette de la souris dans vos applis

Soyez le premier à donner votre avis sur cette source.

Vue 7 962 fois - Téléchargée 1 333 fois

Télécharger le projet
Commenter

Description

'je dois de dire un merci aux personnes ci-dessous:
'Daetips pour sa source http://www.vbfrance.com/codes/MOUSE-WHEEL-EVENTS-EVENEMENTS-MIDDLE_MOUSE_DOWN-MIDDLE_MOUSE_UP-MIDDLE_MOUSE_DOUBLE_CLICK-DLL_32546.aspx
'Philippe734 qui est ma reference vbfrance sur le sujet avec sa source de reference http://www.vbfrance.com/codes/UTILISATION-MOLETTE-ROULETTE-SOURIS_25201.aspx
'EBArtSoft et sa source http://www.vbfrance.com/codes/UTILISER-ROULETTE-DANS-VB6-IDE-ADDIN_21802.aspx

'Ca fait 2 Jours depuis le 11/2 que je me plonge pour la premiere fois dans le subclassing dont j'ai toujours entendu parler dans ce forum et reservé aux initiés
'Au début je voulais juste faire marcher la molette dans mes datagrid et hop voila je me suis retrouve dans un monde magique dont je me demande encore comment j'ai pu m'en passer.
Le problème en lui même est déjà connu et a eu des solutions diverses interessantes pour la plupart mais mon approche est originale, intuitive et simple comme dab.

'Le concept de cet OCX est 100% de moi, et il offre un niveau de souplesse un petit poil au dessus sur la source géniale de Daetips
'Il est autonome et n'a pas besoin d'utiliser le génial fichier Wheel.tlb d'EBArtSoft
'Pas besoin de charger quoi que ce soit du registre, le pas de la roulette est un propriété du contrôle.

'Il suffit de déposer ce contrôle ds votre form et hop les evenements de la molette sont a votre portée.

Note très importante:
--------------------
Il est important de préciser que le but premier de ce controle est d'intercepter tous les mouvements de la molette et de le renvoyer au Hwnd demandeur. La source de Daetips va essayer de traiter le scroll sur les Hwnd demandeurs, ce qui n'est pas le but que je recherche. Pourquoi? parce que je voudrais pouvoir faire interagir la molette sur un objet datagrid (par exemple) en decidant sur quel conteneur je voudrais intercepter les actions de la molette. les cas de figures sont tellement variés que j'ai besoin de traiter les actions de la molette par moi-même, exemple comment je veux que ce comporte la molette pour 2 datagrids dans un même conteneur.
Il existe aussi un autre cas de figure (Le cas pour lequel j'ai été amené absolument à me pencher sur ce problème, vu que c'est le point central de l'affichage de mes listes dans toutes mes applis), ou ce composant se trouve sur un Usercontrol en meme temps qu'un datagrid. je voudrais intercepter les mouvements de la roulette sur le Form Conteneur de cet Usercontrol et j'ai besoin de dire à l'objet sur quel Hwnd je veux qu'il intercepte les mouvements de la molette, en plus les imbrications de usercontrol peuvent ordre à plus de 2 niveaux.

Le controle intercepte les mouvements de la roulette sur le form demandeur, mais va neanmoins préciser si l'action est contenu dans la fenetre. On pourra de ce fait décider de le traiter ou pas. En plus on peut demander a l'objet de stopper la capture de la molette dur le demandeur lorsque le focus est hors de la fenetre.
L'exemple ci-dessous illustre une gestion de ce controle.

Source / Exemple : 


Option Explicit
Private moRst As ADODB.Recordset

Private Sub Command1_Click()
    FormB.Show
End Sub

Private Sub SNA_Wheel1_WheelAction(ByVal peWheelAction As Prj_SNAWheel.EnumWheelAction, ByVal plScrollLines As Variant, ByVal pbFocusIn As Boolean, pbWheelOff As Boolean)
    If pbFocusIn Then
        Select Case peWheelAction
            Case wa_WheelDown:
            Case wa_WheelUP:
            Case wa_WheelDoubleClick:
            Case wa_WheelMove: If pbFocusIn Then DataGrid1.Scroll 0, plScrollLines
        End Select
    Else
        'Je detecte une action de la molette hors de la fenetre, je demande d'y arreter la capture
        pbWheelOff = True
        Debug.Print "WheelOff on Datagrid"
    End If
End Sub

Private Sub Form_Activate()
    'Je suis activé, alors je fais la demande de capture de la molette
    With SNA_Wheel1
        .hWnd = Me.hWnd
        Debug.Print "Activate DataGrid"
    End With
End Sub

Private Sub Form_Load()
    Set DataGrid1.DataSource = moRst
End Sub

Private Sub Form_Initialize()
    Set moRst = New ADODB.Recordset
    With moRst
        .CursorLocation = adUseClient
        .Open "Select * From [Feuil1$]", _
            "driver={Microsoft Excel Driver (*.xls)};DriverId=790;ReadOnly=0;FirstRowHasNames=1;DBQ=" & App.Path & "\Classeur1.xls", _
            adOpenStatic, _
            adLockReadOnly
    End With
End Sub

Private Sub Form_Terminate()
    If moRst.State = adStateOpen Then moRst.Close
    Set moRst = Nothing
End Sub

Conclusion :


Je suis tenté de dire qu'il n'existe pas de bug. En effet le developpeur a tous les moyens d'orienter la capture de la molette sur l'objet de son choix.

Laissons voir les tests, retournez moi les erreurs.

A+
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
8 août 2010 à 22:38
En gardant l'idée du composant + la source géniale de Renf et la proposition de Philippe734, en définitive j'ai réécris mon composant comme ci-dessous:

Classe ClsWheel
---------------
Option Explicit
Implements ISubclasser
Private mtWin1 As SubClassedWindow
Public Event WheelAction(ByVal peWheelAction As Long, ByVal plSens As Long)

Public Sub Init(ByVal plHwnd As Long)
InitiateSubClassing mtWin1, Me, plHwnd, True
End Sub

Private Function ISubclasser_WindowProc(ByVal hWnd As Long, ByVal uMsg As MessageConstants, ByVal wParam As Long, ByVal lParam As Long) As Long
If hWnd <> mtWin1.hWnd Then Exit Function

ISubclasser_WindowProc = CallOldProc(mtWin1, hWnd, uMsg, wParam, lParam)
Select Case uMsg
Case WM_MBUTTONDOWN: RaiseEvent WheelAction(wa_WheelDown, 0)
Case WM_MBUTTONUP: RaiseEvent WheelAction(wa_WheelUP, 0)
Case WM_MBUTTONDBLCLK: RaiseEvent WheelAction(wa_WheelDoubleClick, 0)
Case WM_MOUSEWHEEL:
'wParam indique le mouvement de la molette
'pour wParam négatif, c'est pour voir en haut
'positif, on descend le curseur du scrollbar
RaiseEvent WheelAction(wa_WheelMove, IIf(wParam < 0, 1, -1))
End Select
End Function

Private Sub Class_Terminate()
TerminateSubClassing mtWin1
End Sub

Usercontrol SNA_Wheel
---------------------
Option Explicit

'Valeurs de propriétés par défaut:
Private Const m_def_ScrollLines = 3

Public Enum EnumWheelAction
wa_WheelDown = 1
wa_WheelUP = 2
wa_WheelDoubleClick = 3
wa_WheelMove = 4
End Enum

Private mlScrollLines As Long
Private WithEvents moClsWheel As ClsWheel

'Déclarations d'événements:
Public Event WheelAction(ByVal peWheelAction As EnumWheelAction, ByVal plScrollLines)

'Activation de la capture de la molette sur une fenetre, par défaut celle du conteneur
Public Sub Activate(Optional ByVal plHwnd As Long = 0)
If plHwnd = 0 Then moClsWheel.Init UserControl.Parent.hWnd Else moClsWheel.Init plHwnd
End Sub

'ATTENTION! NE SUPPRIMEZ PAS OU NE MODIFIEZ PAS LES LIGNES COMMENTÉES SUIVANTES!
'MemberInfo=8,0,0,3
Public Property Get ScrollLines() As Long
ScrollLines = mlScrollLines
End Property

Public Property Let ScrollLines(ByVal New_ScrollLines As Long)
mlScrollLines = New_ScrollLines
If Not Ambient.UserMode Then PropertyChanged "ScrollLines"
End Property

Private Sub moClsWheel_WheelAction(ByVal peWheelAction As EnumWheelAction, ByVal plSens As Long)
Select Case plSens
Case -1: RaiseEvent WheelAction(peWheelAction, -mlScrollLines)
Case 1: RaiseEvent WheelAction(peWheelAction, mlScrollLines)
Case 0: RaiseEvent WheelAction(peWheelAction, 0)
End Select
End Sub

'Initialiser les propriétés pour le contrôle utilisateur
Private Sub UserControl_InitProperties()
mlScrollLines = m_def_ScrollLines
End Sub

'Charger les valeurs des propriétés à partir du stockage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
mlScrollLines = PropBag.ReadProperty("ScrollLines", m_def_ScrollLines)
End Sub

'Écrire les valeurs des propriétés dans le stockage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ScrollLines", mlScrollLines, m_def_ScrollLines)
End Sub

Private Sub UserControl_Initialize()
Set moClsWheel = New ClsWheel
End Sub

Private Sub UserControl_Terminate()
Set moClsWheel = Nothing
End Sub

Il suffit de déposer le composant SNA_Wheel sur un form, qu'on activera sur l'évènement Load.
Private Sub Form_Load()
SNA_Wheel1.Activate
End Sub

Les evènements seront gérés comme ci-dessous.
Private Sub SNA_Wheel1_WheelAction(ByVal peWheelAction As Prj_SNAWheel.EnumWheelAction, ByVal plScrollLines As Variant)
Select Case peWheelAction
Case wa_WheelDoubleClick: Label1.Caption = "Wheel DoubleClick"
Case wa_WheelDown: Label1.Caption = "Wheel Down"
Case wa_WheelMove: Label1.Caption = "Wheel Move - Step=" & plScrollLines
Case wa_WheelUP: Label1.Caption = "Wheel Up"
End Select
End Sub

Question : Le composant étant invisible en mode runtime, l'évènement Show du Usercontrol est sans effet, comment pourrait-on faire pour que la capture de la molette s'active automatiquement sur l'évènement Load du form conteneur?. Le but étant de se passer de SNA_Wheel1.Activate sur Load. Le top étant d'avoir la capture par le seul fait de déposer le composant dans une form.
cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
8 août 2010 à 18:19
Merci Philippe734, ca marche nickel, j'adopte ta proposition c'est plus propre à mon avis et comme j'étais à ma première concernant le subclassing, la source vbfrance.com/codes/MODULE-SUBCLASSER_38442.aspx de renf devrait régler certains de mes soucis dont je n'ai pas la parfaite connaissance, je lui fais confiance.
Philippe734 Messages postés 308 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 15 juin 2015 1
3 août 2010 à 00:16
Comme j'ai aimé ton idée d'intégrer l'évènement molette et que j'adore utiliser les modules de renfield, alors j'ai reproduit ton idée avec ses modules :

' Dans un module de class nommé CMouseWheel :
Implements ISubclasser
Private mtWin1 As SubClassedWindow
Public Event MouseWheel(Orientation As Long, Click As Boolean)
Public Sub AttachTo(frm As Form)
InitiateSubClassing mtWin1, Me, frm.hWnd, True
End Sub
Private Sub Class_Terminate()
TerminateSubClassing mtWin1
End Sub
Private Function ISubclasser_WindowProc(ByVal hWnd As Long, ByVal uMsg As MessageConstants, ByVal wParam As Long, ByVal lParam As Long) As Long
If hWnd <> mtWin1.hWnd Then Exit Function
ISubclasser_WindowProc = CallOldProc(mtWin1, hWnd, uMsg, wParam, lParam)
If uMsg = WM_MOUSEWHEEL Then RaiseEvent MouseWheel(Sgn(wParam), False)
If uMsg = WM_MBUTTONUP Then RaiseEvent MouseWheel(Sgn(wParam), True)
End Function

' Intégration de l'évènement molette dans une form :
Private WithEvents FormX As CMouseWheel
Private Sub Form_Load()
Set FormX = New CMouseWheel
FormX.AttachTo Me
End Sub
Private Sub FormX_MouseWheel(Orientation As Long, Click As Boolean)
'If Orientation < 0 Then ' On scroll vers le bas
End Sub

Bon, tout ça pour dire que c'est juste pour le plaisir d'utiliser le subclassing facilement.
Philippe734 Messages postés 308 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 15 juin 2015 1
27 juil. 2010 à 22:45
Merci, en plus, j'aime bien le concept de portabilité pour d'autres appli. En revanche, dans le projet test, le subclassing n'est pas terminée, alors que tu voulais le terminé lorsque la souris sort du datagrid. Je pense que le mieux d'ajouter la fin du subclassing dans form_terminate. Comme tu apprécie le subclassing, alors pour explorer cet univers, je te conseil d'utiliser les modules de rendfield :
vbfrance.com/codes/MODULE-SUBCLASSER_38442.aspx
cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
18 févr. 2010 à 07:34
Finalement l'algorithme utilise pour cette source m'a donné envi d'aller plus loin. Je ne vais pas reloader une source je crois qu'il devrait en avoir ici, mais en définitive je me suis dit pourquoi pas créer un composant qui se chargera de tracker tous les evenements sur Hwnd définit. 2 possiblités tracker tout evenement (uMsg) ou tracker une liste devenement qui serait définit par un "AddEventToTrack puMsg, pbCallDefaultAfterTrack". Dans mon cas je laisse les 2, apres à voir pour l'optimisation du code.

Quelle importance me diriez-vous vu que chaque objet a deja sa propre gestion d'evenement?.
D'un les objets prevoient de gerer les evenements connus, la roulette n'existe pas pour les premières versions de datagrid, et de deux on peut decider faire le track sur un Hwnd quelconque. En principe si vous avez un datagrid à l'interieur d'un form avec plusieurs autres objets, la molette devrait intelligemment agir sur le datagrid, activé ou pas s'il s'agit su seul objet grid.
On peut vouloir tracker les evenements sur une appli externe (à ce sujet j'ai rajouté la fonction "GetWindowHwnd(ByVal plClassName As String, ByVal plWindowName As String) As Long") et pouvoir intereargir avec celle ci au moyen de la fonction "SendEventToWindow(plHwnd as long, pluMsg as long, ByVal pwParam As Long, ByVal plParam As Long). Sur cette forme la fonction SendEventToWindow est un peu du chinois à moins d'être documenté. On peut la decomposer en plusieurs fonctions plus explicites.
La reception des evenements pourrait se faire sous la forme SNA_TrackEvent( ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) qui est aussi du chinois, mais le mieux serait de la decomposer en plusieurs evenements (SNA_TrackWheel, SNA_TrackKeyBoard, SNA_TrackMouse, ...) et ne reserver le SNA_TrackEvent que pour les evenements non traités.

je profite pour preciser que le detournement d'evenement se fait toujours avant d'appeler la procédure normale. Ceci permet d'annuler/transformer l'action pour les autres en fonction de ce que l'on souhaite.

Merci encore Vbfrance de ce que j'ai pu apprendre et cette ouverture sur ce monde merveilleux du Subclassing et divers grace a vous multiples sources que je parcoure regulièrement. Nix, u r de best.
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_asimengo)