标签：LinkProc vb End 鼠标 ByVal 滚轮 Long Private Sub
'添加一个类模块，模块名称设置为：cSubclass
'代码如下：
Option Explicit
Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
Private 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
Private Declare Function SetWindowLong Lib “user32” Alias “SetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib “user32” Alias “GetWindowLongA” (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function VirtualProtect Lib “kernel32” (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Type ThisClassSet
s_srcWndProcAddress As Long
s_Hwnd As Long
End Type
Const SWP_SHOWWINDOW = &H40
Const GWL_WNDPROC = (-4)
Dim PG As ThisClassSet
Dim LinkProc() As Long
'定义用户自定义的事件
Event GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
'子类化接口过程
RaiseEvent GetWindowMessage(Result, cHwnd, Message, wParam, lParam)
End Sub
Private Function GetWndProcAddress(ByVal SinceCount As Long) As Long
’ 地址指针 ＝ GetWndProcAddress( 取第 N 个公共函数（属性） =或= 所有公共函数个数 + 第 N 个私有函数的函数地址）
Dim mePtr As Long
Dim jmpAddress As Long
mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4
ReDim LinkProc(10)
LinkProc(0) = &H83EC8B55
LinkProc(1) = &HFC8B14EC
LinkProc(2) = &H56FC758D
LinkProc(3) = &H3308758D
LinkProc(4) = &HFC04B1C9
LinkProc(5) = &HFF68A5F3
LinkProc(6) = &HB8FFFFFF
LinkProc(7) = &HFFFFFFFF
LinkProc(8) = &H48BD0FF
LinkProc(9) = &H10C2C924
CopyMemory ByVal VarPtr(LinkProc(5)) + 3, mePtr, 4
CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress, 4
GetWndProcAddress = VarPtr(LinkProc(0))
VirtualProtect ByVal VarPtr(LinkProc(0)), 44, SWP_SHOWWINDOW, mePtr
End Function
Function CallDefaultWindowProc(ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'调用窗口默认处理过程
CallDefaultWindowProc = CallWindowProc(PG.s_srcWndProcAddress, ByVal cHwnd&, ByVal Message&, ByVal wParam&, ByVal lParam&)
End Function
Function SetMsgHook(ByVal cHwnd As Long) As Long
'设置指定窗口的子类化
PG.s_Hwnd = cHwnd
PG.s_srcWndProcAddress = SetWindowLong(ByVal cHwnd, ByVal GWL_WNDPROC, ByVal GetWndProcAddress(4))
SetMsgHook = PG.s_srcWndProcAddress
End Function
Sub SetMsgUnHook()
'取消窗口子类化
SetWindowLong ByVal PG.s_Hwnd&, ByV
al GWL_WNDPROC, ByVal PG.s_srcWndProcAddress&
End Sub
’
’
’
'窗体(Form)调用
'代码如下：
Dim WithEvents oSubClass As cSubclass
Dim M As Long
Private Sub Form_Load()
Set oSubClass = New cSubclass’初始化对象
oSubClass.SetMsgHook Me.hWnd '开始子类化
End Sub
Private Sub Form_Unload(Cancel As Integer)
oSubClass.SetMsgUnHook '解除子类化
Set oSubClass = Nothing '销毁对象
End Sub
Private Sub oSubClass_GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
Select Case Message
Case WM_MOUSEWHEEL '鼠标滚轮
M = IIf(wParam < 0, IIf(M >= 100, 100, M + 1), IIf(M <= 0, 0, M - 1))
Text1.text=M
End Select
Result = oSubClass.CallDefaultWindowProc(cHwnd, Message, wParam, lParam)
End Sub
标签：LinkProc,vb,End,鼠标,ByVal,滚轮,Long,Private,Sub 来源： https://blog.csdn.net/ty5858/article/details/122260429
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。