Msflexgrid supports scroll wheel events

Allow msflexgrid to support scroll wheel eventsAuthor: Lisu zhuanzhu/viewing times: 10423/comment: 7 http://www.mndsoft.com/blog/vb6/0923.htmlin a public program,
Write hookwheel me. hwnd in the form_load event in the form.
Write unhookwheel me. hwnd in the form_unload event in the form.
Set ctlwheel = msflexgrid1 in the gotfocus event of the table (modify the table name based on the actual situation)

Set ctlwheel = nothing in the table's lostfocus event (modify the table name based on the actual situation)

Option explicit

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

Private const gwl_wndproc as long = (-4)
Private const wm_mousewheel as long = & h20a

Private m_oldwindowproc as long

Public ctlwheel as object

Public sub hookwheel (byval frmhwnd)

M_oldwindowproc = setwindowlong (frmhwnd, gwl_wndproc, addressof pvwindowproc)
End sub

Public sub unhookwheel (byval hwnd as long)
Dim lngreturnvalue as long
Lngreturnvalue = setwindowlong (hwnd, gwl_wndproc, m_oldwindowproc)

End sub

Private function pvwindowproc (byval hwnd as long, byval wmsg as long, byval wparam as long, byval lparam as long) as long
On Error goto errh

Select case wmsg

Case wm_mousewheel
If not ctlwheel is nothing then
If typeof ctlwheel is msflexgrid then
With ctlwheel

Select case wparam
Case is> 0

If ctlwheel. toprow> 0 then
Ctlwheel. toprow = ctlwheel. toprow-1
End if

Case else

Ctlwheel. toprow = ctlwheel. toprow + 1

End select
End
End if

End if
End select

Errh:

Pvwindowproc = callwindowproc (m_oldwindowproc, hwnd, wmsg, wparam, lparam)
End Function