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

 

[patricktoulon]

c'est le desavantage d'utiliser windowfromfpoint
ca t 'oblige code encore plus pour chopper ton rectangle textbox
alors qu'avec iaccessible on peut

au passage le problème de control non géré est réglé
le userform c'est 16
la frame c'est 20
la listbox c'est 33
le combobox c'est 46 et sa child 33
l'image c'est 40
le textbox c'est 42

 

[abdououbale]

2°
le textbox obligé de se taper toutes les lignes suivantes ou precedentes la curline pour scroller
sur 4 lignes c'est pas trop grave mais quand on en a un paquet comme dans mon vba indenter par exemple
ça fait un peu beaucoup
j'ai déjà donné l'astuce pour éviter ça

raisonnement
textbox calque prise de la mesure avec integral height(tu connais on a vu ça ensemble pour les listbox me semble t il)
split par les sauts de ligne et comptage des lignes
captage du curline
split a partir du curline
recuperation de ce qui est avant en terme de ligne par un simple split par les saut
tu fait le prorata par raport au nombre de ligne possible par rapport au height
et tu sais donc combien il te faut sauter de ligne en plus ou en moins selon le sens du scroll a ajouter ou a enlever avant le premier cran de roulette tu te laisse une marge de une ligne en moins pour la descente et une en plus pour la remonté
donc au final au permier scroll vers le bas ou vers le haut tu aura max 1 ligne a remonter avant le scroll effectif
terminé

Bonjour à tous

Est-il possible d'appliquer le scroll sur des contrôles créés de manière dynamique via un module de classe comme par exemple un combobox ou plusieurs (chaque combobox aura un tag pour l'identifié) et pouvoir les manipuler avec Combobox_MouseMove
???

Merci d'avance

Exemple :
Public WithEvents mForm As MSForms.UserForm
Public WithEvents mpage As MSForms.MultiPage
Public WithEvents mFrame As MSForms.Frame ' Main Frame
Public WithEvents category As MSForms.ComboBox

Sub CreateTableData(form As Object, frm As MSForms.Frame)

Set mForm = form
Set mFrame = frm

With mFrame

' Ajout de Category

Set category = .Controls.Add("Forms.ComboBox.1", "Category" & uniqVal)
BoxDesign category, Width:=100
With category
.left = prevCtrl.left + prevCtrl.Width + spacing
.top = rowTop + 4
.text = "Select Category"
.Tag = uniqVal
.ControlTipText = .text ' Initialiser avec la valeur par défaut
End With

End Sub



' Gestionnaire d'événements MouseMove pour le ComboBox Category
Private Sub category_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Not disableEvents Then
If RecallLoop = False Then UFMouseWheel category.tag, Y
End If
End Sub

 

[Dudu2]

Bonjour,
Avec des Controls dynamiquement créés, je pense que c'est possible en ajoutant dans la Classe leur évènement MouseMove.
Avec IAcessible je peux essayer mais si on retrouve l'accRole, comment différencier 2 contrôles de même accRole juxtaposés pour savoir qu'on a changé de Control ? L'accName donne quelque chose ?

 

[jurassic pork]

Hello,
pour le problème du double affichage je pense avoir cerné la cause :
voici ce que donne le classeur de Dudu2
1 - sur un Excel 2013 windows 10 avec Mise à l'échelle de 100 %

2 - sur un Excel 2013 windows 10 avec Mise à l'échelle de 125 %

et voici maintenant ce que cela donne, le classeur étant corrigé dans un windows avec Mise à l'échelle de 100 %

1 - sur un Excel 2013 windows 10 avec Mise à l'échelle de 100 %

2 - sur un Excel 2013 windows 10 avec Mise à l'échelle de 125 %

Alors la question que je pose à Dudu2 :
Tu travailles sous un windows avec quelle mise à l'échelle ? ou alors sous quelle résolution ?

Ami calmant, J.P

 

[patricktoulon]

Bonjour
oui c'est possible mais tu t y prend mal pour ta classe

 

[patricktoulon]

Bonjour,
Avec des Controls dynamiquement créés, je pense que c'est possible en ajoutant dans la Classe leur évènement MouseMove.
Avec IAcessible je peux essayer mais si on retrouve l'accRole, comment différencier 2 contrôles de même accRole juxtaposés pour savoir qu'on a changé de Control ? L'accName donne quelque chose ?

ben c'est simple
des solutions tu en as
il y a le control

a supposer que tu ai 2 listbox
les deux vont te donner 33 mais listbox1 et listbox2

mon principe est simple
au move j'apelle mousewhell
dans mousewhell
si actualcontrol(l'eventuel control precedemment survoulé) est le control on sort car on est deja dans le moulin do/loop
sinon set actualcontrol=control
etc..etc..

et dans ma fonction isscrollable j'ai mis une condition pour palier au fait que je peut survoler un control qui n'a pas a etre gerer
donc si isscrollable renvoie false criter sera false et arrêtera la boucle

maintenant toi dans ton truc tu peux ajouter da"ns ta fonction qui est a"ppelé au mouve (en plus du windowfrompoint
un simple peek avec accessibleobjectfrompoint
comme ca si tu est dans une frame avec un textbox
windowfrompoint te donnera la frame mais le peek te donnera le textbox
c'est assez simple a mon avis a mettre en place

 

[Dudu2]

Voilà j'ai corrigé mon erreur d'interprétation initiale et bien simplifié le bidule qui est finalement pas très compliqué.
Pour les TextBox, qu'elles soient ActiveX ou UserForm, je suis obligé de récupérer leur RECT pour savoir si le curseur reste dedans ou bien en sort.
Les fonctions de récupération des RECT des TextBox ne sont pas si lourdes et sont très précises quant aux valeurs de RECT récupérées.
Dans tous les cas, j'ai inhibé le phénomène de 1ère entrée en TextBox, c'est quand même plus confortable.

Je vais quand même faire un essai avec AccessibleObjectFromPoint() si j'arrive à identifier le Control et pas seulement son rôle à partir de cette fonction.

 

[Dudu2]

Bonjour @jurassic pork , @patricktoulon,

@jurassic pork

Tu travailles sous un windows avec quelle mise à l'échelle ? ou alors sous quelle résolution ?

@patricktoulon ,

ben c'est simple
des solutions tu en as
il y a le control

En effet, j'ai le Control tu as raison. Je vais essayer.

 

[patricktoulon]

re
regarde comment je fonctionne
ma fonction isscrollable

Function IsScrollable(control As Object, 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 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 prevoit de sortir au cas ou il y a un cotrol no géré
    If onsheet Then 'si on est dans une feuille et que le control n'est pas géré
        On Error Resume Next
        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
        'reste a trouver le moyen de capter l'objet sous pos(x,y) dans le userform
    
    
    End If

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

j'explique

Function IsScrollable(control As Object, 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

ici on selectionne le role qui doit être le bon

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

ici on capte la position du curseur

GetCursorPos pos

en fonction de la position du curseur on va tester l'objectaccessible dans la variable (poscontrol)

#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

ca c'est juste pour la demo pour voir

UserForm1.TextBox2 = "IAccessible :" & PosControl.accRole

a partir de la si role n'est pasle bon on va tester ( avec un decalage de pos.y(pour la combobox )
car quand elle est developpé ca doit me donner le bon role avec le decalage

'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

maintenant il est possible que l'on est des control non gérés
ce qui fait que quand on est dessus il n'appelle pas mousewhell
donc on va faire un simple test de l'object sous le curseur
et si le top et left (suffisant pour tester si oui ou non) n'est pas bon c'est pas scrollable
et donc criter dans mousewhell sera false et arrêtera le do/loop
comme tu peux le voir je cherche encore une methode simple pour les controls dans userform

'on prevoit de sortir au cas ou il y a un cotrol no géré
If onsheet Then 'si on est dans une feuille et que le control n'est pas géré
On Error Resume Next
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
'reste a trouver le moyen de capter l'objet sous pos(x,y) dans le userform


End If

si on est pas passer par le decalage isscrollable =poscontrol=role

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

voila c'est simple
donc dans les feuille
le passage d'un control a l'autre n'est pas un soucis
et si je passe sur un control qui n'est pas géré le test rangefrompoint veille a te faire sortir

reste a trouver la même chose a trouver comment faire (simplement) dans le userform

 

[jurassic pork]

@jurassic pork
Regarde la pièce jointe 1214761

Alors ce n'est pas la mise à l'échelle par contre ta résolution n'est pas trop standard et c'est peut-être cela qui pose problème
Toutes mes captures d'écran ont été faites sous un windows avec une résolution de 1920x1024

 

[Dudu2]

Le problème de l'AccessibleObjectFromPoint() c'est que lorsqu'on sort du Control, il rend toujours le même accRole du Control.
C'est chi*nt c'te fonction quj fait son job à moitié. Donc je ne sais pas comment sortir de la boucle. Peut-être avec le vChild ?
Tu utilises RangeFromPoint pour la feuille.
Je vais essayer avec un WindowFromPoint() pour récupérer soit le Handle de la feuille / ActiveWindow soit celui du UserForm, sauf si le Control scrollé est le UserForm.

 

[jurassic pork]

Le problème de l'AccessibleObjectFromPoint() c'est que lorsqu'on sort du Control, il rend toujours le même accRole du Control.
C'est chi*nt c'te fonction quj fait son job à moitié. Donc je ne sais pas comment sortir de la boucle. Peut-être avec le vChild ?
Tu utilises RangeFromPoint pour la feuille.
Je vais essayer avec un WindowFromPoint() pour récupérer soit le Handle de la feuille / ActiveWindow soit celui du UserForm, sauf si le Control scrollé est le UserForm.

On peut facilement avoir les dimensions des IAccessible grâce à UIAutomation et comme cela distinguer les différents contrôles.
Il y a la fonction elementFromIaccessible qui permet de récupérer l'élément UIAutomation et comme cela récupérer le "BoundingRectangle"
Exemple d'utilisation dans le programme de Patrick avec IAccessible :
Déclaration des variables :

    Dim c As New CUIAutomation
    Dim UIAelem  As IUIAutomationElement

Utilisation dans IScrollable :

    If PosControl.accRole = 46 And bLooping Then IsScrollable = True: Exit Function 'ne fonctionne  que dans le userform
    [c1] = PosControl.accRole
    Set UIAelem = c.ElementFromIAccessible(PosControl, 0)
    [c2] = UIAelem.CurrentBoundingRectangle.Top: [d2] = UIAelem.CurrentBoundingRectangle.Left
    [e2] = UIAelem.CurrentBoundingRectangle.bottom: [f2] = UIAelem.CurrentBoundingRectangle.Right
    ok = PosControl.accRole = role
    IsScrollable = ok

Attention au formulaire qui change de place car les coordonnées sont par rapport à l'écran

 

[Dudu2]

Bon, ben moi je n'y arrive pas.
Si je peux récupérer le Handle du UserForm qui a un menu système qui n'a pas été supprimé (condition déjà rédhibitoire) par un WindowFromPoint() sur son Caption, je ne sais pas déterminer quand le souris quitte un Control ActiveX.
Le RangeFromPoint suppose que la souris n'a pas rippé dans les menus de la feuille et donc ça ne va pas non plus.
Quant à extirper de l'info de l'argument vChild de l'AccessibleObjectFromPoint() je n'obtiens absolument rien.

 

[Dudu2]

OK @jurassic pork, grand spécialiste de l'IA, je vais essayer avec le UIAelem.CurrentBoundingRectangle.

 

[Dudu2]

SOS @jurassic pork