XL 2016 VBA - Comment détecter la changement de position d'une fenêtre ?

[Dudu2]

Bonjour,

En gestion des évènements d'une fenêtre on a ces options:

Il n'y a pas d'évènement WindowLayout() comme il y a un évènement UserForm_Layout() et donc on ne peut pas détecter de déplacement de la Window.

Y a-t-il une parade à part faire mouliner sans fin une macro pour surveiller le layout de la Window ?

 

[jurassic pork]

Patrick, le souci avec ton système c'est qu'il y a énormément d'événements qui se produisent quand on bouge la souris

 

[Dudu2]

@jurassic pork,
Si c'est le LongLong alors il faut déclarer le 32bit en Currency.
Il faudrait que @patricktoulon fasse les essais sur sa config.

@patricktoulon,
Je vais regarder ton code de souris.

Sinon, j'ai intégré le code fourni par @jurassic pork dans un module.
Hélas on ne peut pas le mettre directement dans une Classe à cause du AdressOf qui n'a pas de résolution dynamique.
Pour faire suite à la remarque ce @jurassic pork sur les Application.OnTime, puisque l'appel de la fonction utilisateur sur l'Event Move est synchrone, j'ai protégé la fonction de "callaback" d'une double exécution avec un Static car en effet avec ces Hook, on ne sait jamais même si sur un Move la probabilité de simultanéité est minime sauf si la fonction utilisateur appelée dure des plombes.

 

[patricktoulon]

re
et alors?
les pseudos event ne sont appelés par la mouseproc uniquement si la fenêtre a bougé
sinon ca tourne aucune incidence sur le reste des mouse (down/move/up )sur le reste de l'application
mousedown et oldleft sont là pour ça
on est dans le même;principe que set timer sauf que l'on a la possibilité de détetecter a quel moment on demarre le déplacement et a quel moment on arrête
faudra voir les les déclaration 64 sont bonne j'ai un soucis avec la tienne chez moi dans le vba7 sur la copimemory

 

[jurassic pork]

@jurassic pork,
Si c'est le LongLong alors il faut déclarer le 32bit en Currency.

ben en fait un LongPtr fait l'affaire comme dans le code que j'ai modifié

 

[Dudu2]

ben en fait un LongPtr fait l'affaire comme dans le code que j'ai modifié

Et oui parce qu'on est en 64 bits.
Mais le problème vient du 32 bits.

@patricktoulon,
L'idée est originale ! Le truc c'est que je pense aux fonctions de Scroll souris en ListBox, ComboBox TextBox, et je me demande si ça va pas tilter.

 

[jurassic pork]

re
et alors?
les pseudos event ne sont appelés par la mouseproc uniquement si la fenêtre a bougé

oui mais la mouseproc est appelée dès qu'on bouge la souris. Si je fais un point d'arrêt dedans à l'entrée ça me plante mon Excel

 

[jurassic pork]

Et oui parce qu'on est en 64 bits.
Mais le problème vient du 32 bits.

C'est pour cela que le LongPtr a été inventé . 64 bits pour Excel 64 bits , 32 bits pour Excel 32 bits.

 

[patricktoulon]

@jurassic pork regarde l'effet avec la tienne(regarde le curseur)
pour tester je passe tout en vb6 l'api memory me crache excel la declaration n'est pas bonne en vb7 pour 32bits(office 2013)

cela dit ca marche
sauf que l'on le debut et la fin en même temps

 

[Dudu2]

C'est pour cela que le LongPtr a été inventé . 64 bits pour Excel 64 bits , 32 bits pour Excel 32 bits.

Si ça plante chez @patricktoulon, c'est qu'il lui faut aussi 64bits, donc LongPtr ne va pas si c'est ça la cause.
et en 32 bits on a une donnée de 64 bits avec Currency.
Mais il faut que lui le vérifie.

 

[Dudu2]

Par exemple:

#If VBA7 Then
   #If Win64 Then
       Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (Frequency As LongLong) As Long
       Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (TickCount As LongLong) As Long
   #Else
       Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (Frequency As Currency) As Long
       Private Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (TickCount As Currency) As Long
   #End If
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (Frequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (TickCount As Currency) As Long
#End If

 

[Dudu2]

@patricktoulon,

la declaration n'est pas bonne en vb7 pour 32bits(office 2013)

Est-ce que tu peux regarder le fichier du Post #17 et voir où est le problème de déclaration.
Essaie un Currency sur l'un ou l'autre ou les 2 des LongLong en différenciant #Win64.

 

[Dudu2]

Si tu n'as pas le temps, on fera faire des tests par un autre utilisateur 32 bits.

 

[patricktoulon]

@Dudu2 même erreu au même endroit

c'et la

Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As LongLong, ByVal lpfnWinEventProc As LongLong, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long

 

[patricktoulon]

comme ca ca a l'air de fonctionner

#If VBA7 Then
   #If Win64 Then
   Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As LongLong, ByVal lpfnWinEventProc As LongLong, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
   #Else
    Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As LongPtr, ByVal lpfnWinEventProc As LongPtr, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
 
   #End If
   Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
    Private Declare PtrSafe Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As LongPtr) As Long
#Else
    Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As Long, ByVal lpfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As Long) As Long
#End If

 

[Dudu2]

Ok alors dans ce cas, simplement remplacer les LongLong par LongPtr comme l'avait fait @jurassic pork.
Ce n'est pas un problème de data 64bits en 32bits.