Autres toutes versions tester le scrool avec la roulette sans passer par un hooking en addressof

[patricktoulon]

Bonjour a tous
la principal raison des crash excel quand on utilise le hooking de la souris pour avoir le mouse wheel(la roulette)
c'est que le looping avec le (CallnextHook)est asynchrone avec le captage du message de la souris
donc quand une erreur se produit(on va trop vite ou autre)
le looping lui continue parfois au moins une fois même en erreur
résultat comme on déplace le block type du message en mémoire ça crash

je vous propose de tester ceci
ici on va rester dans un do/loop vba classique et le message de la souris sera récupéré par un peekmessage
si il y a une erreur (du au message de la souris non conforme) normalement on a une erreur vba classique
et donc le do/loop est interrompu
donc pas de relance avec un message de la souris erroné donc pas de crash
Vous constaterez que j'augmente l'allocation de la mémoire aussi (64 bits double (longlong ou longPtr))(+2&)

d'autant plus que la dans cette démo je met tout dans le userform
ce qui n'est pas possible avec un code de hooking bien entendu
et ça peut avoir un avantage lorsque l'on veut distribuer un interface(userform) sans devoir l'accompagner de x modules

toujours pareil pour déterminer le rectangle je me sert de ma fonction perso du calendar que j'ai modifié pour ce besoins
donc testez et si ça fonctionne je ferais une ressource au propre

merci d'avance pour votre participation

j'en connais un qui vas ouvrir grand les yeux 🤣

Patrick

 

[ChTi160]

Bonjour le Fil !
Chez moi c'est pareil ! ca fonctionne qu'avec les TextBox 2 et 3 (W11 365 (32)
Merci !
Bonne Journée
Jean marie

 

[patricktoulon]

tiens donc en 32 bits en plus
alors il y a d'autres paramètres car c'est pas normal que
chez moi office 2013 32 ca marche
chez dan_W excel2021 64 ca marche
jaafar tribak 2013 32 et 2016 64 ca marche

et que chez vous ça marche pas
@jurassic pork d'autant plus que j'utilise en fait la même astuce que j'utilise dans la version 2 pour la combo
(sauf que là je l'utilise pour tout les controls)
et que dans ta demo post #619 tu montre que ça marche sur la combo
et là ca marche plus ??????????????????????????????????? alors que c'est le même code que j'ai mis dans le setup
à savoir pour le code:

 Call IUnknown_GetWindow(Me, VarPtr(hWnd))
    HandL = GetWindow(hWnd, 5)
     Set IC = New MSINKAUTLib.InkCollector
    SetFocus HandL
    Set mycontrol = Ctrl
    On Error Resume Next
    With IC
        .hWnd = HandL ' The InkCollector requires an 'anchor' hWnd

quand je vous dit qu'il n'y a pas de logique 😉

 

[jurassic pork]

chez dan_W excel2021 64 ca marche
jaafar tribak 2013 32 et 2016 64 ca marche

tu leur as fait tester ton dernier classeur ? je n'ai pas vu ton classeur dans la discussion de MrExcel

 

[patricktoulon]

le code c'est le même que son exemple modeless sur gitub

 

[patricktoulon]

voila le code de son exemple

'    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
'    |||||||||||||    EZPZ MOUSECONTROLLER - DEMO 2      |||||||||||||
'    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
'
'    AUTHOR:   Kallun Willock
'    NOTES:    This demonstrates how the InkController can be used with
'              windowless MSForms controls. It relies on attaching to
'              the UserForm's hWnd. Note that with the UserForm, you must
'              use the hWnd of the Client Area and not the UserForm
'              proper (as set out in the code below).
'
'              - The technique requires a reference to be set to
'                Microsoft Tablet PC Type Library, version 1.0.
'                "C:\Users\YourUserName\AppData\Roaming\Microsoft
'
'    VERSION:  1.0        31/03/2025         Uploaded to Github

Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
#Else
  Private Enum LongPtr
  [_]
  End Enum
  Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hWnd As LongPtr) As Long
  Private Declare Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
#End If
 
Private WithEvents IC As MSINKAUTLib.InkCollector
Private TargetControl As msforms.Control

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Initialize()
  SetupMouseWheel
  Label1.Picture = New StdPicture
  Me.TextBox1.SelStart = 0
End Sub

Private Sub SetupMouseWheel()
  Dim hWnd As LongPtr, TemphWnd As LongPtr
  Call IUnknown_GetWindow(Me, VarPtr(hWnd))
  Const GW_CHILD = 5
  TemphWnd = GetWindow(hWnd, GW_CHILD)
  Set IC = New MSINKAUTLib.InkCollector
  With IC
    .hWnd = TemphWnd                                ' The InkCollector requires an 'anchor' hWnd
    .SetEventInterest ICEI_MouseWheel, True         ' This sets event that you want to listen for
    .MousePointer = IMP_Arrow                       ' If this is not set, the mouse pointer disappears
    .DynamicRendering = False                       ' I suggest turning this off = less overhead
    .DefaultDrawingAttributes.Transparency = 255    ' And making the drawing fullly transparent
    .Enabled = True                                 ' This must be set last
  End With
End Sub

' When the mouse cursor moves over these controls, this will set the control as the target of the mousewheel event.

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Not Label1 Is TargetControl Then
    Set TargetControl = Label1
  End If
End Sub

Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Not TextBox1 Is TargetControl Then
    Set TargetControl = TextBox1
  End If
End Sub

' The MouseWheel event selects what type of control it is dealing with and then executes the custom actions accoringly.
' Here, I use CallByName to adjust the controls properties to avoid the headaches associated with the limitations found
' in the the generic MSForms.Control control.

Private Sub IC_MouseWheel(ByVal Button As MSINKAUTLib.InkMouseButton, ByVal Shift As MSINKAUTLib.InkShiftKeyModifierFlags, ByVal Delta As Long, ByVal X As Long, ByVal Y As Long, Cancel As Boolean)
  Select Case TypeName(TargetControl)
    Case "Label"
      CallByName TargetControl, "Caption", VbLet, "Delta: " & Delta
    Case "TextBox"
      Dim CurrentLine As Long
      CurrentLine = CallByName(TargetControl, "CurLine", VbGet)
      If CurrentLine = TextBox1.LineCount - 1 And Delta < 0 Then Exit Sub
      If CurrentLine = 0 And Delta > 0 Then Exit Sub
      CallByName TargetControl, "CurLine", VbLet, IIf(Delta > 0, CurrentLine - 1, CurrentLine + 1)
  End Select
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  Set IC = Nothing
End Sub

on vois bien que c'est pareil sauf que lui la variable c'est "TemphWnd" et moi " HandL"

 

[jurassic pork]

on vois bien que c'est pareil sauf que lui la variable c'est "TemphWnd" et moi " HandL"

Sauf que dans son exemple , il n' y a pas de ListBox, de ComboBox et de Multipage

 

[patricktoulon]

allez si tu veux ,je reprends son exemple j'ajoute une listbox , une frame , un multipage , un combobox
je modifie le setup avec le handle optionael comme ca tu a les bon handle sauf pour le textbox ou combobox il va le chercher
ensuite comme on a plusieur control à gérer le setupmouswheel sera executé au move des controls
donc destruction et creation d'un new ink au changement de controls
voilà on est paré
démonstration

 

[ChTi160]

Re
Chez moi cette partie est en rouge

Private Enum LongPtr

jean marie

 

[patricktoulon]

re
bonsoir jean marie
on s'en fou ca marche quand même c'est pour le 64

 

[ChTi160]

Re
si

on s'en fou ca marche quand même c'est pour le 64

c'est pour cela que ça fonctionne que pour les deux premiers controls !
Bonne fin de Journée
Jean marie

 

[patricktoulon]

eleve le c'est pour le 64

 

[jurassic pork]

Hello,
patricktoulon j'ai repris ton dernier classeur et cela ne fonctionnait pas pour le Multipage et la ComboBox. C'est parce que ces contrôles peuvent avoir plusieurs fenêtres (les pages et le multipage pour le multipage, la liste des éléments et la comboBox pour la ComboBox. Alors mon idée c'est quand on a un mousemove dans un contrôle c'est de mémoriser aussi la fenêtre dans laquelle on est (avec la position curseur) et d'appeler la fonction SetupMouseWheel avec comme argument la fenêtre mémorisée et cela semble OK :

Testé OK avec :
Excel 2007 Win 7 SP1
Excel 2013 Win 10
Excel 2016 Win 11
Excel 2021 64 bits Win 11

Classeur en pièce jointe.
Ami calmant, J.P

 

[patricktoulon]

re
ben c'est ce qui etait fait
le handle est désigné dans IC il ne changera pas avant un autre mousemove sur un autre control
en quoi le mémoriser sur une cell rend la chose mieux ?
il faudrait que tu mette des debug pour voir ce dont je doute c'est que le mouve recrée a chaque fois
au quel cas tant mieux si ca marche mais ça ne doit pas fonctionner comme ça
le setupmouseWheel enclenche le IC avec le handle désigné ou par le unknow child et ne change pas sauf sortie ou changement de control pendant le survol

 

[patricktoulon]

re
je viens de regarder
ta fonction windowsfrom curs reprend mon idée pour la combobox sauf que tu ne considère que le point X et y
et non developpée tout ce que tu capte et l'espace client du userform c'est a dire le handle du inside
a savoir de classe "F3 Server XXXXX..."
ce qui est déjà fait avec le "unknowwindow"
donc je ne comprends pas pourquoi tu me dit que le 637 ne fonctionne pas alors qu'il nous donne les même handle

pour que tu comprenne ce que je dit
ceci

  Call IUnknown_GetWindow(Me, VarPtr(hWnd))
        Const GW_CHILD = 5
        TemphWnd = GetWindow(hWnd, GW_CHILD)

te donnera la même chose que ceci quand la combo n'est pas developpée

#If VBA7 Then
    Private Function GetWindowFromCurs() As LongPtr
#Else
    Private Function GetWindowFromCurs() As Long
#End If
    Dim Pt As POINTAPI
    Call GetCursorPos(Pt)
#If Win64 Then
    GetWindowFromCurs = WindowFromPoint(PointToLongLong(Pt))
#Else
    GetWindowFromCurs = WindowFromPoint(Pt.X, Pt.Y)
#End If
End Function

d'autant plus que tu inscrit dans les cell mais a aucun moment tu t'en resert

peut être a ce moment là ou tu switch avec le activcontrol ou TargetHwnd et le getwindowfromcurs
et donc au debut la combo tourne avec le handle espace client du userform
et si elle est developpée elle passe par la 2d condition getwindowfromcurs/targethandle lors du mouve dans la child
et pareil visiblement avec le multipage
un truc qui serait bien c'est de controler si l'inside du multipage a le même handle que le multipage lui même
au quel cas ça serait bien ca la différence entre le 32 bits et 64 car chez moi le multipage a le même handle partout

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Sheets("Feuil1").Range("B2") = "ComboBox1"
    Sheets("Feuil1").Range("B3") = GetWindowFromCurs()
     If Not ComboBox1 Is TargetControl Then
        Set TargetControl = ComboBox1
'        SetupMouseWheel MultiPage1.[_GethWnd]
      End If
    If Not GetWindowFromCurs() = TargetHwnd Then
        TargetHwnd = GetWindowFromCurs()
        Debug.Print "Combo"
        SetupMouseWheel TargetHwnd
    End If
End Sub

 

[patricktoulon]

bon ben après analyse je comprends pas comment ma V2 ne fonctionnait pas
puisque finalement tu fait la même chose mais en deux fois
par exemple ici pour la combobox
comme je l'ai dit tu pass de l'espace client userform au handle de la child de la combo
sauf que par rapport a ma v2 il faut que tu te ballade dessus pour le capter

et la version 2 d'hier

on fait exactement la même chose sauf que je déclenche la creation du IC uniquement si le handle child est dispo
donc je comprends pas

en tout cas ça démontre clairement que pour un userform engager un hooking survitaminé et surencapsulé n'est pas utile
chez moi la mémoire c'est l'encephalo plat et mes processeur sont a 0%

on vois bien qu'après la mise en route de capture et placement de fenêtre me processeur redescend malgré le scroll
si je te montre avec le module de qui tu sais tu va prendre peur
voila développer c'est pas seulement faire du code pour que ça marche c'est aussi veiller a ne pas bouffer toutes les ressources

allez on en fait une classe et on en parle plus
en tout cas perso pour mes userforms j'adopte largement la méthode avec le InkCollector