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

 

[Dudu2]

Ah mais non !
C'est pareil en SendInput et mouse_event !
Ça ne Scroll que dans le sens montant (up) quelque soit l'action sur la molette (up / down).
Donc en 64 bits, le problème est peut-être dans la position du curseur, sur le mauvais bouton de la ScrollBar !
Bon de toutes façons... cette méthode de clic souris n'est pas très orthodoxe.

 

[patricktoulon]

1. Je n'ai pas compris sa détection de la disparition du UserForm en utilisant la CommandBars.
   Je ne vois pas où est l'évènement qu'il dit intercepter.
   Si un UserForm en appelle un autre, est-ce que c'est discriminant ?

c'est pourtant simple
dans la classe il implemente un event commandbar
Private WithEvents oCmndBars As CommandBars

ensuite dans l'evente update

Private Sub oCmndBars_OnUpdate()
    If IsWindow(GetProp(Application.hwnd, "Hwnd")) = 0 Then
        Set oCmndBars = Nothing
        Set oForm = Nothing
        Call CoLockObjectExternal(Me, False)
    End If
End Sub

getProp c'est un stockage des donnée et parametres
dans l'update il ferme tout l'instance de classe en réinitialisant la variable

tu m'a déjà vu avec ca pour faire un timer par exemple
qui me sert de looper sans do loop dans le stack memoire

 

[jurassic pork]

Ah mais non !
C'est pareil en SendInput et mouse_event !
Ça ne Scroll que dans le sens montant (up) quelque soit l'action sur la molette (up / down).
Donc en 64 bits, le problème est peut-être dans la position du curseur, sur le mauvais bouton de la ScrollBar !

Ben en fait cela fonctionne dans les deux sens si on clique sur un élément qui est en dessous de la zone visible (exemple : élément 100)
On arrive à remonter avec la molette mais quand on arrive sur l'élément 1 on ne peut plus redescendre avec la molette.

 

[Dudu2]

Oui je connais ton "Timer CommandBars".
Et si un UserForm en appelle un autre, ça marche aussi à la fermeture du UserForm de 2ème niveau ?
Je dis ça parce que ça m'arrive de la faire, par exemple un choix de couleur géré par un UserForm de 2ème niveau appelé par un UserForm de 1er niveau.

Je m'absente, retour dans 2 heures.

 

[jurassic pork]

Ben en fait cela fonctionne dans les deux sens si on clique sur un élément qui est en dessous de la zone visible (exemple : élément 100)
On arrive à remonter avec la molette mais quand on arrive sur l'élément 1 on ne peut plus redescendre avec la molette.

Le problème doit se situer dans ce code pour le forward:

                    Set iAcc = TextBox
                    lScrollBarWidth = GetSystemMetrics(SM_CXHTHUMB)
                    With uRect
                        iAcc.accLocation .Left, .Top, .Right, .Bottom
                        .Left = .Right + .Left - lScrollBarWidth
                        .Right = .Left + lScrollBarWidth
                        .Bottom = .Bottom + .Top
                    End With
                    With uRect
                        uP1.X = .Left + 5&:   uP1.Y = .Top + lScrollBarWidth / 2&
                        uP2.X = .Right - lScrollBarWidth + 5&: uP2.Y = .Bottom - lScrollBarWidth + 5&
                    End With
                 
                    If eScrollDirection = Forward Then
                        If GetAncestor(WndFromPoint(uP1.X, uP1.Y), GA_ROOT) = GetProp(Application.hwnd, "Hwnd") Then
                            Call ClickAtPosition(uP1.X, uP1.Y, nScrollLines)
                        End If
                    Else
                        If GetAncestor(WndFromPoint(uP2.X, uP2.Y), GA_ROOT) = GetProp(Application.hwnd, "Hwnd") Then
                            Call ClickAtPosition(uP2.X, uP2.Y, nScrollLines)
                        End If
                    End If

 

[patricktoulon]

re
tiens @Dudu2 tu va comprendre
prend un fichier vierge et met lui 2 userforms
dans le userform1 met lui ce code

Dim cls As Classe1

Private Sub UserForm_Activate()
Set cls = New Classe1
End Sub

Private Sub UserForm_Click()
UserForm2.Show
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 'on change quelque chose dans la commandbar pour faire réagir l'event de la classe
Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled
 Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled
End Sub

dans le userform2 ne met rien
ajoute un module classe

Public WithEvents oCmndBars As CommandBars

Private Sub Class_Initialize()
Set oCmndBars = Application.CommandBars
End Sub

Private Sub oCmndBars_OnUpdate()
Unload UserForm1
Set oCmndBars = Nothing

End Sub

voila on y est
ouvre le userform 1 et click dessus le userform2 va s'afficher et maintenant ferme le userform2 😉

explication:
le userform2 a été ouvert par le userform1 donc l'event queryclose du userform1 va fonctionner pour le userform2
au queryclose on modifie quelque chose dans la commandbar ce qui va declencher l'event update dans la classe
dans cet event tu fait ce que tu veux
en l'occurrence ici je ferme le 1
rigolo comme c'est tordu le truc non?🤪🤪🤪

à la fermeture du 2 l'eventupdate
ferme le 1 l
'events est nothing
et la classe est détruite puisque c'est dans le userform1 qu'elle a été créée

 

[jurassic pork]

tiens patricktoulon tu peux regarder le code que j'ai mis dans mon message précédent car il est franchement bizarre .
le RECT est défini comme ceci :

Private Type RECT
    Left As Long
    Top As Long
    right As Long
    bottom As Long

End Type

et dans le code il fait :

                   With uRect
                        iAcc.accLocation .Left, .Top, .Right, .Bottom

uRect étant un Rect mais normalement accLocation c'est Left , Top, Width, Height

 

[jurassic pork]

Bon ben finalement c'est scroll direction qui est pas bon :
il ne bouge pas en 64 bits

 

[Dudu2]

Mouais, pour ma part j'en resterai là avec le code de Jaafar tribak et sa boucle de luxe !

@patricktoulon,
Merci pour l'exemple avec la CommandBar.
Cependant je note que tu fais des trucs dans la CommandBar sur le FindControl(ID:=2040) pour faire marcher ce système.
Je supposais que la fermeture d'un UserForm provoquait naturellement l'évènement sans autre intervention.

 

[patricktoulon]

Mouais, pour ma part j'en resterai là avec le code de Jaafar tribak et sa boucle de luxe !

@patricktoulon,
Merci pour l'exemple avec la CommandBar.
Cependant je note que tu fais des trucs dans la CommandBar sur le FindControl(ID:=2040) pour faire marcher ce système.
Je supposais que la fermeture d'un UserForm provoquait naturellement l'évènement sans autre intervention.

re oui dans certain cas oui des fois on a besoins de rien faire
non @jurassicpork c'est bon c'est vrai qu'il utilise right et bottom mais dans IAccesible mais si tu regarde avant


on vois bien quie pour le left il prend le left + leright+la poitié de la scrollbar

  lScrollBarWidth = GetSystemMetrics(SM_CXHTHUMB)
                    With uRect
                        iAcc.accLocation .Left, .Top, .Right, .Bottom
                        .Left = .Right + .Left - lScrollBarWidth
                        .Right = .Left + lScrollBarWidth
                        .Bottom = .Bottom + .Top
                    End With
                    With uRect
                        uP1.X = .Left + 5&:   uP1.Y = .Top + lScrollBarWidth / 2&
                        uP2.X = .Right - lScrollBarWidth + 5&: uP2.Y = .Bottom - lScrollBarWidth + 5&
                    End With

ICI ILPREND LE LEFT DE LA SCROLLBAR
.Left = .Right + .Left - lScrollBarWidth
ICI IL PREND LE RIGHT DE LE SCROLLBAR
.Right = .Left + lScrollBarWidth
DONC POUR MOI SON RECTANGLE SCROLLBAR EST JUSTE

Donc il envoie bien le right et non le width
c'est seulement qu'il aurait pu changer le non des variables c'est tout
de tout façon vous cherchez là ou il y a pas la place puisque ca marche sur 32 et 2016 en 64
1 pixel en 2016 et 1 pixel en 2021 c'est le même
c'est ailleurs qu'il faut chercher
cet aprem sur un 365 qui utilise 2019 en 64 il fonctionnait
je le répète c'est ailleurs qu'il faut chercher

 

[jurassic pork]

cet aprem sur un 365 qui utilise 2019 en 64 il fonctionnait
je le répète c'est ailleurs qu'il faut chercher

Ben Chez moi en Excel 2021 64 bits Windows 11 cela ne fonctionne pas :

dans l'animation dans un premier temps je bouge la molette vers le bas puis vers le haut
on voit très bien que le Scroll Direction ne change pas et que les données Rotation ne sont pas bonnes :
Normalement elles doivent être négatives puis positives . Là on a que des valeurs positives. Il y a typiquement une erreur dans le traitement. Dudu2 qui a un Excel 2016 64 bits a le même problème (voir son animation au post #501)
Demande à ton grand gourou ce qu'il en pense.

 

[patricktoulon]

Bon dans tous les cas vous l'avez compris le principe est de taper dans la scrollbar
il nous faut donc
les api showcursorpos
getcursoprpos et setcursorpos
sendimput ou Sub mouse_event

on capte le position du curseur
on capte le rectangle
on le reduit a la scrollbar
on cache le curseur
on place le curseur sur la scrollbar
on applique soit le message avec sendinput soit le mous event
on remet le curseur a sa place initiale
et selan a chaque cran de roulette

si vous utiliser le message
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
et il vous faudra comptabiliser le coup de scroll et le repéter a chaque tour

par contre si vous utilise les le coin droite et haut pour monter et le droite et bas pour descendre le scroll on utilise ra le message simple
Private Const MOUSEEVENTF_CLICKLEFT = &H2 Or &H4 ' LEFTDOWN + LEFTUP
avec l api mouse event
terminé
maintenant @Dudu2 à toi 😉
je te sent bien là 🤣
j'ose a peine dire que si on se servait d'un tel principe cela serait valable pour tout les control ayant la scrollbar

a si? je l'ai dit bon ben c'est dit alors 😉

 

[jurassic pork]

Mouais, pour ma part j'en resterai là avec le code de Jaafar tribak et sa boucle de luxe !

Ben moi aussi, ce n'est pas mon code

 

[Dudu2]

maintenant @Dudu2 à toi
je te sent bien là 🤣
j'ose a peine dire que si on se servait d'un tel principe cela serait valable pour tout les control ayant la scrollbar

Je trouve le principe d'aller taper avec la souris sur des éléments du Control comme la solution que tu utilises quand tu es dans le désespoir total 😩. Nos .Curline, .TopIndex et .ScrollTop sont quand même plus sérieux. Mais bon, c'est son code et chacun choisit sa méthode.

Edit: Et comme je l'ai indiqué plus haut, une TextBox ActiveX peut ne pas avoir de Vertical ScrollBar. Et alors, on clique où pour scroller ?

 

[patricktoulon]

moi je trouve que pour le textbox c'est sa version qui est plus sérieuse et plus pro que les nôtres
il faut pas oublier qu'il n'applique aucun changement dans le textbox nous on change le curline
autant je montre au front quand je suis sur de moi (tu me connais) mais là il faut reconnaitre qu'il tape fort
et c'est limpide à l'utilisation (pour ceux chez qui ça marche )
apres comme je l'ai dit tu n'est pas obligé d'utiliser la souris tu peux utiliser sendinput
mais je reconnais que j'ai eu du mal a le digérer surtout anen principe classe pilote et classe fille comme ça
après on est pas obligé de faire tout ça ce qui nous intéresse c'est le moteur de scroll