mouse_event(-MOUSEEVENTF_WHEEL, 0, 0, WHEEL_DELTA, 0) en windows 7 (VB6)

[joise]

hola, en Visual Basic 6 tengo un problema, parece ser que el mouse_event() para mover la ruedita no funciona en windows 7 o no se que le pasa porque en windows xp anda perfecto y en windows 7 no anda, aca les dejo un ejemplo sencillo para que lo prueben:

en un EXE estandar pongan un Listbox

en el formulario escriban lo siguiente

Código:

Private Sub Form_Load()
For i = 1 To 200
List1.AddItem (i)
Next i
List1.ListIndex = 100
End Sub

Private Sub List1_Click()
Call mouse_event(-MOUSEEVENTF_WHEEL, 0, 0, WHEEL_DELTA, 0)
End Sub

luego agreguen un modulo y escriban lo siguiente

Código:

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Public Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Public Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Public Const WHEEL_DELTA = 120
Public Const MOUSEEVENTF_WHEEL = &H800

Denle iniciar y hagan click en el listbox.
En windows xp la barrita hace scroll hacia arriba, pero en windows 7 no se mueve.

Una aclaracion, el objetivo de la pregunta no es hacer mover la barrita del listbox, sino que quiero que funcione el scroll mouse_event() en windows 7. Asqiue por favor me gustaria que me digan porque no funciona el scroll mouse_event() en windows 7.

Otra aclaracion, el movimiento del mouse y los 3 botones funcionan bien en xp y en 7, lo unico que no funciona es la ruedita cuando quiero hacer scroll.

Cualquier detalle que necesiten pidanme.
Desde ya muchas gracias.

[JonathanB]

Ya has probado "Ejecutar en modo de compatibilidad"?

[truskyvb]

En Windows 7 conseguí resolverlo de la siguiente manera:


Form_Load
HScroll1.Value = 1
HookForm HScroll1
End Sub
'-------------------

Private Sub HScroll1_Change()
On Error Resume Next

' Definimoc una variable estática
Static Sumar As Integer
If Sumar = 0 Then Sumar = 1

If HScroll1.Value = HScroll1.Min Then
Sumar = 1
HScroll1.Value = HScroll1.Value + Sumar

'Const Sumar = 1
'HScroll1.Value = HScroll1.Value + Sumar

Direccion = -1
ElseIf HScroll1.Value = HScroll1.Max Then
Sumar = -1
HScroll1.Value = HScroll1.Value + Sumar

Direccion = 1

end if
End Sub
'---------------

Private Sub Form_Unload(Cancel As Integer)
'--Terminamos el gancho
UnHookForm HScroll1
End Sub

'------------

MODULE1.BAS
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Public Const GWL_WNDPROC = (-4)
Dim PrevProc As Long

Public Sub HookForm(Scroll As Object)
PrevProc = SetWindowLong(Scroll.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(Scroll As Object)
SetWindowLong Scroll.hWnd, GWL_WNDPROC, PrevProc
End Sub
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
Dim retval As Long

If uMsg = 49283 Or uMsg = 522 Then

If wParam < 0 Then
'envio la señal de la tecla "AvPág" presionada y luego soltada
retval = SendMessage(hWnd, 256, ByVal 34, ByVal CLng(0))
retval = SendMessage(hWnd, 257, ByVal 34, ByVal CLng(0))
Else
'envio la señal de la tecla "RePág" presionada y luego soltada
retval = SendMessage(hWnd, 256, ByVal 33, ByVal CLng(0))
retval = SendMessage(hWnd, 257, ByVal 33, ByVal CLng(0))
End If
End If
'Debug.Print uMsg, wParam, lParam
End Function
'-------------



Espero que te sirva.
Un saludo