2022年VB高级编程初探.docx

VB 高级编程初探（子类技术SUBCLASS与消息捕捉）关键词 ： VB 高级编程初探（子类技术SU一、前言很早以前就想写一篇关于子类技术（SubClass）的文章，不过由于时间有限没有深化争论；这段时间由于工作需要用子类实现了大量的Windows消息捕捉，正好今日有人问到鼠标滚动大事的捕捉问题（这个问题我将在文末给出一个较简洁的方法），因此打算写这篇文章，期望对大家有些帮忙；我们都知道 VB 有其局限性，我们也常常在摸索通过某种方法拓展其应用范畴，正如我在以前讲到过的如何在 VB 中使用隐匿的指针操作函数， 如何突破限制使用 TOM 对象等等； 今日讲到的子类技术正是突破 VB 局限的又一有力工具；二、子类（ SubClass）技术简介众所周知， Windows是一个基于消息的系统，消息在Windows的对象之间进行着传递；子类（Su bClass ）和 Windows的钩子（ Hook ）机制存在于消息系统之中，我们可以利用这些机制来操纵、修改甚至丢弃那些在操作系统或是进程中传递的消息，以求转变系统的一些行为；子类（ SubClass ）技术用来拦截窗口或控件之间的消息，当然是消息在到达目的窗口之前完成的操作；这些被拦截的消息既可以保留也可以修改它们的状态，之后就连续发送到目的地；子类技术实现了一些正常情形下无法实现的功能，试想鼠标右键单击TextBox，系统默认弹出 Undo 、Cut 、Copy 、Paste 等菜单，我们就可以利用子类技术来转变这个系统菜单；简洁的说，子类（ SubClass ）技术就是创建一个新的窗口消息处理过程，并将其插入到原先的默认窗口消息处理过程之前；对于有点OO 学问的人来说，这个名称很好懂得，由于它继承了上级窗口的一些属性和方法并且加入了自己特有的内容；同样的，超类（SuperClass）技术与之相对，它通过转变父类的特性以求转变其派生类的共同特性，这里不是我们的争论重点，因此略过；子类技术的原理：要先取得原先WindowProcedure所在的地址，将之记录起来，接着设定全部的消息都先转到我们所写的消息处理过程上来，我们过滤传过来的消息，查找特定的消息进行处理，其余的送回系统，由系统打算如何处理；等到我们不需要再处理这些特定的消息时，便取消拦截，即中止子类过程；它一般需要三个过程：开头拦截，消息处理，中止拦截；三、磨刀霍霍： API 预备通常要实现子类技术需要对Windows消息机制有较深化的懂得， 同时对于相关 API 有较好的把握；常用 API 如下：9 / 8RegisterClass或 RegisterClassEx：该函数为随后在调用Createwindow函数和 CreatewindowEx函数中使用的窗口注册一个窗口类；UnregisterClass：删除一个窗口类，清空该类所需的内存；DefWindowProc：该函数调用缺省的窗口过程来为应用程序没有处理的任何窗口消息供应缺省的处理；该函数确保每一个消息得处处理；调用DefWindowProc函数时使用窗口过程接收的相同参数； GetMessage：该函数从调用线程的消息队列里取得一个消息并将其放于指定的结构；TranslateMessage：该函数将虚拟键消息转换为字符消息；DispatchMessage：该函数调度一个消息给窗口程序，通常调度从GetMessage取得的消息； ShowWindow：用于设置窗口的状态，其中包括窗口的隐匿、显示、最小化、最大化、激活等； UpdateWindow：立刻更新窗口内需要更新的任何部分；CreateWindowEx：该函数创建一个具有扩展风格的重叠式窗口、弹出式窗口或子窗口，其他与Creat eWindow函数相同；CallWindowProc：该函数 CallWindowProc将消息信息传送给指定的窗口过程； SetWindowLong，GetWindowLong：用于猎取或设置与窗口有关的信息； PostQuitMessage：将一条消息投递到指定窗口的消息队列；DestroyWindow：清除指定的窗口以及下属全部子窗口与包涵窗口；这里主要对核心的 SetWindowLong和 CallWindowProc两个函数进行具体讲解，其他函数的说明请参见 MSDN ：1 、 SetWindowLong函数：该函数将转变指定窗口的特殊属性；声明如下：DeclareFunctionSetWindowLongLib "user32"Alias"SetWindowLongA"ByValhwndAs Long ， ByValnIndexAs Long ， ByValdwNewLongAs LongAs Long第一个参数代表要进行子类处理的窗口，其次个参数应当是 GWL_WNDPROC-4，第三个参数是新的窗口函数的地址 . 参见回调和窗口函数一节 .此函数将在窗口取得焦点，发生大事，或其他情形下 如其他进程转变了系统的某些参数 被随时调用 .假如发生错误 SetWindowLong函数将返回 0，否就将返回原先的窗口函数的地址. 这个地址特殊重要， 你应当把它储存在一个变量中或其他地方.当你不处理某些消息时 实际上， 你可能只处理不到 1% 的消息， 其他的都将由原窗口函数处理 ，调用原先的窗口函数就需要该地址；注：此处的窗口并非只是指的 VB 窗体，它表示的是任何一个具备 hWnd句柄的对象；比如我们用于捕捉一个 RichEdit控件，就要用到它的 hWnd句柄；2 、 CallWindowProc函数：调用原窗口函数；声明如下：DeclareFunctionCallWindowProcLib "user32"Alias"CallWindowProcA"ByVallpPrevWndFuncAs Long ，ByValhWndAs Long ， ByValMsgAs Long ，ByValwParamAs Long ， ByVa l lParamAs LongAs Long第一个参数是原窗口函数的地址， 其他的同你接收到的四个参数一样 . 你可以转变其中的值来掌握对消息的处理；例如， 当你收到了一条 WM_MOUSEMOVE 消息时， 你从 lParam 中得到鼠标所在位置的坐标并将其改成了其他的坐标；那么原窗口函数就会认为鼠标位于其他的位置从而做出一些好玩的事如显示其他控件的 Tooltip ；你指定的返回值也是有意义的，它依靠于发送的消息；在终止你的程序时将掌握权交回给原窗口函数是很重要的，通常在Form_Unload中完成如下 : Ret&=SetWindowLongMe.Hwnd， GWL_WNDPROC， oldWndProcAddress假如你在 VB 中启动程序时忘掉了这一行，结果将是VB 崩溃并会丢失尚未储存的数据；千万要当心；3 、 AddressOf函数：另外，我们通常需要通过AddressOf函数得到一个 VB 内部的函数指针，我们可以将这个函数指针传递给需要回调这个函数的API ，它的作用就是让外部的程序可以调用VB 内部的函数；基本思路 是：我们可以使 SetWindowLong这个 API 来将原先的窗口函数指针换成自己的函数指针， 并将原先的窗口函数指针储存下来；这样窗口消息就可以发到我们自己的函数里来，并且我们随时可以用CallWindowProc来调用前面储存下来的窗口指针，以调用原先的窗口函数；这样，我们可以在不破坏原有窗口功能的前提下处理钩入的消息，这也是钩子技术的精髓；三、管中窥豹： VB 中子类技术实现的一个例子下面的例子是在网上比较常见的一个例子程序，它演示了如何将”About Me”加入窗口的系统菜单；创建工程启动 VisualBasic6 同时创建一个标准 EXE 工程；在窗体中录入代码PrivateDeclareFunctionGetSystemMenuLib"user32"ByValhWndAs Long,ByValbRe vertAs LongAs LongPrivateDeclareFunctionInsertMenuLib"user32"Alias"InsertMenuA"ByValhMenuAsLong,ByValnPositionAs Long,ByValwFlagsAs Long,ByValwIDNewItemAs Long,By VallpNewItemAs StringAs LongPrivateConstMF_BYCOMMAND=&H0&PrivateConstMF_BYPOSITION=&H400&PrivateConstMF_STRING=&H0&PrivateConstMF_SEPARATOR=&H800&PrivateSubForm_LoadInsertMenuGetSystemMenuMe.hWnd,False,0,MF_BYPOSITIONorMF_SEPARATOR, 2001,""InsertMenuGetSystemMenuMe.hWnd,False,0,MF_BYPOSITIONorMF_STRING,2002,"AboutMe&A" ' 安装子 类化入口CallInitMe.hWndEndSubPrivateSubForm_UnloadCancelAs Integer ' 卸载子类化CallTerminateMe.hWnd EndSub加入一个模块并录入代码OptionExplicitPrivateDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"ByValhWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long As LongPrivate Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ByVal lp PrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Lo ng, ByVal lParam As Long As LongConst GWL_WNDPROC = -4&Dim PrevWndProc&PrivateConstWM_SYSCOMMAND=&H112 ConstWM_DESTROY=&H2' 子类化入口PublicSubInithWndAsLongPrevWndProc=SetWindowLonghWnd,GWL_WNDPROC,AddressOfSubWndProc EndSub' 子类化出口PublicSubTerminatehWndCallSetWindowLonghWnd,As LongGWL_WNDPROC,PrevWndProcEndSub' 新的窗口消息处理过程，将被插入到默认处理过程之前PrivateFunctionSubWndProcByValhWndAs Long,ByValMsgAs Long,ByValwParam As Long,ByVallParamAs LongAs LongIfMsg=WM_DESTROYThenTerminateForm1.hWndIfwParam=2002ThenMsgBox" 呵呵，一个子类技术的例子！",vbInformation," 吴庆伟 "EndIf' 调用默认的窗口处理过程SubWndProc=CallWindowProcPrevWndProc,hWnd,Msg,wParam,lParamEndFunction但是，需要指出的是不正确的子类化是特别危急的，通常情形下将导致一个GeneralProtectionF ault （ GPF）错误，致使VB 应用立刻崩溃；四、过关斩将：如何解决VB 中对于子类技术的调试问题如前所述，一般情形下运用子类技术或者钩子技术进行编程时常常显现一些不行控的情形，从而导致VB 崩溃，因此许多人对子类是又爱又恨，缘由很简洁 它不能使用断点调试模式，这将导致VB 崩溃！ 而这也是 VB 程序员最不能接受的事实！下面是我找到的一个很好的封装了子类技术的动态链接库（zlSubTmr.dll，含源码！），它的最大特点就是能够在 VB 下进行大部分 SubClass消息捕捉的调试，而不会在断点调试模式下导致崩溃！点击下载此文件下面简洁介绍一下它的使用方法与步骤，具体请常见源码；1 、第一继承其子类：在代码申明部分写：ImplementsISubclass'继承子类2 、设置需要捕捉的消息名称：如我们需要捕捉窗体的WM_MOUSEWHEEL大事，就写：AttachMessageMe,Me.hWnd,WM_MOUSEWHEEL3 、然后处理 ISubclass_MsgResponse、ISubclass_MsgResponse和 ISubclass_WindowPr oc 三个大事；如：PrivatePropertyLetISubclass_MsgResponseByValRHSAs zlSubTmr.EMsgResponse ' 通常不处理！EndPropertyPrivatePropertyGetISubclass_MsgResponseAs zlSubTmr.EMsgResponse ' 猎取消息反馈SelectCaseCurrentMessageCaseWM_MOUSEWHEEL这里是我们需要捕捉的大事！ISubclass_MsgResponse=emrConsume '手工处理的大事CaseElseISubclass_MsgResponse=emrPreProcess' 默认处理大事EndSelectEndPropertyPrivateFunctionISubclass_WindowProcByValhwndAs Long,ByValiMsgAs Long,ByVa l wParamAs Long,ByVallParamAs LongAs Long' 进行具体的消息处理！EndFunction4 、销毁消息捕捉：DetachMessageMe,m_hWndParent,WM_ACTIVATE五、后记：关于鼠标滚动大事捕捉的一个简洁的例子仍是一个关于鼠标滚轮大事捕捉的例子，不过这个代码更简洁些，摘自；它同样是使用的子类技术进行了消息鼠标滚动时间的消息捕捉，不过实现方法特别简洁（主要归功于PeekMessage和 WaitMessage两个 API 函数），大家有爱好可以看看；PrivateConstPM_REMOVE=&H1 PrivateTypePOINTAPIx As Long y As LongEndTypePrivateTypeMsg hWndAs Long MessageAs Long wParamAs Long lParamAs Long timeAs LongptAs POINTAPIEndTypePrivateDeclareFunctionPeekMessageLib"user32"Alias"PeekMessageA"lpMsgAs Msg ， ByValhWndAs Long ， ByValwMsgFilterMinAs Long ， ByValwMsgFilterMaxAs Long ，ByValwRemoveMsgAs LongAs LongPrivateDeclareFunctionWaitMessageLib"user32"As Long PrivatebCancelAs BooleanPrivateConstWM_MOUSEWHEEL=522PrivateSubProcessMessages DimMessageAs MsgDoWhileNotbCancelWaitMessage'WaitFormessageand.IfPeekMessageMessage， Me.hWnd， WM_MOUSEWHEEL， WM_MOUSEWHEEL， P M_REMOVEThen'.whenthemousewheelis used.IfMessage.wParam<0 Then'.scrollup.Me.Top=Me.Top+240 Else'.orscrolldownMe.Top=Me.Top- 240 EndIfEndIf DoEvents LoopEndSubPrivateSubForm_Load Me.AutoRedraw=TrueMe.Print"Pleaseusenowmousewheeltomovethisform." Me.ShowProcessMessages EndSubPrivateSubForm_UnloadCancelAs Integer bCancel=TrueEndSub