哈,佛山兄,你也到这里来了!
哈,佛山兄,你也到这里来了!
绝对能用
module:
Public Const GWL_WNDPROC = -4&
Public Const WM_COPYDATA = &H4A
Public Const WM_MOUSEWHEEL = &H20A
Public Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Public 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
Public Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public prevWndProc As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long,
ByVal yPoint As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
Public OldWindowProc As Long ???
Public hwndDataGrid As Long
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If Msg = WM_MOUSEWHEEL Then
Dim CurPoint As POINTAPI, hwndUnderCursor As Long
GetCursorPos CurPoint
hwndUnderCursor = WindowFromPoint(CurPoint.X, CurPoint.Y)
If wParam = -7864320 Then
frmEquipManage.DataGrid1.Scroll frmEquipManage.DataGrid1.VisibleCols, frmEquipManage.DataGrid1.VisibleRows
ElseIf wParam = 7864320 Then
frmEquipManage.DataGrid1.Scroll -frmEquipManage.DataGrid1.VisibleCols, -frmEquipManage.DataGrid1.VisibleRows
End If
Else
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End If
End Function
form_Load:
hwndDataGrid = DataGrid1.hwnd
OldWindowProc = GetWindowLong(DataGrid1.hwnd, GWL_WNDPROC)
Call SetWindowLong(DataGrid1.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
[此贴子已经被作者于2007-10-11 11:52:27编辑过]