请问: 在datagrid或MShflexgrid中如何设置能让鼠标的滚轮起作用, 谢谢
解决方案 »
- 请教个遍历窗口控件的问题
- vb发送邮件 发件人从数据库获取
- 请问怎么设置activereport的ado的数据源?
- 系统文件夹
- 求vb中wav转wma的方法
- 怎樣用程序注冊不在SYSTEM32中的DLL
- 自己做了个触摸屏用的虚拟键盘,如何才能判断窗口处于等待键盘输入状态,然后自动打开虚拟键盘,在不需要键盘输入时隐藏
- 请问如何解码UTF-8?
- 请问,vb里用了MS Word 8.0/9.0 olb(开发的机器有office),那么安装应用程序的机器没有office,该怎么办呢?
- Winsock控件,tcpip协议,如何使用senddata方法连续发送两个字符串?
- 请问:如何获得datagrid当前选择行的每一列的值!
- 水晶报表9.0的一个小问题
http://www.dapha.net/down/list.asp?id=2032
'模块
Option Explicit
Public Type POINTL
X As Long
Y As Long
End Type
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
Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SystemParametersInfo Lib "USER32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, xyPoint As POINTL) As LongPublic Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As LongGlobal lpPrevWndProc As LongPublic sngX As Single, sngY As Single '鼠标坐标
Public intShift As Integer '鼠标按键
Public bWay As Boolean '鼠标方向
Public bMouseFlag As Boolean '鼠标事件激活标志'*************************************************************************
'**函 数 名:Hook
'**输 入:ByVal hWnd(Long) - 窗口句柄
'**输 出:无
'**功能描述:安装鼠标钩子
'*************************************************************************
Public Sub Hook(ByVal hWnd As Long)
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
'获取"控制面板"中的滚动行数值
Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
End Sub'*************************************************************************
'**函 数 名:UnHook
'**输 入:ByVal hWnd(Long) - 窗口句柄
'**输 出:无
'**功能描述:卸载鼠标钩子
'*************************************************************************
Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
End Sub'*************************************************************************
'**函 数 名:WindowProc
'**输 入:ByVal hw(Long) - 窗口句柄
'** :ByVal uMsg(Long) - 消息类型
'** :ByVal wParam(Long) -
'** :ByVal lParam(Long) -
'**输 出:(Long) -
'**功能描述:窗口函数
'*************************************************************************
Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim pt As POINTL
Select Case uMsg
Case WM_MOUSEWHEEL '滚动
Dim wzDelta, wKeys As Integer
'wzDelta传递滚轮滚动的快慢,该值小于零表示滚轮向后滚动(朝用户方向),
'大于零表示滚轮向前滚动(朝显示器方向)
wzDelta = HIWORD(wParam)
'wKeys指出是否有CTRL=8、SHIFT=4、鼠标键(左=2、中=16、右=2、附加)按下,允许复合
wKeys = LOWORD(wParam)
'pt鼠标的坐标
pt.X = LOWORD(lParam)
pt.Y = HIWORD(lParam)
'--------------------------------------------------
If wzDelta < 0 Then '朝用户方向
bWay = True
'
‘这里添加滚动的代码
Else '朝显示器方向
bWay = False
'
’这里添加滚动的代码
End If
'--------------------------------------------------
'将屏幕坐标转换为Form1.窗口坐标
ScreenToClient hw, pt
sngX = pt.X
sngY = pt.Y
intShift = wKeys
bMouseFlag = True '置滚动标志
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function'*************************************************************************
'**函 数 名:HIWORD
'**输 入:LongIn(Long) - 32位值
'**输 出:(Integer) - 32位值的低16位
'**功能描述:取出32位值的高16位
'*************************************************************************
Public Function HIWORD(LongIn As Long) As Integer
' 取出32位值的高16位
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function'*************************************************************************
'**函 数 名:LOWORD
'**输 入:LongIn(Long) - 32位值
'**输 出:(Integer) - 32位值的低16位
'**功能描述:取出32位值的低16位
'*************************************************************************
Public Function LOWORD(LongIn As Long) As Integer
' 取出32位值的低16位
LOWORD = LongIn And &HFFFF&
End Function
‘窗体 ’
'datagrid或MShflexgrid
Private Sub datagrid_GotFocus()
Hook datagrid.hWnd
End SubPrivate Sub datagrid_LostFocus()
UnHook datagrid.hWnd
End Sub