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]

Il y a plus simple : GetDpiForWindow() :

Declare PtrSafe Function GetDpiForWindow Lib "user32" (ByVal hWnd As LongPtr) As Integer
Sub GetDpi()
    Debug.Print GetDpiForWindow(Application.Hwnd)
End Sub

cela me donne 120 quand je suis en mise à l'échelle à 125%
et 96 à 100%

 

[patricktoulon]

oui c'est ce que j'avais au depart et souvient toi tu m'a dit que ca ne fonctionne pas sur 2007 qu'elle n'existait tout simplement pas sur Windows 7

 

[patricktoulon]

et le coeff c'est(si je ne me trompe pas
Debug.Print 1/(GetDpiForWindow(Hwnd)/72)

 

[jurassic pork]

Oki je ne m'en rappelai pas

 

[Dudu2]

Avec ce code:

Function PpX()
   Dim z#
   With ActiveWindow.Panes(1)
        z = .Parent.Zoom / 100
        PpX = 1 / ((.PointsToScreenPixelsX(72 / z) - .PointsToScreenPixelsX(0)) / 72)
    End With
End Function

j'obtiens ça en fonction du Zoom.

 

[Dudu2]

Pour l'échelle j'ai cette fonction qui marche chez moi.

'----------------
'Scale of display
'----------------
Function DisplayScale() As Double
    With Application
        DisplayScale = GetDpiForWindow(.hwnd) / 96
    End With
End Function

 

[patricktoulon]

j'attire ton attention sur "Lib"user32" alors que leo t a repondu

je sais ou qu y va chercher ses source celui là 🤪 🤪 🤪 🤪

@Dudu2 oui c'est pas précis en 125% je sais mais que veux tu si on veux quelque chose de compatible 2007 à 2024 il faut faire des consséssion
ou des usine a gaz de déclarations pour un coeff p to px
chez moi en 100% c'est 0.75 tout le temps

 

[Rheeem]

Attention le accLocation n'est pas toujours disponible et pour une ListBox cela me renvoyait 0 0 0 0

Teste sur un userform, ca fonctionne mais sur le classeur renvoie 0
si on veut avoir les cordonnées du premier item visible ca fonctionne :

 Dim acc As IAccessible
Dim l As Long, t As Long, w As Long, h As Long
Set acc = ListBox1
 
acc.accLocation l, t, w, h, ListBox1.TopIndex + 1

MsgBox l & "  " & t & " " & w & " " & h

La listBox à son propre handle que'on peut utiliser pour récupérer ses cordonnées

 

[patricktoulon]

et oui

 

[Dudu2]

il faut faire des consséssion ou des usine a gaz de déclarations pour un coeff p to px

Je sais que ton but c'est de minimiser les lignes code. Déclarer 3 fonctions API de plus ce n'est pas pour moi une usine à gaz.
Ce sont juste de déclarations et ça ne génère pratiquement rien à part des références en interne.
Je préfère avoir un résultat 100% correct dans tous les cas.

Chez moi en 100%

 

[patricktoulon]

Teste sur un userform, ca fonctionne mais sur le classeur renvoie 0
si on veut avoir les cordonnées du premier item visible ca fonctionne :

 Dim acc As IAccessible
Dim l As Long, t As Long, w As Long, h As Long
Set acc = ListBox1
 
acc.accLocation l, t, w, h, ListBox1.TopIndex + 1

MsgBox l & "  " & t & " " & w & " " & h

La listBox à son propre handle que'on peut utiliser pour récupérer ses cordonnées

et oui mais c'est la" ou ca coince la combo a son topindex à-1 quand elle est repliée
cela dit c'est une belle trouvaille dans un autre registre pour avoir la hauteur d'une ligne par exemple
et là je vois dudu2 faire les gros yeux intéréssés 😉

 

[Dudu2]

et là je vois dudu2 faire les gros yeux intéréssé

Certes, comme toujours.

Mais de mon coté j'ai 3 versions du Scroll:
- 1 Version avec UIAutomation (pour Excel 2016+)
- 2 Versions sans UIAutomation (pour toutes versions Excel y compris 2013-) sur des principes différents:
--- WindowFromPoint et ControlRECT pour les TextBox
--- ControlRECT pour tous les Controls
qui fonctionnent à 100% toutes les 3.
Alors...

cela dit c'est une belle trouvaille dans un autre registre pour avoir la hauteur d'une ligne par exemple

Je vais suivre cette affaire... Mais je n'ai pas compris comment obtenir cette hauteur de ligne.

 

[patricktoulon]

Je vais suivre cette affaire... Mais je n'ai pas compris comment obtenir cette hauteur de ligne.

ben le T de l'une - le T de celle du dessus ma fois et *ptpx tu obtient la hauteur en point

souvient toi le sujet de la listbox adapté a la taille des item sans scroll bar
ben voila tu l'a ta solution et en plus on passe par le com et pas par l'api
c'est pas bo' la vie

Dim acc As IAccessible
Dim l As Long, t As Long, w As Long, h As Long,t2
Set acc = ListBox1
 
acc.accLocation l, t, w, h, ListBox1.TopIndex + 1
acc.accLocation l, t2, w, h, ListBox1.TopIndex + 2
MsgBox (t2-t)*ptopx

héééé woila joust' oune petite peeee d'ooo choode
what else
😉
moi aussi j'ai une version qui marche partout full option Iaccessible
j'en ai une autre avec Iaccessible mais autrement
et la dernière dite sans librairie
et d'autre truc ou j'ai fait des essais et découvert plein de choses

la version 4 mais pour W7 et 2007 seulement toujours sans librairie
je sais même pas si je vais merger les deux
j'ai testé sur mon pc p w7SP office 2007 it's fullwork

 

[patricktoulon]

re
@Dudu2 c'est même plus simple que ca
c'est pas un rect
en fait ca donne le left top width et height et non le right et bottom comme les rect
et voila
test vite fait
il faut ajouter width-insidewidth du parent si tu met les bordure ccar l'effect il prend environ 3.5 points

Private Sub UserForm_Click()
    Dim acc As IAccessible
    Dim l As Long, t As Long, w As Long, h As Long, h2 As Long
    Set acc = ListBox1
    ppx = 0.75 ' change le ppx ici pour ta méthode
    acc.accLocation l, t, w, h, ListBox1.TopIndex + 1
    ListBox1.Height = 3.5 + (h * ppx) * ListBox1.ListCount
End Sub

 

[Dudu2]

en fait ca donne le left top width et height et non le right et bottom comme les rect

Ok j'essaierai.
3 questions:
- Ça marche pour tous les Controls ActiveX et UserForm ?
- Les valeurs sont en Pixels ou en Points ?
- Dim acc As IAccessible: ça marche sur Excel 2013 je suppose ?
Je n'aime pas trop ce 3.5