DataGrid支持鼠标滚轮滚动记录

来源：互联网发布：nuke mac破解失败编辑：程序博客网时间：2024/05/21 17:19

http://www.mndsoft.com/blog/article.asp?id=901

在本站的VB源码《数据网格下拉列表框控件》中(链接地址：http://www.mndsoft.com/blog/article.asp?id=214)中，网友 taomaintao 提示支持滚轮鼠标，其实原本代码有已经有部分API代码意图支持鼠标滚轮，但可能作者后来没有加上。基于此，我找到一个解决办法（来自网络），taomaintao 网友可以按照下面自己进行修改吧。

首先在DataGrid 的【拆分】属性中的【选取框样式】设置为 3，即整行高亮选择，然后加入如下代码就支持了，只要让鼠标的焦点在grid控件上，滚动鼠标滑轮，grid滚动条会自动滚动的。

如果需要更平滑的滚动以及自定义滚动方法，我还有个代码，到时发给你，你自己研究吧。

示例操作方法：
将以下代码写到公共模块中

  '支持滚轮鼠标API---------------------------------
          Public   Const   GWL_WNDPROC   =   (-4)
          Public   Const   WM_COMMAND   =   &H111
          Public   Const   WM_MBUTTONDOWN   =   &H207
          Public   Const   WM_MBUTTONUP   =   &H208
          Public   Const   WM_MOUSEWHEEL   =   &H20A

          Public   Oldwinproc   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   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   Function   GetWindowLong   Lib   "user32"   Alias   "GetWindowLongA"   (ByVal   hWnd   As   Long,   _
                                                          ByVal   nIndex   As   Long)   As   Long
  Public   Function   FlexScroll(ByVal   hWnd   As   Long,   ByVal   wMsg   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long
  '支持滚轮的滚动   Yu   2004-5-10   15:33
          Select   Case   wMsg
          Case   WM_MOUSEWHEEL
                  Select   Case   wParam
                  Case   -7864320     '向下滚
                          SendKeys   "{PGDN}"
                  Case   7864320       '向上滚
                          SendKeys   "{PGUP}"
                  End   Select

          End   Select
          FlexScroll   =   CallWindowProc(Oldwinproc,   hWnd,   wMsg,   wParam,   lParam)
  End   Function
  '支持滚轮鼠标API---------------------------------


  '将下列代码写到表格控件的GotFocus事件中
  Private   Sub   控件名称_GotFocus()
          Oldwinproc   =   GetWindowLong(Me.hWnd,   GWL_WNDPROC)
          SetWindowLong   Me.hWnd,   GWL_WNDPROC,   AddressOf   FlexScroll
  End   Sub

  '将下列代码写到表格控件的LostFocus事件中
  Private   Sub   控件名称_LostFocus()
          SetWindowLong   Me.hWnd,   GWL_WNDPROC,   Oldwinproc
  End   Sub