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]

Donc on est ???????

OK 😉

 

[patricktoulon]

a tu regardé un peu la version WindowFromPoint?
juste par curiositéchez moi W7 office 2007 et W10 office 2013 pro plus 32 bits elle fonctionne nikel
je dirais même mieux pour les combobox sur feuille elle est mieux
puisque je peux clicker sur le dropbutton sans declencher le do/loop
grasse au jeux de classe choppée
F3 mdcPopup XLDESK ou F3 mdc Popup avec EXCEL7

 

[jurassic pork]

et comme je n'aime pas jeter la version avec windowfrompoint qui elle avec le 64 a parfois des erreurs memoire insuffisante
après quand tu dis que ça te le faisait pas avec l'ancienne version je ne sais pas de la quelle tu parle
les deux versions en piece jointe

Hello,
la version avec windowfrompoint ne fonctionne pas chez moi avec un excel 64 bits :
1 - Erreur de compilation
2 - Après correction rien ne se passe
Ami calmant, J.P

 

[patricktoulon]

Bonjour @jurassic pork
c'est quoi les erreurs et correction que tu a faite?
par ce que j'ai testé ce matin sur 365 w 11 un pc très récent et ça marche

 

[jurassic pork]

Hello Patrick,
tu peux mettre en pièce jointe le fichier avec lequel tu testes ? c'est bien une version excel 64 bits avec laquelle tu testes ?

 

[patricktoulon]

ben je ne sais pas j'ai testé sur le pc portable de mon pot voisin et c'est un pc lonovo qui a moins d'un an donc

le fichier windowfrompoint joint
tu constatera que le switch control est plus simple je vais l'adapter a l'Iaccessible aussi
fini les bLooping et tout y cointi
do/loop while criter et c'est tout essaie aussi sur ton virtual W7

 

[cathodique]

ben je ne sais pas j'ai testé sur le pc portable de mon pot voisin et c'est un pc lonovo qui a moins d'un an donc

le fichier windowfrompoint joint
tu constatera que le switch control est plus simple je vais l'adapter a l'Iaccessible aussi
fini les bLooping et tout y cointi
do/loop while criter et c'est tout essaie aussi sur ton virtual W7

Bonjour tout le monde,

@patricktoulon : Pc win7 64 bit, Office 2010 32 bit, c'est ok pour ce dernier fichier.

Bon dimanche

 

[jurassic pork]

Voilà l'erreur que j'ai en compilation sur mon Excel 2021 64 bits :

En corrigeant comme ceci :

#If VBA7 Then
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Type Msg: hWnd As LongPtr: message As Long: wParam As LongPtr: lParam As LongPtr: time As Long: pt As POINTAPI: End Type
    #If Win64 Then
        Private Const NULL_PTR = 0
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal point As LongLong) As LongPtr
        Function PointApiToLong(point As POINTAPI) As LongLong
            Dim DbLL As LongLong, StructureLL As LongPtr
            StructureLL = LenB(DbLL) + 2&
            If LenB(point) = StructureLL Then CopyMemory VarPtr(DbLL), VarPtr(point), StructureLL
            PointApiToLong = DbLL
            CopyMemory VarPtr(DbLL), 0, StructureLL
        End Function
    #Else
        Private Const NULL_PTR = 0&
        Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
    #End If
    Private Function HiWord(Param As LongPtr) As Integer
        Call CopyMemory(HiWord, ByVal VarPtr(Param) + 2&, 2&)
    End Function  
#Else

je n'ai plus d'erreur mais cela ne fonctionne pas en L1 je n'ai qu'une chose qui s'affiche :

La version Ultimate avec IAccessible , elle, fonctionne avec mon Excel 2021 64 bits

Ami calmant, J.P

 

[patricktoulon]

@jurassic pork
d'accords il ne te donne pas les même classe de fenêtre

merci @ChTi160

 

[patricktoulon]

il va falloir que j’étudie cela
la version Iaccessible je sais elle marche partout
mais ca m'intéresse de régler ce windowfrompoint pour d'autre travaux

 

[Rheeem]

Bonjour,

Private Function HiWord(Param As LongPtr) As Integer
Call CopyMemory(HiWord, ByVal VarPtr(Param) + 2&, 2&)
End Function

Je pense que cette fonction n'est pas correcte , les entiers sont enregistrés en little-endian cela veut dire que le poids fort est le premier dans la mémoire

 

[patricktoulon]

Bonjour @Rheeem
Pourtant ça fonctionne en 32/64 bits et les tests ont été effectués sur divers (et variées) configs 32/64 bits
aucun retour négatifs

 

[jurassic pork]

il va falloir que j’étudie cela
la version Iaccessible je sais elle marche partout
mais ca m'intéresse de régler ce windowfrompoint pour d'autre travaux

Bon j'ai trouvé d'où venait le problème : c'est la fonction PointApiToLong qui n'est pas bonne
cela marche beaucoup mieux avec cette fonction :

Function PointToLongLong(point As POINTAPI) As LongLong
    Dim ll As LongLong, cbLongLong As LongPtr
    cbLongLong = LenB(ll)  
    If LenB(point) = cbLongLong Then CopyMemory ll, point, cbLongLong
    PointToLongLong = ll
End Function

 

[patricktoulon]

donc ce n'est pas les address pointeur mais les pointeurs tout court

Function PointApiToLong(point As POINTAPI) As LongLong
            Dim DbLL As LongLong, StructureLL As LongPtr
            StructureLL = LenB(DbLL)
            If LenB(point) = StructureLL Then CopyMemory DbLL , point, StructureLL
            PointApiToLong = DbLL
            CopyMemory DbLL, 0, StructureLL
End Function

perso une fois le return etabli je vide le tampon
et donc ça fonctionne ou pas ?

 

[Rheeem]

On peut faire le transtypage entre différents types sans le recours à copymemory

        Private Type t8
           L As LongLong
        End Type
      
        Private Function PointApiToLong(point As POINTAPI) As LongLong
          Dim t As t8
          LSet t = point
          PointApiToLong = t.L
        End Function