Bueno, yo no uso OCX, creo que ya lo sabran todos.. Pero aca dnode laburo, si. Por tal motivo, tuve que hacer un codigo que permita scrollear los MSHFlexGrids (y Listbox).
La opcion mas sencilla era hacer un hook al Mouse, que de hecho, funciona bien. El problema es que en la aplicacion, se corren sentencias SQL muy raras, que hacen que el soft quede trabado unos segundos...
Dicha situacion hace que el sistema no le de mas bolilla al Wide Hook que puse en la aplicacion.
Solucion? Wide Hook del WH_WNDPROC (copiado mas o menos del ejemplo del Skinner de Leandro). Con eso, se puede obtener los mensajes de todas las ventanas del ThreadID actual (VB usa un solo thread, asi que uso eso como filtro; si no, caerian mensajes de todas las ventanas de windows).
En fin, la gracia de esto es no usar una funcion para cada objeto (ni cada form que contenga uno), ya que esto es global (a nivel de la aplicacion) y no requiere que el objeto tenga foco.
V2!
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type CWPSTRUCT
lParam As Long
wParam As Long
message As Long
hWnd As Long
End Type
Private Enum HookConstants
HC_ACTION = 0
HC_GETNEXT = 1
HC_SKIP = 2
HC_NOREMOVE = 3
HC_NOREM = HC_NOREMOVE
HC_SYSMODALOFF = 5
HC_SYSMODALON = 4
End Enum
Private Const WH_MOUSE_LL As Long = 14
Private Const WH_CALLWNDPROC As Long = 4
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WM_VSCROLL As Long = &H115
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_CREATE As Long = &H1
Private Const WM_DESTROY As Long = &H2
'* The SetWindowsHookEx function installs an application-defined hook procedure into a hook chain. You would install a hook procedure to monitor the system for certain types of events. These events are associated either with a specific thread or with all threads in the system.
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
'* The UnhookWindowsHookEx function removes a hook procedure installed in a hook chain by the SetWindowsHookEx function.
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
'* The CallNextHookEx function passes the hook information to the next hook procedure in the current hook chain. A hook procedure can call this function either before or after processing the hook information.
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) 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
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
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 GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private m_lHook As Long
Private Function HookProc(ByVal uCode As Long, ByVal wParam As Long, lParam As CWPSTRUCT) As Long
On Local Error Resume Next ' No use of a event handler in hooking procedures
Dim ptMouse As POINTAPI
HookProc = CallNextHookEx(m_lHook, uCode, wParam, lParam)
' si es un mensaje de mouse wheel, agarrarlo
If (uCode = HC_ACTION) And (lParam.message = WM_MOUSEWHEEL) Then
' obtener posicion del mouse
Call GetCursorPos(ptMouse)
' scrollear flex
Call DoGenericScroll(WindowFromPoint(ptMouse.x, ptMouse.y), lParam.wParam < 0)
End If
End Function
Private Sub DoGenericScroll(ByVal lWndUnderMouse As Long, ByVal bUp As Boolean)
Dim lVScrollWnd As Long
Dim lParentWnd As Long
' Obtiene el Hwnd de la barra de Scroll vertical del DataGrid
lVScrollWnd = FindWindowEx(lWndUnderMouse, 0, "ScrollBar", "DataGridSplitVScroll")
' ver que tipo de clase es
Select Case WndClass(lWndUnderMouse)
Case "DataGridWndClass", "MSHFlexGridWndClass", "MSFlexGridWndClass", _
"ThunderTextBox", "ThunderRT6TextBox", "ThunderListBox", "ThunderRT6ListBox"
Case "ThunderComboBox", "ThunderRT6ComboBox"
Case "Edit"
If (WndClass(GetParent(lWndUnderMouse)) = "ThunderComboBox") Or _
(WndClass(GetParent(lWndUnderMouse)) = "ThunderRT6ComboBox") Then
lWndUnderMouse = GetParent(lWndUnderMouse)
Else
Exit Sub
End If
Case Else: Exit Sub
End Select
Debug.Print "scroll: "; lVScrollWnd; " under: "; lWndUnderMouse
If Not (lVScrollWnd = 0) Then
SendMessage lWndUnderMouse, WM_VSCROLL, IIf(bUp, 1, 0), ByVal lVScrollWnd
Else ' no se encontro la barra... probar con scroll sin definir de donde viene
SendMessage lWndUnderMouse, WM_VSCROLL, IIf(bUp, 1, 0), ByVal 0&
End If
End Sub
Public Function StartMouseHook() As Boolean
If Not (m_lHook = 0) Then
Exit Function
End If
m_lHook = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf HookProc, 0, App.ThreadID)
StartMouseHook = Not (m_lHook = 0)
End Function
Public Function StopMouseHook() As Boolean
If m_lHook = 0 Then
Exit Function
End If
Call UnhookWindowsHookEx(m_lHook)
m_lHook = 0
StopMouseHook = True
End Function
Private Function WndClass(ByVal lHandle As Long) As String
Dim sBuffer As String * 256
WndClass = Left$(sBuffer, GetClassName(lHandle, sBuffer, 256))
End Function
Espero alguna respuesta! saludos
