vb如何使dirlistbox控件支持鼠标滚轮

'功能：VB鼠标滚轮控制DirListBox控件选择
'标准模块中：
OptionExplicit
PublicDeclareFunctionCallWindowProcLib"user32"Alias"CallWindowProcA"(ByVallpPrevWndFuncAsLong,ByValhwndAsLong,ByValMsgAsLong,ByValwParamAsLong,ByVallParamAsLong)AsLong
PublicDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"(ByValhwndAsLong,ByValnIndexAsLong)AsLong
PublicDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByValhwndAsLong,ByValnIndexAsLong,ByValdwNewLongAsLong)AsLong
PublicConstGWL_WNDPROC=-4&
PublicConstWM_MOUSEWHEEL=&H20A
PublicDeclareFunctionGetCursorPosLib"user32"(lpPointAsPOINTAPI)AsLong
PublicDeclareFunctionWindowFromPointLib"user32"(ByValxPointAsLong,ByValyPointAsLong)AsLong
PublicTypePOINTAPI
xAsLong
yAsLong
EndType
PublicOldWindowProcAsLong'用来保存系统默认的窗口消息处理函数的地址
PublichwndDirListBoxAsLong'用来保存Dir1控件的句柄
'自定义的消息处理函数
PublicFunctionNewWindowProc(ByValhwndAsLong,ByValMsgAsLong,ByValwParamAsLong,ByVallParamAsLong)AsLong
OnErrorResumeNext
IfMsg=WM_MOUSEWHEELThen
'下面得到鼠标位置处的对象的句柄
DimCurPointAsPOINTAPI,hwndUnderCursorAsLong
GetCursorPosCurPoint
hwndUnderCursor=WindowFromPoint(CurPoint.x,CurPoint.y)
'如果鼠标位于Form1.Dir1内部，则对鼠标滚轮事件进行处理
IfhwndUnderCursor=hwndDirListBoxThen
IfwParam=-7864320Then'向下滚动
Form1.Dir1.ListIndex=Form1.Dir1.ListIndex-1
ElseIfwParam=7864320Then'向上滚动
Form1.Dir1.ListIndex=Form1.Dir1.ListIndex+1
EndIf
EndIf
Else
'调用Dir1的默认窗口消息处理函数
NewWindowProc=CallWindowProc(OldWindowProc,hwnd,Msg,wParam,lParam)
EndIf
EndFunction
'窗体中添加DirListBox控件(Dir1),CommandButton控件(Command1)：
PrivateSubCommand1_Click()
PrintDir1.List(Dir1.ListIndex)
EndSub
PrivateSubForm_Load()
'取得Dir1控件的句柄
hwndDirListBox=Dir1.hwnd
'保存Dir1控件的默认窗口消息处理函数地址
OldWindowProc=GetWindowLong(Dir1.hwnd,GWL_WNDPROC)
'将Dir1控件的消息处理函数指定为自定义函数NewWindowProc
CallSetWindowLong(Dir1.hwnd,GWL_WNDPROC,AddressOfNewWindowProc)
EndSub
PrivateSubForm_Unload(CancelAsInteger)
DimlngReturnValueAsLong
lngReturnValue=SetWindowLong(hwndDirListBox,GWL_WNDPROC,OldWindowProc)
EndSub