title: Implement Mousewheel in msforms.textbox
body: <p>I’m trying to implement mousewheel scroll in a large text box. I found Peter Thornton’s code and it works well for frames and userforms (only using it for the former right now), but not for text box because text boxes don’t have a <code>.ScrollTop</code> property.</p>
  
  <p>The code I use now isn’t actually a scroll-wheel function. Full code below, but the relevant portion is:</p>
  
  <pre><code>If TypeName(mControl) = "TextBox" Then
      If reasonCustKeyPressed Then
          lngSelStart = .SelStart
          .CurLine = .CurLine
          lngOldLinePos = lngSelStart - .SelStart
          reasonCustKeyPressed = False
      End If
      If lParam.Hwnd &gt; 0 Then
          .CurLine = Application.Max(0, .CurLine - cTBOX_SCROLLCHANGE)
      Else
          .CurLine = Application.Min(.LineCount - 1, .CurLine + cTBOX_SCROLLCHANGE)
      End If
      lngSelStart = .SelStart
      If .CurLine &lt; .LineCount - 1 Then
          .CurLine = .CurLine + 1
          .SelStart = .SelStart - 1
      Else
          .SelStart = Len(.Text)
      End If
      lngNewLineLen = .SelStart - lngSelStart
      .SelStart = Application.Min(lngSelStart + lngOldLinePos, lngSelStart + lngNewLineLen)
  End If
  </code></pre>
  
  <p>Can anybody give any suggestions on how I could implement actual scroll wheel functionality? One idea I have is to find:</p>
  
  <ol>
  <li>Whether the scroll bar was active (the content isn't always long enough to activate it - but don't know how, windows API?).</li>
  <li>Storing <code>.SelStart</code> in a temporary variable</li>
  <li>Find the top / bottom line somehow (I can't find any property of the textbox like this in documentation)</li>
  <li>Increase the bottom line / decrease the top line (as appropriate) by setting <code>.CurLine</code> </li>
  <li>Resetting <code>.SelStart</code> to the temporary variable (or top / bottom line, if the line stored in the temporary variable is no longer visible).</li>
  </ol>
  
  <p>This isn't ideal either, however, because it doesn't preserve the previous cursor position if you scroll too far. I might be able to work around it by storing the <code>.SelStart</code> variable in the module's state and jumping back to it on the <code>KeyDown</code> event. There are some really big gaps, however, that I don't really have a good idea of how to fill. Any ideas (for this or other, more elegant solutions)? Thank you in advance. </p>
  
  <p>Full code:</p>
  
  <pre><code>Option Explicit
   ' Based on code from Peter Thornton here:
   ' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba
  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 FindWindow Lib "user32" _
  Alias "FindWindowA" ( _
  ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long
  
  Private Declare Function GetWindowLong Lib "user32.dll" _
  Alias "GetWindowLongA" ( _
  ByVal Hwnd As Long, _
  ByVal nIndex As Long) As Long
  
  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
  
  Declare Function GetActiveWindow Lib "user32" () As Long
  
  Private Const WH_MOUSE_LL           As Long = 14
  Private Const WM_MOUSEWHEEL         As Long = &amp;H20A
  Private Const HC_ACTION             As Long = 0
  Private Const GWL_HINSTANCE         As Long = (-6)
  
  Private Const WM_KEYDOWN            As Long = &amp;H100
  Private Const WM_KEYUP              As Long = &amp;H101
  Private Const VK_UP                 As Long = &amp;H26
  Private Const VK_DOWN               As Long = &amp;H28
  Private Const WM_LBUTTONDOWN        As Long = &amp;H201
  
  Private Const cFRAME_SCROLLCHANGE   As Long = 20
  Private Const cTBOX_SCROLLCHANGE    As Long = 1
  
  Private mLngMouseHook               As Long
  Private mControlHwnd                As Long
  Private mbHook                      As Boolean
  Private lngOldLinePos               As Long
  Dim mControl                        As Object
  
  
  Sub HookFormScroll(oControl As Object, strFormCapt As String)
      Dim lngAppInst                  As Long
      Dim hwndUnderCursor             As Long
  
      Set mControl = oControl
      hwndUnderCursor = FindWindow("ThunderDFrame", strFormCapt)
      Debug.Print "Form window: " &amp; hwndUnderCursor
      If mControlHwnd &lt;&gt; hwndUnderCursor Then
          UnhookFormScroll
          Debug.Print "Unhook old proc"
          mControlHwnd = hwndUnderCursor
          lngAppInst = GetWindowLong(mControlHwnd, GWL_HINSTANCE)
          If Not mbHook Then
              mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf mouseProc, lngAppInst, 0)
              mbHook = mLngMouseHook &lt;&gt; 0
              If mbHook Then Debug.Print "Form hooked"
          End If
      End If
  End Sub
  
  Sub UnhookFormScroll()
      If mbHook Then
          UnhookWindowsHookEx mLngMouseHook
          mLngMouseHook = 0
          mControlHwnd = 0
          mbHook = False
      End If
  End Sub
  
  Private Function mouseProc( _
      ByVal nCode As Long, ByVal wParam As Long, _
      ByRef lParam As MOUSEHOOKSTRUCT) As Long
      Dim lngSelStart As Long, lngNewLineLen As Long
      On Error GoTo errH 'Resume Next
      If (nCode = HC_ACTION) Then
          If GetActiveWindow = mControlHwnd Then
  
              If wParam = WM_MOUSEWHEEL Then
                  mouseProc = True
                  With mControl
                      If TypeName(mControl) = "Frame" Then
                          If lParam.Hwnd &gt; 0 Then
                              .ScrollTop = Application.Max(0, .ScrollTop - cFRAME_SCROLLCHANGE)
                          Else
                              .ScrollTop = Application.Min(.ScrollHeight - .InsideHeight, .ScrollTop + cFRAME_SCROLLCHANGE)
                          End If
                      Else
                          If TypeName(mControl) = "TextBox" Then
                              If reasonCustKeyPressed Then
                                  lngSelStart = .SelStart
                                  .CurLine = .CurLine
                                  lngOldLinePos = lngSelStart - .SelStart
                                  reasonCustKeyPressed = False
                              End If
                              If lParam.Hwnd &gt; 0 Then
                                  .CurLine = Application.Max(0, .CurLine - cTBOX_SCROLLCHANGE)
                              Else
                                  .CurLine = Application.Min(.LineCount - 1, .CurLine + cTBOX_SCROLLCHANGE)
                              End If
                              lngSelStart = .SelStart
                              If .CurLine &lt; .LineCount - 1 Then
                                  .CurLine = .CurLine + 1
                                  .SelStart = .SelStart - 1
                              Else
                                  .SelStart = Len(.Text)
                              End If
                              lngNewLineLen = .SelStart - lngSelStart
                              .SelStart = Application.Min(lngSelStart + lngOldLinePos, lngSelStart + lngNewLineLen)
                          End If
                      End If
                  End With
                  Exit Function
              End If
          End If
  
      End If
      mouseProc = CallNextHookEx( _
      mLngMouseHook, nCode, wParam, ByVal lParam)
      Exit Function
  errH:
      UnhookFormScroll
  End Function
  </code></pre>