Ver Mensaje Individual
  #3 (permalink)  
Antiguo 25/02/2012, 15:18
truskyvb
 
Fecha de Ingreso: octubre-2008
Mensajes: 188
Antigüedad: 16 años, 5 meses
Puntos: 3
Respuesta: mouse_event(-MOUSEEVENTF_WHEEL, 0, 0, WHEEL_DELTA, 0) en windows 7 (VB6)

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

Última edición por truskyvb; 25/02/2012 a las 15:48