Commentaires sur une source : INTEGRATION AUTOMATIQUE DE LA ROULETTE/MOLETTE DE LA SOURIS DANS VOS APPLIS

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.

cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
14 févr. 2010 à 15:37

@PCPT: "qui peut le moins ne pourra pas le plus", mais c'est ton choix, pas de problème. Ce que j'en rajoute, ce que, ce qui est trivial pour l'un ne l'est pas forcement pour les autres. Meme les grands scientifiques n'ont pas toujours été compris en leur temps, ... lecture diagonale

cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
14 févr. 2010 à 15:19

@PCPT: Pour etre plus precis, la source de Daetips a ceci de genial que c'est un programme resident qui gere globalement la molette pour tous les forms demandeurs. Le mien a la particularité, que la demande doit etre faite par le form demandeur. ca se passe cmt?, sur "activate, gotfocus", jai besoin, je demande, sur "Lostfocus, Unload" je n'ai plus besoin je libere. Je pense avoir ete plus precis. C'est une approche différente de celle de Daetips mais qui du moins est aussi interessante.
Par cette occasion, je vois que j'ai oublie de faire un truc important celui de commencer par executer la procedure normale avant de gerer les evenements.

Ceci apporte une modification à la Winproc qui devient ceci:

Public Function WindowProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo Err_WindowProc

'Si on est là c'est parcequ'il ya eu subclassing dont mlAddressOfWndProc est valide
'Commencer toujours par appeler la procedure par défaut afin que les autres objets puissent gerer les evenements
'Le detournement se fait apres
WindowProc = CallWindowProc(mlAddressOfWndProc, Hwnd, uMsg, wParam, lParam)

Select Case uMsg
Case WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MBUTTONDBLCLK: voClsWheel.SetMouseWheelEvent uMsg
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

voClsWheel.SetMouseWheelEvent uMsg, Sgn(wParam)
Case Else:
End Select

Exit_WindowProc:
Exit Function

Err_WindowProc:
' MsgBox "Hwnd = " & Hwnd & vbCrLf & _
' "AddressOfWndProc = " & mlAddressOfWndProc & vbCrLf & vbCrLf & _
' "Error = " & Err & vbCrLf & _
' Err.Description
Resume Exit_WindowProc
End Function

PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
14 févr. 2010 à 15:03

la source est lue ^^. en diagonale mais assez pour avoir laissé le commentaire ;)

ce n'est pas la bonne conception.
si ta source est une sorte d'allégé (pourquoi pas), et que pour fonctionner comme tu l'avais en tête (pas de collection) il doit y avoir un changement de handle lors de l'activate, c'est ta classe qui doit alors observer cet activate pour switcher. ce n'est pas au dev de le faire.

je parle bien uniquement de conception.
après, "qui peut le moins ne pourra pas le plus", mais c'est ton choix, pas de problème

bonne continuation

cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
14 févr. 2010 à 15:01

J'ai pensé à une autre approche, celle de rediriger les evenements de la molette sur les evenements mouse (MouseMove, MoveDown, MouseUp) en definissant une constante approprie pour le paramettre "Button" qui permettra de differencier avec les evenements standards.

je suis pour le moment dans la recherche des bons parametres à passer à la Winproc, voir Winproc ci-dessous, au cas ou quelqu'un aurait une idee.

Public Function WindowProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo Err_WindowProc
Dim wParam2 As Long, lParam2 As Long

Select Case uMsg
Case WM_MBUTTONDOWN:
wParam2= ...
lParam2= ...
WindowProc = CallWindowProc(mlAddressOfWndProc, Hwnd, WM_MOUSEDOWN, wParam2, lParam2)
Case WM_MBUTTONUP:
wParam2= ...
lParam2= ...
WindowProc = CallWindowProc(mlAddressOfWndProc, Hwnd, WM_MOUSEUP, wParam2, lParam2)
Case WM_MBUTTONDBLCLK:
wParam2= ...
lParam2= ...
WindowProc = CallWindowProc(mlAddressOfWndProc, Hwnd, WM_MOUSEDOWN, wParam2, lParam2)
Case WM_MOUSEWHEEL:
wParam2= ...
lParam2= ...
WindowProc = CallWindowProc(mlAddressOfWndProc, Hwnd, WM_MOUSEMOVE, wParam2, lParam2)
Case Else:
'Si on est lÃ c'est parcequ'il ya eu subclassing dont mlAddressOfWndProc est valide
WindowProc = CallWindowProc(mlAddressOfWndProc, Hwnd, uMsg, wParam, lParam)
End Select

Exit_WindowProc:
Exit Function

Err_WindowProc:
' MsgBox "Hwnd = " & Hwnd & vbCrLf & _
' "AddressOfWndProc = " & mlAddressOfWndProc & vbCrLf & vbCrLf & _
' "Error = " & Err & vbCrLf & _
' Err.Description
Resume Exit_WindowProc
End Function

cs_asimengo Messages postés 280 Date d'inscription jeudi 24 mars 2005 Statut Membre Dernière intervention 18 mars 2009
14 févr. 2010 à 14:52

@PCPT: l'exemple effectivement va ds le sens de montrer qu'on peut se passer de la collection, c pourkoi j'ai montre qu'on peut gerer facilement le changement d'un form à un autre. je te recommande de lire la source, tu veras que c'est bien mieux pensé qu'il ne parait.
A la différence de la source de Daetips, qui gere le scroll sur les objets, le mien a pour seul but de renvoyer les evenements molette sur le Hwnd voulu. par défaut le form conteneur.
Pr l'évenement "Activate" je voulais demontrer que le developpeur a la main plus sur le fait de ramener la capture sur la form active. Chaque form qui a le focus, ramene automatiquement la capture sur lui.

PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 47
14 févr. 2010 à 14:42

salut,

pas testé mais à la lecture en diagonale, c'est incorrect :
tu dois gérer une collection de classes
ici tu changes le handle observé lors de l'activate, masquant le problème (avec cet exemple pour une form). tu as donc une seule observation possible par projet

mais suppose l'observation d'une form (ok) ET d'un bouton sur cette form?

ou de 2 grids (ton projet de départ) sur une même form?
l'évènement relevé ne sera pas celui du control concerné

collection de class, la winproc doit appeler le raise de la class ayant le même handle
NB : attention à bien gérer un clé STRING

++

INTEGRATION AUTOMATIQUE DE LA ROULETTE/MOLETTE DE LA SOURIS DANS VOS APPLIS

Votre réponse

Discussions similaires