[Switch from csdn] enables msflexgrid control to support scroll wheel

Method 1:
The following program is placed in a public module,
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

Method 2
From: http://blog.csdn.net/yachong/archive/2007/01/26/1494442.aspx

If the program contains multiple forms and each form contains multiple msflexgrid controls, it is easier to write code for each grid control.

Replace "msflexgrid" with "mshflexgrid" to support the mshflexgrid control.

Create a new module and paste the following code:
Public declare function setwindowlong lib "USER32" alias "setwindowlonga" (byval hwnd as long, byval nindex as long, byval dwnewlong as long) as long
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 const gwl_wndproc = (-4)

Public type tgridlist
FRM as form
Grid as msflexgrid
Grdhwnd as long
Grdpreproc as long
End type

Private gridlist () as tgridlist
Private ngridcount as long

Public Function windowprocgridhook (byval hwnd as long, byval umsg as long, byval wparam as long, byval lparam as long) as long
Dim nindex as long
Nindex = getgridindex (hwnd)
If umsg <> 522 then
Windowprocgridhook = callwindowproc (gridlist (nindex). grdpreproc, hwnd, umsg, wparam, lparam)
Else 'scroll Wheel
On Error resume next
With gridlist (nindex). Grid
Dim lngtoprow as long, lngbottomrow as long
Lngtoprow = 1
Lngbottomrow =. Rows-1
If wparam> 0 then
If not. rowisvisible (lngtoprow) then
. Toprow =. toprow-1
End if
Else
. Toprow =. toprow + 1
End if
End
End if
End Function

Public sub starthook (FRM as form)
Dim X as Variant
Dim proc as long
For each X in frm. Controls
If typeof X is msflexgrid then
Ngridcount = ngridcount + 1
Redim preserve gridlist (1 to ngridcount) as tgridlist
Set gridlist (ngridcount). Grid = x
Set gridlist (ngridcount). FRM = FRM
Gridlist (ngridcount). grdhwnd = x. hwnd
Proc = setwindowlong (X. hwnd, gwl_wndproc, addressof windowprocgridhook)
Gridlist (ngridcount). grdpreproc = proc
End if
Next
End sub

Public sub endhook (FRM as form)
Dim I as long, J as long, N as long
For I = ngridcount to 1 step-1
If gridlist (I). frm is frm then
Setwindowlong gridlist (I). grdhwnd, gwl_wndproc, gridlist (I). grdpreproc
N = n + 1
For J = I to ngridcount-n
Gridlist (j) = gridlist (J + 1)
Next
End if
Next
Ngridcount = ngridcount-n
End sub

Private function getgridindex (hwnd as long) as long
Dim I as long
For I = 1 to ngridcount
If gridlist (I). grdhwnd = hwnd then
Getgridindex = I
Exit Function
End if
Next
End Function

Call starthook and endhook in each form containing the msflexgrid control.
For example:
Private sub form_load ()
Starthook me
End sub
Private sub form_unload (cancel as integer)
Endhook me
End sub
In this way, the scroll wheel is supported.