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]

si je roule trop vitre par exemple 30 petits crans de roulette je scroll que de 1/4 item ou de 1/4 (le pas pour la frame et autre control ayant le scrolltop)

Chez moi je ne ressens pas du tout ce phénomène.
Si je scrolle un grand coup de roulette, ça scroll en conséquence et si je scrolle doucement, ça scroll léger.

Scroll grands coups de roulette:

Scroll petits coups de roulette rapides:

 

[patricktoulon]

c'est pas petit coup et grand coup c'est vite et lentement
après peut être est ce un problème de poids avec copymemory en 32

 

[jurassic pork]

c'est pas petit coup et grand coup c'est vite et lentement
après peut être est ce un problème de poids avec copymemory en 32

moi j'ai des soucis en 64 bits pas en 32 bits.

 

[Dudu2]

Quels genres de soucis ? Les mêmes ? Sur tous les Controls ?

Dans ce cas il faudrait déterminer d'où vient le non traitement des évènements de Scroll.
Est-ce le temps de Scroller le Control ou autre chose.

 

[jurassic pork]

Quels genres de soucis ? Les mêmes ? Sur tous les Controls ?

Dans ce cas il faudrait déterminer d'où vient le non traitement des évènements de Scroll.
Est-ce le temps de Scroller le Control ou autre chose.

Si je bouge rapidement la molette dans les deux sens au bout de quelques secondes le scroll ne se fait plus et si j'arrête de bouger la molette, je vois encore des effets quelques secondes après comme si c'était "bufferisé"
[EDIT] oops cela ne le fait plus cela fonctionne normalement maintenant.
Je vais refaire un essai avec le hook de patricktoulon

 

[Dudu2]

Si je bouge rapidement la molette dans les deux sens au bout de quelques secondes le scroll ne se fait plus

Je n'ai pas ce phénomène. Core I5.

 

[jurassic pork]

Je n'ai pas ce phénomène. Core I5.

ben cela ne me le fait plus . Je me demande si c'est pas parce que j'avais lancé le module avec hook de patricktoulon juste avant. Avec le module hook de patricktoulon cela me le fait à chaque fois jusqu'à ne plus avoir d'effet de la molette sur le scroll.

 

[patricktoulon]

mis part que dudu2 met le pointapi en longlong dans le getstructure en 64 bits , je ne vois pas
puisque le reste c'est pareil
c'est donc bien un effet dans copymemory
a voir si on peut pas convertir celle là aussi pour virer copymemory

dudu2

Private Type MSLLHOOKSTRUCT
#If Win64 Then
    Pt As LongLong
#Else
    Pt As POINTAPI
#End If
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

moi

Private Type MSLLHOOKSTRUCT: pt As POINTAPI: mouseData As Long: flags As Long: time As Long: dwExtraInfo As LongPtr: End Type

ca peut être que ca" puisque dans le mien plus aucun calcul n'est fait a part la présence dans le rectangle qui est mémorisé avant
mais bon on est pas dans la bonne discussion là

 

[Dudu2]

Je viens de modifier à l'instant la Ressource de Scroll pour modifier le Scroll TextBox et le rendre plus "intelligent".
@patricktoulon, tu as dû être notifié car partie de la discussion.
J'y ai passé plusieurs heures car la chose n'est pas du tout facile même si en scrollant on ne voit pas où est la difficulté.

 

[patricktoulon]

on a la même théhorie même si on ne l'ecrit pas pareil

Case TypeOf CtrlHooked Is TextBox Or TypeName(CtrlHooked) = "TextBox"
                Dim HL, CCR, nbL
                nbL = Int(CtrlHooked.Height / (CtrlHooked.Font.Size * 1.2))
                CCR = CtrlHooked.CurLine Mod nbL
                'MsgBox nbL
                If Mdata > 0 Then
                    If CCR > 0 Then CtrlHooked.CurLine = CtrlHooked.CurLine - (CCR - 1) 'Else .CurLine = Application.Max(0, .CurLine - 1)
                Else
                    If CCR < nbL Then CtrlHooked.CurLine = CtrlHooked.CurLine + (nbL - (CCR) - 1) 'Else .CurLine = Application.Min(.LineCount - 1, .CurLine + 1)
                End If

j'ai bloqué les up down pour que l'on voit le caret se positionner en bas ou en haut

 

[Dudu2]

Juste pour info, je mets ici le code du Scroll de la TextBox que j'ai commenté davantage après un accouchement difficile.

'------------------
'Scroll for TextBox
'------------------
Private Function Scroll_TextBox(Up As Boolean) As Boolean
    Dim VerticalScrollBar As Boolean
    Dim NbLignesParPage As Integer
    Dim NbLignesScroll As Integer
    Dim CurlineIdentique As Boolean
    '
    Static CurrentTextBox As Object
    Static LastCurline As Integer
    Static LastAction As Integer
   
    'Changement de TextBox
    If Not CurrentTextBox Is ControlHooked Then
        Set CurrentTextBox = ControlHooked
        LastCurline = 0
        LastAction = 0
    End If
   
    With ControlHooked
        'Nombre de lignes de Scroll par défaut
        NbLignesScroll = ScrollStep
       
        'Détection de la Scroll Bar verticale
        If .ScrollBars = fmScrollBarsVertical _
        Or .ScrollBars = fmScrollBarsBoth Then
            VerticalScrollBar = True
            NbLignesParPage = Int(.Height / (.Font.Size * 1.2))
        End If
    End With

    On Error Resume Next
    With ControlHooked        
        If VerticalScrollBar Then
            If LastAction = 0 Then LastCurline = .Curline
            CurlineIdentique = (LastCurline = .Curline)
        End If
       
        'Scroll Up
        If Up Then
            If VerticalScrollBar Then
                'Inversion du Scroll (Down -> Up) sans modification de la Curline ou tout début du Scroll en TextBox
                If (CurlineIdentique And LastAction = 1) Or LastAction = 0 Then
                    'Pour provoquer une décalage Scroll Bar et pas un simple décalage ligne
                    NbLignesScroll = NbLignesParPage
                Else
                    'Sinon c'est un décalage ligne qui provoquera naturellement un décalage Scroll Bar le cas échéant
                End If
               
                'Flag Scroll Up
                LastAction = -1
            End If
           
            .Curline = Application.Max(0, .Curline - NbLignesScroll)
       
        'Scroll Down
        Else
            If VerticalScrollBar Then
                'Inversion du Scroll (Up -> Down) sans modification de la Curline ou tout début du Scroll en TextBox
                If (CurlineIdentique And LastAction = -1) Or LastAction = 0 Then
                    'Pour provoquer une décalage Scroll Bar et pas un simple décalage ligne
                    NbLignesScroll = NbLignesParPage
                Else
                    'Sinon c'est un décalage ligne qui provoquera naturellement un décalage Scroll Bar le cas échéant
                End If
               
                'Flag Scroll Down
                LastAction = 1
            End If
           
            .Curline = Application.Min(.LineCount - 1, .Curline + NbLignesScroll)
        End If
       
        If VerticalScrollBar Then
            'Il y a eu un clic au milieu de la TextBox => on passe en mode décalage ligne
            If Not CurlineIdentique Then LastCurline = -1
            If Not LastCurline = -1 Then LastCurline = .Curline
           
            'La première et la dernière ligne réactivent le mode décalage Scroll Bar
            If .Curline = 0 Or .Curline = .LineCount - 1 Then LastCurline = .Curline
        End If
    End With
   
    If Err.Number = 0 Then
        'Return value
        Scroll_TextBox = True
    End If
    On Error GoTo 0
End Function

 

[jurassic pork]

Bonjour @jurassic pork
le classeur de dudu plante au bout de 15/20 scroll c'est tout et quand ca plante malheureusement ca crash excel

Hello,
tu es avec quelle version d'Excel quand tu fais cette manipulation ?
Parce que moi j'ai essayé sur toutes mes configs et je n'ai pas ce phénomène sauf quand je bouge la molette souris comme un forcené mais jamais avec un crash.
Par contre ton classeur lui sous excel 2021 64 bits, ne fonctionne pas bien et peut me faire planter excel et je suis obligé de redémarrer windows pour ne pas avoir d'effets dans le classeur de dudu2 par exemple.
Ami calmant, J.P

 

[jurassic pork]

Donc le MultiThreading Excel, à part la lourdeur des instances d'Excel, il faut oublier.

Hello,
En effet et même avec une autre instance Excel , on aura pas le contexte de scroll de ton classeur. Et d'ailleurs dans quel cas est-ce utile ? parce qu'en fait du scroll d'un contrôle normalement on ne fait pas autre chose. Le seul cas que je vois , c'est qu'on a lancé un timer rapide qui exécute du code VBA mais cela me paraît improbable (sauf l'affichage d'un chrono).
Ami calmant, J.P

 

[patricktoulon]

@jurassic pork
re et oui mais tes test sont fait avec des win vierge dans un virtualbox
moi j'ai tout mon system et peut être que des mises ajour win ont modifier des choses
après qu'il déconne en 64 je suis pas étonné la structure doit recevoir un longlong et non un pointapi
dudu2 converti dans sa version moi je le fait pas
sinon tout le reste c'est pareil pour la lowlevelmouse
windows 10 office 2013 pro plus

 

[Dudu2]

Bonjour à tous,

qu'en fait du scroll d'un contrôle normalement on ne fait pas autre chose.

Certes, mais tant que le curseur reste dans le Control scrollé, la boucle tourne.
Tu es dans un Frame scrollé et le curseur est placé dans une petite TextBox du Frame non scrollée pour saisie, la boucle tourne (*).
Et il y a du code sur les évènements de la TextBox qui sont supposés tourner en parallèle de la boucle.
Encore qu'avec des évènements le parallélisme semblerait fonctionner mais je n'ai pas creusé.
Et même ce code lié à la TextBox peut vouloir lancer une séquence avec un OnTime (**) qui elle ne s'exécutera pas tant que la boucle tourne.

(*) Ce qu'il faudrait peut-être faire, c'est arrêter la boucle de Scroll si le curseur est sur un objet quelconque (scrollé ou non) qui n'est pas l'objet scrollé. Parce que pour l'instant, nos codes ne considèrent que les objets scrollés. Mais ça ne rendrait pas le système évènementiel pour autant.

(**) Ça m'arrive de faire ça par exemple dans un QueryClose d'un UserForm vbModeless pour relancer un traitement après la fermeture dudit UserForm. Même si dans ce cas particulier la boucle se sera arrêtée par disparition du Control scrollé (erreur sur Control.Visible dans mon code).