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 |