解决方案：在VB6中使用鼠标滚轮

VB6不支持鼠标滚轮的处理，因此必须借助系统的API挂钩函数来实现。代码显示如下。

使用方法：将模块添加到项目中并添加以下代码。在主窗口中调用一次HOOK函数以安装该挂钩。程序退出时，请不要忘记使用UNHOOK函数来卸载已安装的钩子，否则会浪费系统资源。

在以下WindowProc函数的注释中添加您自己的代码，以完成鼠标滚轮事件的处理。

OptionExplicit

PublicTypePOINTL

XAsLong

YAsLong

EndType

DeclareFunctionCallWindowProcLib“ USER32” Alias“ CallWindowProcA”（ByVallpPrevWndFuncAsLong，ByValhWndAsLong，ByValMsgAsLong，ByValwParamAsLong，ByVallParamAsLong）AsLong

DeclareFunctionSetWindowLongLib“ USER32” Alias“ SetWindowLongA”（ByValhWndAsLong，ByValnIndexAsLong，ByValdwNewLongAsLong）AsLong

DeclareFunctionSystemParametersInfoLib“ USER32” Alias“ SystemParametersInfoA”（ByValuActionAsLong，ByValuParamAsLong，lpvParamAsAny，ByValfuWinIniAsLong）AsLong

DeclareFunctionScreenToClientLib“ USER32”（ByValhWndAsLong，xyPointAsPOINTL）AsLong

PublicConstGWL_WNDPROC = -4

PublicConstSPI_GETWHEELSCROLLLINES = 104

PublicConstWM_MOUSEWHEEL =＆H20A

WHEEL_SCROLL_LINESAsLong

GloballpPrevWndProcAsLong

PublicsngXAsSingle，sngYAsSingle的鼠标坐标

PublicintShiftAsInteger'鼠标按钮

PublicbWayAsBoolean'鼠标方向

PublicbMouseFlagAsBoolean'鼠标事件激活标记

'********************************************** ****************************

'**功能名称：挂钩

'**输入：ByValhWnd（Long）-窗口句柄

'**输出：无

'**功能描述：安装鼠标钩子

'********************************************** ****************************

PublicSubHook（ByValhWndAsLong）

lpPrevWndProc = SetWindowLong（hWnd，GWL_WNDPROC，AddressOfWindowProc）

'在“控制面板”中获取滚动行值

CallSystemParametersInfo（SPI_GETWHEELSCROLLLINES，0，WHEEL_SCROLL_LINES，0)

EndSub

'********************************************** ****************************

'**功能名称：摘机

'**输入：ByValhWnd（Long）-窗口句柄

'**输出：无

'**功能描述：卸载鼠标钩子

'********************************************** ****************************

PublicSubUnHook（ByValhWndAsLong）

DimlngReturnValueAsLong

lngReturnValue = SetWindowLong（hWnd，GWL_WNDPROC，lpPrevWndProc）

EndSub

'********************************************** ****************************

'**函数名称：WindowProc

'**输入：ByValhw（Long）-窗口句柄

'**：ByValuMsg（长）消息类型

'**：ByValwParam（Long）-

'**：ByVallParam（Long）-

'********************************************** ****************************

PrivateFunctionWindowProc（ByValhwAsLong，ByValuMsgAsLong，ByValwParamAsLong，ByVallParamAsLong）AsLong

DimptAsPOINTL

SelectCaseuMsg

CaseWM_MOUSEWHEEL的滚动

DimwzDelta，wKeysAsInteger

'wzDelta通过滚轮的速度，如果该值小于零，则表示滚轮正在向后滚动（向用户），

“大于零表示滚轮向前滚动（向显示屏方向）

wzDelta = HIWORD（wParam）

'wKeys指出是否按下了CTRL =8、SHIFT =4、鼠标按钮（向左=2、= 16、向右=2、添加），可以进行复合操作

wKeys = LOWORD（wParam）

'pt鼠标坐标

pt.X = LOWORD（lParam）

pt.Y = HIWORD（lParam）

'---------------------------------------------- ----

IfwzDelta

bWay = True

'在这里，您自己处理---------

MsgBox0'这行代码是我添加的，使用时更改为您自己的代码

否则，朝着显示方向

bWay = False

MsgBox1'这行代码是我添加的，使用时更改为您自己的代码

EndIf

'---------------------------------------------- ----

'将屏幕坐标转换为Form1.窗口坐标

ScreenToClienthw，pt

sngX = pt.X

sngY = pt.Y

intShift = wKeys

bMouseFlag =真设置滚动标志

CaseElse

WindowProc = CallWindowProc（lpPrevWndProc，hw，uMsg，wParam，lParam）

EndSelect

EndFunction

'********************************************** ****************************

'**函数名称：HIWORD

'**输入：LongIn（Long）-32位值

'**输出：（整数）-32位值的低16位

'**功能描述：取出32位值的高16位

'********************************************** ****************************

PublicFunctionHIWORD（LongInAsLong）AsInteger

'获取32位值的高16位

HIWORD =（LongInAnd＆HFFFF000 0) \＆H10000

EndFunction

'********************************************** ****************************

'**函数名称：LOWORD

'**输入：LongIn（Long）-32位值

'**输出：（整数）-32位值的低16位

'**功能描述：取出32位值的低16位

'********************************************** ****************************

PublicFunctionLOWORD（LongInAsLong）AsInteger

'获取32位值的低16位

LOWORD = LongInAnd＆HFFFF＆

EndFunction

本文来自电脑杂谈，转载请注明本文网址：
https://www.pc-fly.com/a/bofangqi/article-323352-1.html