MSHFlexGrid是否支持鼠标滚轮，似乎工具条只能拖放
MSHFlexGrid是否支持鼠标滚轮，似乎工具条只能拖放，需要在哪儿设置吗？
[解决办法]
modWheel.bas
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (pDest As Any, pSource As Any, ByVal ByteLen As Long)Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong As Long) As LongPublic Const GWL_WNDPROC = (-4)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 LongDeclare Function SetProp Lib "user32" Alias "SetPropA" _ (ByVal hWnd As Long, ByVal lpString As String, _ ByVal hData As Long) As LongDeclare Function GetProp Lib "user32" Alias "GetPropA" _ (ByVal hWnd As Long, ByVal lpString As String) As LongDeclare Function RemoveProp Lib "user32" Alias "RemovePropA" _ (ByVal hWnd As Long, ByVal lpString As String) As LongDeclare Function GetParent Lib "user32" (ByVal hWnd As Long) As LongPublic Const WM_MOUSEWHEEL = &H20APublic Const WM_MOUSELAST = &H20APublic Const WHEEL_DELTA = 120 '/* Value for rolling one detent */Public Function HIWORD(LongIn As Long) As Integer ' ' Mask off low word then do integer divide to ' shift right by 16. ' HIWORD = (LongIn And &HFFFF0000) \ &H10000End FunctionPublic Function LOWORD(LongIn As Long) As Integer ' ' Low word retrieved by masking off high word. ' If low word is too large, twiddle sign bit. ' If (LongIn And &HFFFF&) > &H7FFF Then LOWORD = (LongIn And &HFFFF&) - &H10000 Else LOWORD = LongIn And &HFFFF& End IfEnd FunctionPublic Function MWheelProc(ByVal hWnd As Long, _ByVal wMsg As Long, ByVal wParam As Long, _ByVal lParam As Long) As Long Dim OldProc As Long Dim CtlWnd As Long Dim CtlPtr As Long Dim IntObj As Object 'Intermediate object in between Dim MWObject As MWheel 'pointer and mousewheel control CtlWnd = GetProp(hWnd, "WheelWnd") CtlPtr = GetProp(CtlWnd, "WheelPtr") OldProc = GetProp(CtlWnd, "OldWheelProc") If wMsg = WM_MOUSEWHEEL Then CopyMemory IntObj, CtlPtr, 4 Set MWObject = IntObj MWObject.WndProc hWnd, wMsg, wParam, lParam Set MWObject = Nothing CopyMemory IntObj, 0&, 4 Exit Function End If MWheelProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)End FunctionPublic Sub Subclass(MWCtl As MWheel, ParentWnd As Long) If GetProp(MWCtl.hWnd, "OldWheelProc") <> 0 Then Exit Sub End If 'Save the old window proc of the control's parent SetProp MWCtl.hWnd, "OldWheelProc", _ GetWindowLong(ParentWnd, GWL_WNDPROC) 'Object pointer to the control SetProp MWCtl.hWnd, "WheelPtr", ObjPtr(MWCtl) 'Save control's hWnd in its parent data SetProp ParentWnd, "WheelWnd", MWCtl.hWnd 'Subclass the control's parent SetWindowLong ParentWnd, GWL_WNDPROC, AddressOf MWheelProcEnd SubPublic Sub UnSubclass(MWCtl As MWheel, ParentWnd As Long) Dim OldProc As Long OldProc = GetProp(MWCtl.hWnd, "OldWheelProc") If OldProc = 0 Then Exit Sub 'Unsubclass control's parent SetWindowLong ParentWnd, GWL_WNDPROC, OldProc 'Clean up properties RemoveProp ParentWnd, "WheelWnd" RemoveProp MWCtl.hWnd, "WheelPtr" RemoveProp MWCtl.hWnd, "OldWheelProc"End Sub
