Have an ActiveX dll with a form with a multi-line textbox and have
sub-classed this textbox to
do a scroll up and down with the middle mouse. Scrolling down is fine, but
on some machines/some
mouses the scroll up is somewhat problematic in that if you do it fast it
either won't scroll or scroll down.
This is with VB6 and Windows XP. The textbox has no scrollbars.

These are the essential bits of code:

In a module:
-----------------------

Private Declare Function CallWindowProc Lib "user32.dll" _
                                        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 SetWindowLong Lib "user32.dll" _
                                       Alias "SetWindowLongA" _
                                       (ByVal hwnd As Long, _
                                        ByVal nIndex As Long, _
                                        ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A

Private Const SB_LINEUP As Long = 0
Private Const SB_LINEDOWN As Long = 1

Private hControl As Long
Private lPrevWndProc As Long

Private Function WindowProc(ByVal lWnd As Long, _
                            ByVal lMsg As Long, _
                            ByVal wParam As Long, _
                            ByVal lParam As Long) As Long

  Dim lWheelDirection As Long

  lWheelDirection = HiWord(wParam)

  If lMsg = WM_MOUSEWHEEL Then
    If lWheelDirection = 120 Then
      FMsgBox.MouseWheelScroll hControl, SB_LINEUP
    Else
      FMsgBox.MouseWheelScroll hControl, SB_LINEDOWN
    End If
  End If
  If lMsg <> WM_MOUSEWHEEL Then
    WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, wParam, lParam)
  End If
End Function

Private Function HiWord(DWord As Long) As Integer
  If DWord And &H80000000 Then
    HiWord = (DWord \ 65535) - 1
  Else
    HiWord = DWord \ 65535
  End If
End Function

Sub Hook(ByVal lHwnd As Long)
  hControl = lHwnd
  lPrevWndProc = SetWindowLong(lHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub UnHook()
  Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub


In the form:
---------------------

Option Explicit
Private Const EM_SCROLL As Long = &HB5
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

Public Sub MouseWheelScroll(lHwnd As Long, lLine As Long)
  Dim lLines As Long
  lLines = SendMessage(lHwnd, EM_SCROLL, lLine, 0)
End Sub

Private Sub Form_Load()
    Hook txtPrompt(0).hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHook
End Sub


Is there anything I could do to improve on this?


RBS

Form Minimize, restore, maximize, close buttons
Automatically fix indentation throughout my code
Concept of God in Islam
IE browser: how to refresh it?
Generic SendInput samples?