VB高级编程初探（子类技术SUBCLASS与消息捕获）

概述一、前言 很早以前就想写一篇关于子类技术（SubClass）的文章，不过由于时间有限没有深入研究。这段时间由于工作需要用子类实现了大量的Windows消息捕获，正好有朋友今天又问到鼠标滚动事件的捕获问题（这个问题我将在文末给出一个较简洁的方法），因此决定写这篇文章，希望对大家有些帮助。 我们都知道VB有其局限性，我们也常常在试探通过某种方法拓展其应用范围，正如我在以前讲到过的如何在VB中使用隐藏的

一、前言

很早以前就想写一篇关于子类技术（SubClass）的文章，不过由于时间有限没有深入研究。这段时间由于工作需要用子类实现了大量的windows消息捕获，正好有朋友今天又问到鼠标滚动事件的捕获问题（这个问题我将在文末给出一个较简洁的方法），因此决定写这篇文章，希望对大家有些帮助。

我们都知道VB有其局限性，我们也常常在试探通过某种方法拓展其应用范围，正如我在以前讲到过的如何在VB中使用隐藏的指针 *** 作函数，如何突破限制使用TOM对象等等。今天讲到的子类技术正是突破VB局限的又一有力工具。

二、子类（SubClass）技术简介

众所周知，windows是一个基于消息的系统，消息在windows的对象之间进行着传递。子类（SubClass）和windows的钩子（Hook）机制存在于消息系统之中，我们可以利用这些机制来 *** 纵、修改甚至丢弃那些在 *** 作系统或是进程中传递的消息，以求改变系统的一些行为。

子类（SubClass）技术用来拦截窗口或控件之间的消息，当然是消息在到达目的窗口之前完成的 *** 作。这些被拦截的消息既可以保留也可以修改它们的状态，之后就继续发送到目的地。子类技术实现了一些正常情况下无法实现的功能，试想鼠标右键单击TextBox，系统默认d出Undo、Cut、copy、Paste等菜单，我们就可以利用子类技术来改变这个系统菜单。

简单的说，子类（SubClass）技术就是创建一个新的窗口消息处理过程，并将其插入到原先的默认窗口消息处理过程之前。对于有点OO知识的人来说，这个名称很好理解，因为它继承了上级窗口的一些属性和方法并且加入了自己特有的内容。同样的，超类（SuperClass）技术与之相对，它通过改变父类的特性以求改变其派生类的共同特性，这里不是我们的讨论重点，因此略过。

子类技术的原理：要先取得原先Window Procedure所在的地址，将之记录起来，接着设定所有的消息都先转到我们所写的消息处理过程上来，我们过滤传过来的消息，寻找特定的消息进行处理，其余的送回系统，由系统决定如何处理。等到我们不需要再处理这些特定的消息时，便取消拦截，即中止子类过程。它一般需要三个过程：开始拦截，消息处理，中止拦截。

三、磨刀霍霍：API准备

通常要实现子类技术需要对windows消息机制有较深入的理解，同时对于相关API有较好的掌握。常用API如下：

RegisterClass或RegisterClassEx：该函数为随后在调用Createwindow函数和CreatewindowEx函数中使用的窗口注册一个窗口类；

UnregisterClass：删除一个窗口类，清空该类所需的内存；

DefWindowProc：该函数调用缺省的窗口过程来为应用程序没有处理的任何窗口消息提供缺省的处理。该函数确保每一个消息得到处理。调用DefWindowProc函数时使用窗口过程接收的相同参数；

GetMessage：该函数从调用线程的消息队列里取得一个消息并将其放于指定的结构；

TranslateMessage：该函数将虚拟键消息转换为字符消息；

dispatchMessage：该函数调度一个消息给窗口程序，通常调度从GetMessage取得的消息；

ShowWindow：用于设置窗口的状态，其中包括窗口的隐藏、显示、最小化、最大化、激活等；

UpdateWindow： 立即更新窗口内需要更新的任何部分；

CreateWindowEx：该函数创建一个具有扩展风格的重叠式窗口、d出式窗口或子窗口，其他与CreateWindow函数相同；

CallWindowProc：该函数CallWindowProc将消息信息传送给指定的窗口过程；

SetwindowLong，getwindowlong：用于获取或设置与窗口有关的信息；

PostQuitMessage：将一条消息投递到指定窗口的消息队列；

DestroyWindow：清除指定的窗口以及下属所有子窗口与包容窗口。

这里主要对核心的SetwindowLong和CallWindowProc两个函数进行详细讲解，其他函数的说明请参见MSDN：

1、 SetwindowLong函数：该函数将改变指定窗口的特殊属性。

声明如下：

Declare Function SetwindowLong lib "user32" Alias "SetwindowLongA"(ByVal hwnd As Long， ByVal nIndex As Long，ByVal DWNewLong As Long) As Long

第一个参数代表要进行子类处理的窗口，第二个参数应该是GWL_WNDPROC(-4)，第三个参数是新的窗口函数的地址.参见回调和窗口函数一节.

此函数将在窗口取得焦点，发生事件，或其他情况下(如其他进程改变了系统的某些参数)被随时调用.

如果发生错误SetwindowLong函数将返回0，否则将返回原来的窗口函数的地址.这个地址特别重要，你应该把它保存在一个变量中或其他地方.当你不处理某些消息时(实际上，你可能只处理不到1%的消息，其他的都将由原窗口函数处理)，调用原来的窗口函数就需要该地址。

注：此处的窗口并非只是指的VB窗体，它表示的是任何一个具备hWnd句柄的对象。比如我们用于捕获一个RichEdit控件，就要用到它的hWnd句柄。

2、 CallWindowProc函数：调用原窗口函数。

声明如下：

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

第一个参数是原窗口函数的地址，其他的同你接收到的四个参数一样.你可以改变其中的值来控制对消息的处理。例如，当你收到了一条WM_MOUSEMOVE消息时，你从lParam中得到鼠标所在位置的坐标并将其改成了其他的坐标。那么原窗口函数就会认为鼠标位于其他的位置从而做出一些有趣的事如显示其他控件的tooltip。

你指定的返回值也是有意义的，它依赖于发送的消息。

在结束你的程序时将控制权交回给原窗口函数是很重要的，通常在Form_Unload中完成如下:

Ret& = SetwindowLong(Me.Hwnd， GWL_WNDPROC， olDWndProcAddress)

如果你在VB中启动程序时忘掉了这一行，结果将是VB崩溃并会丢失尚未保存的数据。千万要小心。

3、 AddressOf函数：另外，我们通常需要通过AddressOf函数得到一个VB内部的函数指针，我们可以将这个函数指针传递给需要回调这个函数的API，它的作用就是让外部的程序可以调用VB内部的函数。

基本思路是：我们可以使SetwindowLong这个API来将原来的窗口函数指针换成自己的函数指针，并将原来的窗口函数指针保存下来。这样窗口消息就可以发到我们自己的函数里来，并且我们随时可以用CallWindowProc来调用前面保存下来的窗口指针，以调用原来的窗口函数。这样，我们可以在不破坏原有窗口功能的前提下处理钩入的消息，这也是钩子技术的精髓。

三、管中窥豹：VB中子类技术实现的一个例子

下面的例子是在网上比较常见的一个例子程序，它演示了如何将”About Me”加入窗口的系统菜单。

①创建工程

启动Visual Basic 6同时创建一个标准EXE工程。

②在窗体中录入代码

Private Declare Function GetSystemMenu lib "user32" (ByVal hWnd As Long,ByVal bRevert As Long) As Long

Private Declare Function InsertMenu lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long,ByVal nposition As Long,ByVal wFlags As Long,ByVal wIDNewItem As Long,ByVal lpNewItem As String) As Long

Private Const MF_BYCOMMAND = &H0&

Private Const MF_BYposition = &H400&

Private Const MF_STRING = &H0&

Private Const MF_SEParaTOR = &H800&

Private Sub Form_Load()

InsertMenu GetSystemMenu(Me.hWnd,False),MF_BYposition Or MF_SEParaTOR,2001,""

InsertMenu GetSystemMenu(Me.hWnd,MF_BYposition Or MF_STRING,2002,"About Me(&A)"

'安装子类化入口

Call Init(Me.hWnd)

End Sub

Private Sub Form_Unload(Cancel As Integer)

'卸载子类化

Call Terminate(Me.hWnd)

End Sub

③加入一个模块并录入代码

Option Explicit

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 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

Const GWL_WNDPROC = (-4&)

Dim PrevWndProc&

Private Const WM_SYSCOMMAND = &H112

Const WM_DESTROY = &H2

'子类化入口

Public Sub Init(hWnd As Long)

PrevWndProc = SetwindowLong(hWnd,GWL_WNDPROC,AddressOf SubWndProc)

End Sub

'子类化出口

Public Sub Terminate(hWnd As Long)

Call SetwindowLong(hWnd,PrevWndProc)

End Sub

'新的窗口消息处理过程，将被插入到默认处理过程之前

Private Function SubWndProc(ByVal hWnd As Long,ByVal lParam As Long) As Long

If Msg = WM_DESTROY Then Terminate (Form1.hWnd)

If wParam = 2002 Then

MsgBox "呵呵，一个子类技术的例子！",vbinformation,"吴庆伟"

End If

'调用默认的窗口处理过程

SubWndProc = CallWindowProc(PrevWndProc,hWnd,Msg,wParam,lParam)

End Function

但是，需要指出的是不正确的子类化是非常危险的，通常情况下将导致一个General Protection Fault（GPF）错误，致使VB应用立即崩溃。

四、过关斩将：如何解决VB中对于子类技术的调试问题

如前所述，一般情况下运用子类技术或者钩子技术进行编程时经常出现一些不可控的情况，从而导致VB崩溃，因此很多人对子类是又爱又恨，原因很简单――它不能使用断点调试模式，这将导致VB崩溃！而这也是VB程序员最不能接受的事实！！！

下面是我找到的一个很好的封装了子类技术的动态链接库（zlSubTmr.dll，含源码！），它的最大特点就是能够在VB下进行大部分SubClass消息捕获的调试，而不会在断点调试模式下导致崩溃！相信对感兴趣的朋友有很大帮助。

【zlSubTmr.dll源码及捕获鼠标滚轮的示例】 地址：http://blog.zlsoft.cn/files/wqw/zlSubTmr.Dll源码及示例.rar

下面简单介绍一下它的使用方法与步骤，具体请常见源码。

1、 首先继承其子类：在代码申明部分写：

Implements ISubclass '继承子类

2、 设置需要捕获的消息名称：如我们需要捕获窗体的WM_MOUSEWHEEL事件，则写：

AttachMessage Me,Me.hWnd,WM_MOUSEWHEEL

3、 然后处理ISubclass_MsgResponse、ISubclass_MsgResponse和ISubclass_WindowProc三个事件。

如：

Private Property Let ISubclass_MsgResponse(ByVal RHS As zlSubTmr.EMsgResponse)

'通常不处理！

End Property

Private Property Get ISubclass_MsgResponse() As zlSubTmr.EMsgResponse

'获取消息反馈

Select Case CurrentMessage

Case WM_MOUSEWHEEL ‘这里是我们需要捕获的事件！！！

ISubclass_MsgResponse = emrConsume '手工处理的事件

Case Else

ISubclass_MsgResponse = emrPreProcess '默认处理事件

End Select

End Property

Private Function ISubclass_WindowProc(ByVal hwnd As Long,ByVal imsg As Long,ByVal lParam As Long) As Long

'进行具体的消息处理！

……

End Function

4、 销毁消息捕获：

DetachMessage Me,m_hWndParent,WM_ACTIVATE

五、后记：关于鼠标滚动事件捕获的一个简洁的例子

还是一个关于鼠标滚轮事件捕获的例子，不过这个代码更简洁些，摘自mndsoft.com。它同样是使用的子类技术进行了消息鼠标滚动时间的消息捕获，不过实现方法非常简洁（主要归功于PeekMessage和WaitMessage两个API函数），大家有兴趣可以看看。

Private Const PM_REMOVE = &H1

Private Type POINTAPI

x As Long

y As Long

End Type

Private Type Msg

hWnd As Long

Message As Long

wParam As Long

lParam As Long

time As Long

pt As POINTAPI

End Type

Private Declare Function PeekMessage lib "user32" Alias "PeekMessageA" (lpMsg As Msg， ByVal hWnd As Long， ByVal wMsgFilterMin As Long， ByVal wMsgFilterMax As Long， ByVal wRemoveMsg As Long) As Long

Private Declare Function WaitMessage lib "user32" () As Long

Private bCancel As Boolean

Private Const WM_MOUSEWHEEL = 522

Private Sub ProcessMessages()

Dim Message As Msg

do while Not bCancel

WaitMessage 'Wait For message and...

If PeekMessage(Message， Me.hWnd， WM_MOUSEWHEEL， WM_MOUSEWHEEL， PM_REMOVE) Then '...when the mousewheel is used...

If Message.wParam < 0 Then '...scroll up...

Me.top = Me.top + 240

Else '... or scroll down

Me.top = Me.top - 240

End If

End If

DoEvents

Loop

End Sub

Private Sub Form_Load()

Me.autoRedraw = True

Me.Print "Please use Now mouse wheel to move this form."

Me.Show

ProcessMessages

End Sub

Private Sub Form_Unload(Cancel As Integer)

bCancel = True

End Sub

总结

以上是内存溢出为你收集整理的VB高级编程初探（子类技术SUBCLASS与消息捕获）全部内容，希望文章能够帮你解决VB高级编程初探（子类技术SUBCLASS与消息捕获）所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。