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

 

[jurassic pork]

SOS @jurassic pork

Regarde la pièce jointe 1214774

Normal il faut cocher UIAutomationclient dans les références . On peut pas utiliser createObject

 

[patricktoulon]

j'ai même encore trouver plus simple si on eccepte que le scroll soit effectif uniquement dans le control et pas le cuseur sur la scroll bar
ca ne demande aucune api
et punaise qu'est ce que c'est simple

j'explique le contexte
quand le move lance le scroll dans la premiere version dans la ressource pour userform
je n'utilisait plus X et Y de l'event move
ET POURTANT C EST CON COMME UN BALLAIS
si j'envoie X et Y de l'event dans la mousewheel
il vont changer bien sur
de même que pos avec getcursor pos
sauf que quand on sort
je vous le donne dans le mille il n'y a plus que getcursorpos qui change
conclusion
si pos change et x ou x ne change pas c'est que l'on est dehors ou sur la scrollbar du control

Terminé
faut il encore accepter que la roulette ne fonctionne pas sur les scrollbar des control
mais c'est un moindre mal
vu toute l'energie que tu déploie pour corriger point par point

que pensez vous de ca ?

 

[jurassic pork]

Normal il faut cocher UIAutomationclient dans les références . On peut pas utiliser createObject

Quand tu coches UIAutomationclient dans un classeur , normalement si tu transmets le classeur , la référence va exister et comme UIAutomationclient est présent sur tous les windows cela ne devrait pas présenter de problème

 

[Dudu2]

Quand tu coches UIAutomationclient dans un classeur , normalement si tu transmets le classeur , la référence va exister et comme UIAutomationclient est présent sur tous les windows cela ne devrait pas présenter de problème

Oui, je sais mais lorsque tu fais un Module à insérer dans un projet (type Ressource pour un utilisateur quelconque) il faudra alors bien préciser d'ajouter la référence.

 

[patricktoulon]

@jurassic pork
la methode avec uiautomation n’arrête pas quand je passe sur un control non géré

 

[Dudu2]

Voilà la "version UIAutomation" élaborée grâce aux indications de @jurassic pork pour trouver le RECT du Control.
C'est vrai que c'est plus court et plus simple que la version précédente avec les WindowFromPoint() et les RECT des TextBox par code VBA.

Et on a du bol pour les ComboBox car une instruction UIAutomation se plante sur l'objet ComboBox non DropDown !
On sait donc que c'est pas le bon.

Fichier -> voir plus loin !

 

[patricktoulon]

et c'est normal que ça marche pas
il faut le faire avant les iaccessibleobjectfrompoint car après c'est le control en dessous le curseur qui est pris en compte
cela dit même avant ca marche pas non plus
il n'y a que ma methode rangefrompoint qui marche mais que sur les feuille bien sur

Function IsScrollable(control, Onsheet As Boolean) As Boolean
    Dim PosControl As IAccessible, pos As POINTAPI, ok As Boolean, role, obj As Object
    If control Is Nothing Then Exit Function
    Select Case True
        Case TypeOf control Is ComboBox: role = 33
        Case TypeName(control) = "ListBox": role = 33
        Case TypeOf control Is TextBox: role = 42
        Case TypeOf control Is Frame: role = 20
        Case TypeOf control Is UserForm: role = 16
            'etc..
    End Select
    GetCursorPos pos
    If Onsheet Then 'si on est dans une feuille et que le control n'est pas géré
        DoEvents
        Set obj = ActiveWindow.RangeFromPoint(pos.X, pos.Y): DoEvents
        If TypeName(obj) <> "Range" Then DoEvents: If obj.Left <> control.Left Or obj.Top <> control.Top Then IsScrollable = False: Exit Function
    Else
        Dim c As New CUIAutomation
        Dim UIAelem As IUIAutomationElement
        Dim accescontrol As IAccessible
        Set accescontrol = control
        Set UIAelem = c.ElementFromIAccessible(accescontrol, 0)
        If UIAelem.CurrentBoundingRectangle.Top < pos.Y And _
               UIAelem.CurrentBoundingRectangle.Left < pos.X And _
               UIAelem.CurrentBoundingRectangle.bottom > pos.Y And _
               UIAelem.CurrentBoundingRectangle.Right > pos.X Then _
               IsScrollable = False: Exit Function
    End If

    #If Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, pos, LenB(pos)
        AccessibleObjectFromPoint lngPtr, PosControl, 0
    #Else
        AccessibleObjectFromPoint pos.X, pos.Y, PosControl, 0
    #End If
    UserForm1.TextBox2 = "IAccessible :" & PosControl.accRole

    'ratrapage pour la combobox quand elle n'est pas developpée
    'on decale  pos.y de 25 pour passer eventuellement SUR LA child si elle est developpée directement et donc scrollable a partir du bouton drop ou input
    If PosControl.accRole <> role Then
        If TypeOf control Is ComboBox Then
            pos.Y = pos.Y + 25
            #If Win64 Then
                CopyMemory lngPtr, pos, LenB(pos)
                AccessibleObjectFromPoint lngPtr, PosControl, 0
            #Else
                AccessibleObjectFromPoint pos.X, pos.Y, PosControl, 0
            #End If
        End If
    End If


    On Error Resume Next
    '[c1] = PosControl.accRole
    IsScrollable = PosControl.accRole = role
End Function

 

[Dudu2]

Moi je ne dis qu'une chose après 19 pages d'investigations: ça c'est quand même beau à voir !

 

[patricktoulon]

re
a oui on peut le dire

IACCESSIBLE ONLY

 

[jurassic pork]

Dudu2 dans ton classeur du post #276 quand on clique dans une ComboBox et qu'on bouge la molette de la souris , cela provoque une erreur :
Impossible de définir la propriété TopIndex

 

[Dudu2]

@jurassic pork, en effet, pas vu ça ! Merci pour le signalement.

Fichier corrigé -> voir plus loin.

 

[Dudu2]

Je vais en faire une nouvelle Ressource en citant les contributeurs pour le code et pour les tests.

 

[patricktoulon]

et voici la version IAccessible
sortie du scroll sur control non gérer
scroll possible dès le développé de la combo même en restant dans l'input
fonctionne sur feuille excel et userform

pour la sortie comme vous m'avez clairement laisser tomber j'ai trouvé mon astuce tout seul
sur les feuilles je passe par rangefrompoint sur l'userform je passe par uiautomationclient basé sur l'exemple de @jurassic pork
j'ai ajouter les textbox
mais je suis en train de reduire mon astuce pour adapter a ce module pour choper le point curline haut et bas avant de scroller

déposée dans les ressources
comme ça il y a aura le choix Iaccessible ou autres

le brouillon de la ressource joint

 

[Dudu2]

Désolé mon @patricktoulon mais j'ai des plantages assez rapidement.

pour la sortie comme vous m'avez clairement laisser tomber j'ai trouvé mon astuce tout seul

La sortie est très simple, c'est la sortie du rectangle du Control comme indiqué par @jurassic pork.
Y a pas d'autre moyen sûr.
Le RangeToPoint n'est pas sûr car à proximité immédiate du Control scrollé il peut y avoir d'autres Controls non scrollés ou le menu de la feuille ou des Shapes ou je ne sais quoi d'autre.

 

[patricktoulon]

après test benchmark ce do/loop tourne plus vite que le looping en adressof avec setnexthook et callnexthook
va comprendre charle

on va pas s'en plaindre hein