Option Explicit
 
' benötigte API-Funktionen
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
 
' Konstante für das Subclassing
Private Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL = &H20A
 
' Variable für die Original-Addresse der Windowsprozedur
Private oldWndProc As Long
 
' Subclassing starten
Public Sub StartSubclass(ByVal hWnd As Long)
  oldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
 
' Subclassing beenden
Public Sub StopSubclass(ByVal hWnd As Long)
  SetWindowLong hWnd, GWL_WNDPROC, oldWndProc
End Sub
 
' Windows-Messages abfragen
Public Function WndProc(ByVal hWnd As Long, _
  ByVal uMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
  ' WM_MOUSEWHEEL-Message abfragen!
  If uMsg = WM_MOUSEWHEEL Then
    ' Mausrad wurde gedreht!
    If wParam < 0 Then
      ' nach hinten: ScrollDown
      SendKeys "%{Down}"
    Else
      ' nach vorne: ScrollUp
      SendKeys "%{Up}"
    End If
  End If
 
  WndProc = CallWindowProc(oldWndProc, hWnd, uMsg, wParam, ByVal lParam)
End Function

Private Sub MSFlexGrid1_GotFocus()
  ' Subclassing aktivieren
  StartSubclass MSFlexGrid1.hWnd
End Sub
 
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
  ' WheelMouse?
  With MSFlexGrid1
    If (KeyCode = vbKeyUp Or KeyCode = vbKeyDown) And (Shift = 4) Then
      Select Case KeyCode
        Case vbKeyUp
          KeyCode = 0
          If .TopRow > 1 Then .TopRow = .TopRow - 1
        Case vbKeyDown
          KeyCode = 0
          If .TopRow < .Rows - 1 Then .TopRow = .TopRow + 1
      End Select
    End If
  End With
End Sub
 
Private Sub MSFlexGrid1_LostFocus()
  ' Subclassing beenden
  StopSubclass MSFlexGrid1.hWnd
End Sub

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de