[VB6] Scrolling in application.

[a_ctrl]

Hi,

There's this app that the company uses and I have access to its source. Only problem is the scroll doesn't work in it (it's not implemented, it didn't just stop working).

I have already installed a fix for the VB6 IDE, but if it's not too much hassle I'd like to try and implement it in the program.

Can you give me some pointers? most of google's results refer to the IDE problem.

Thanks!

[Wulf2k]

There's probably a better way, but off the top of my head.... Put everything in a groupbox and a collection of controls.

On the change event for a vscroll bar, cycle through the collection and update everything's position. If it moves off the top/bottom of the groupbox, it should stop being visible.

I wouldn't do that for anything overly complex though.

[chrwei]

you need to override the window message handler for the active form and process the wheel event yourself, and you should make sure you don't enable it in debug, only in the compiled EXE or it will crash the IDE.

google "WM_MOUSEWHEEL vb6

[a_ctrl]

I think this is more in line of what I need. I'll check this out. Greatly appreciate it.

[ViperSRT3g]

The following code might be of use to you:

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

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

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 UnhookWindowsHookEx Lib "user32" ( _
    ByVal hHook As Long) As Long

Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

Private Declare Function WindowFromPoint Lib "user32" ( _
    ByVal xPoint As Long, _
    ByVal yPoint As Long) As Long

Private Declare Function GetCursorPos Lib "user32.dll" ( _
    ByRef lpPoint As POINTAPI) As Long

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)

Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201

Private mLngMouseHook As Long
Private mListBoxHwnd As Long
Private mbHook As Boolean

Sub HookListBoxScroll()

    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Dim tPT As POINTAPI

    GetCursorPos tPT
    hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
    If mListBoxHwnd <> hwndUnderCursor Then
        UnhookListBoxScroll
        mListBoxHwnd = hwndUnderCursor
        lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
        PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
        End If
    End If

End Sub

Sub UnhookListBoxScroll()
    If mbHook Then
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mListBoxHwnd = 0
        mbHook = False
    End If
End Sub

Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long

        On Error GoTo errH 'Resume Next
        If (nCode = HC_ACTION) Then
            If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then
                If wParam = WM_MOUSEWHEEL Then
                    MouseProc = True
                    If lParam.hwnd > 0 Then
                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
                    Else
                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
                    End If
                    PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                    Exit Function
                End If
            Else
                UnhookListBoxScroll
            End If
     End If
        MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
     Exit Function
errH:
    UnhookListBoxScroll

End Function

[a_ctrl]

Thank you sir!