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]

en fait dans la v 4 sans hooking
j'ai trouvé une solution plus simple

Case "TextBox"
            Dim nbl
            nbl = control.Height / (control.Font.Size * 1.2)
            If Onsheet Then control.Activate Else control.SetFocus
            If lDelta > 0& Then
                If Val(control.Tag) = 0 Then control.Tag = 1: control.CurLine = Application.Max(0, control.CurLine - nbl): Exit Sub
                control.CurLine = Application.Max(0, control.CurLine - 1)
            Else
                If Val(control.Tag) = 1 Then control.Tag = 0: control.CurLine = Application.Min(control.LineCount - 1, control.CurLine + nbl): Exit Sub
                control.CurLine = Application.Min(control.LineCount - 1, control.CurLine + 1)
            End If

je vais essayer de l'adapter a mon model hooking
un simple switch entre 0 et 1 et j'utilise va"l pour le tag pour la premiere fois pour ne pas avoir a le mettre aau premier move
terminé
je veux monter et que c'est 1 c'est donc que je suis en bas donc je decal de nbl
si je veux descendre et que c'est 0 alors j'ajoute nbl au curline
et je change les tag bien évidemment

et je sais pas si vous avez vu la vélocité du truc mais avec le hooking on est loin d'avoir cette vélocité et là j'ai un pas de 1 pour le textbox
c'est vraiment tout con en fait

 

[patricktoulon]

et voila adapté aussi sur le model avec hooking

Case TypeOf CtrlHooked Is TextBox Or TypeName(CtrlHooked) = "TextBox"
                Dim nbL
               If .Tag = "" Then .SetFocus: .CurLine = 0: .Tag = 1
               nbL = Int(.Height / (.Font.Size * 1.2))
                  If Mdata > 0 Then
                     If Val(.Tag) = 0 Then .Tag = 1: .CurLine = Application.Max(0, .CurLine - nbL): Exit Sub
              .CurLine = Application.Max(0, .CurLine - 1)
                Else
                    If Val(.Tag) = 1 Then .Tag = 0: .CurLine = Application.Min(.LineCount - 1, .CurLine + nbL): Exit Sub
               .CurLine = Application.Min(.LineCount - 1, .CurLine + 1)
                End If

et dans le lanceur je lui donne le focus et je met le curline a zero si le tag est vide et je met le tag à 1 prêt a descendre

Sub LancerMouseWheel(obj)
    'Appele le hook et ferme eventuellement le précedent sur un autre control
    If Not CtrlHooked Is Nothing Then
        If CtrlHooked Is obj Then UnHookMouse
    End If
    'If obj.Parent Is ActiveSheet Then obj.Parent.ScrollArea = obj.TopLeftCell.Address
   If TypeOf obj Is TextBox Then If obj.Tag = "" Then obj.SetFocus: obj.CurLine = 0: obj.Tag = 1
               Call HookMouse(obj)
End Sub

voila comme on peut le voir ca reste encore assez véloce mais un peu moins que sans hooking

terminé
c'est moins satisfaisant que si j'avais trouver la formule math parfaite mais ca fonctionne

 

[patricktoulon]

grand maitre Jaafar tribak ma donné la solution pour scroller le textbox sans changer le curline

trying to scroll listbox with two commandbutton

hello i'me trying to scroll a listbox with a commandbutton but that dont work Option Explicit Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _...

www.mrexcel.com

punaise c'est du costaud

 

[Dudu2]

Oui c'est costaud, et il fait un RaiseEvent ce que je garderai comme exemple car je ne savais pas faire ça.

Reste que dans sa classe CWheelScroll, il garde son système de boucle sur WaitMessage & PeekMessage dans laquelle il fait sont RaiseEvent au lieu de gérer le Scroll directement comme dans nos code. Donc c'est toujours une boucle. "Sa boucle" d'ailleurs puisque je pense que nos codes viennent de ses précédents exemples plus simples.

 

[patricktoulon]

oui mais on fait du sub classing ( ce que tu n'aime pas) ce qui libère un peu plus de ressources pour d'autres choses puisque la mère ne fait qu'instancier
le raiseevent c'est assez simple en fait à faire
l'avantage c'est que le textbox est scrollé et non le curline modifié
il y a aussi l'astuce de la commandbar que j'utilise déjà dans un autre contexte qui est intéressante pour créer un repère de fermeture quand la class le queryclose et autre event ne les gère pas
bref il a fait un boulot formidable je suis admiratif
ça fait un un peu beaucoup UAG je te l'accorde mais ça a le mérite d'être analysé au moins pour le scroll réel du textbox

 

[Dudu2]

Au fait, son fichier, il Scroll chez toi ? Où c'est juste une démo pour afficher les valeurs ?

 

[patricktoulon]

re

et ça fuse en plus

 

[ChTi160]

Bonsoir le Fil

Chez moi ça fonctionne très bien !

Bonne fin de Soirée
Jean marie

 

[Dudu2]

@ChTi160, je crois que tu es en 32 bits aussi.
Je suis en 2016 64 bits.

 

[patricktoulon]

jaafar triback l'a fait sur 2016 64 bits a testé sur 2013 32 aussi

 

[Dudu2]

Je n'invente rien. A vérifier avec un autre 64 bits.

 

[patricktoulon]

je te crois ,mais ça montre bien qu'il n'y a pas que 32/64 a prendre en compte
le module que vous dites qui marche pas chez vous ou mal fonctionne sur 2021 ,2019 et même 2016 en 64 bits et en 32 bits toutes versions par des membre de dvp
donc tu vois il y a des paramètres que l'on ignore encore
je serait pas étonné que ce soit encore le .net et son genzen je sais plus quoi

 

[jurassic pork]

Je n'invente rien. A vérifier avec un autre 64 bits.

Hello,
ben chez moi cela ne fonctionne pas sur un Excel 2021 64 bits par contre cela fonctionne sur un Excel 2016 32 bits.
Je pense que j'ai localisé où se situe le problème : c'est sans doute au niveau du SendInput .
J'ai comparé le déroulement du code entre le 32 bits et le 64 bits, çà passe aux mêmes endroits et avec des données cohérentes et comme c'est le SendInput qui fait scroller la textBox , j'en déduit que cela doit être cette fonction qui pose problème. J'ai rajouté une ligne qui affiche le retour d'exécution du SendInput qui envoie un MouseLeftDown et un MouseLeftUp :

res = SendInput(2&, uInput(0&), LenB(uInput(0&)))
Debug.Print res

j'ai bien 2 avec le 32 bits et le 64 bits ce qui signifie :

La fonction renvoie le nombre d'événements qu'elle a insérés avec succès dans le flux d'entrée du clavier ou de la souris. Si la fonction renvoie zéro, l'entrée était déjà bloquée par un autre thread. Pour obtenir des informations d'erreur étendues, appelez GetLastError.

Cette fonction échoue quand elle est bloquée par UIPI. Notez que ni l'un ni l'autre GetLastError ni la valeur de retour n'indiquera que l'échec a été causé par le blocage d'UIPI.

A moins que cela soit l'UIPI qui bloque mais cela semble plutôt lié au 32 bits , 64 bits.
Ami calmant, J.P

 

[Dudu2]

Son code est très bien écrit (selon mes références) mais très complexe. Trop pour mon petit cerveau.

1. Pour scroller il fait des clics sur la ScrollBar verticale. Est-ce que ça scrolle s'il elle n'est pas présente ?
   Je préfère de loin la manipulation de la .Curline.
   
   
   
   Edit: ceci dit, il me semble qu'elle vient automatiquement en TextBox UserForm.
   
   
2. Perso je n'aime pas les Get / Let Property. Ça fait savant mais je n'ai pas l'habitude et préfère les affectations standards.
   Mais peut-être ai-je tort et je devrais me renseigner davantage.
   
   
3. 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 ?
   La méthode simple c'est de tester le Control.Visible sous On Error.
   
   
4. Encore une fois, une boucle ça reste un boucle, fut-elle en classe ce qu'on avait d'ailleurs essayé.

 

[Dudu2]

@jurassic pork,
Je ne connais pas le SendInput. Peut-être faudrait-il le remplacer par un mouse_event() ?

Edit: en faisant ça, ça scroll up dans tous les cas. Faudrait affuter.