DataGrid控件支持鼠标滚动操作

VB中使DataGrid控件支持鼠标滚动操作

(2010-01-29 14:42:15)

标签： 分类：软件编程

it

默认情况下VB中的DataGrid控件是不支持鼠标滚动的，但可以通过API函数来实现，具体如下:

'在工程中新建一模块，并将以下代码加入到该的模块中(即module1.bas) Public tmpDataGrid As DataGrid '用与确定要实现滚动的DataGrid控件 Public tmpDataGridRowNum As Integer '有多少行数据

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 DataGridScroll(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'该函数用于实现鼠标滚动 Select Case wMsg

Case WM_MOUSEWHEEL Select Case wParam Case -78320 '向下滚

If tmpDataGrid.Row < tmpDataGridRowNum - tmpDataGrid.FirstRow Then tmpDataGrid.Row = tmpDataGrid.Row + 1 End If

Case 78320 '向上滚

If tmpDataGrid.Bookmark > 1 Then

tmpDataGrid.Bookmark = tmpDataGrid.Bookmark - 1 End If End Select End Select

DataGridScroll = CallWindowProc(Oldwinproc, hWnd, wMsg, wParam, lParam) End Function

'在具体包含要实现滚动功能的DataGrid控件的窗体中加入如下代码,并一定记得把DataGrid1的属性页中的 '拆分选项卡中的选取框样式改为 2-debhighlightCell

Private Sub DataGrid1_GotFocus() '获取焦点时候

Oldwinproc = GetWindowLong_r(Me.hWnd, GWL_WNDPROC) Set tmpDataGrid = Me.DataGrid1

tmpDataGridRowNum = adodc1.Recordset.RecordCount '获取记录源中记录的条数 SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf DataGridScroll End Sub

Private Sub DataGrid1_LostFocus() '失去焦点时候

SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc End Sub

运行程序后在DataGrid控件中单击后（获取焦点），滚动看下，呵呵，是不是OK了！！ 方法二：

将以下代码写到公共模块中

'支持滚轮鼠标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 -78320 '向下滚 SendKeys \"{PGDN}\" Case 78320 '向上滚 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