Visual Basic/子类化

当您想要添加 Visual Basic 不直接支持的功能时，子类化可能很有用。为了解释它是如何工作的，我们必须先了解一些背景理论。

Windows 中的所有窗口（例如窗体、按钮、列表框等）都具有一个函数，操作系统或其他程序可以调用该函数来与程序通信。例如，Windows 可以发送有关事件的消息，例如鼠标指针移过窗口、窗口处于焦点时按下某个键，以及更多情况。程序也可以发送请求窗口信息的消息；例如，EM_GETLINECOUNT 消息要求文本框发送回它保存的文本行数。您也可以定义自己的函数。

要调用这些特殊函数，您可以使用PostMessage、SendMessage 或CallWindowProc（如果您知道函数的地址，则仅使用最后一个）。

通常，这样的过程看起来像这样

  Public Function WindowProc(ByVal hwnd As Long, _
                             ByVal uMsg As Long, _
                             ByVal wParam As Long, _ 
                             ByVal lParam As Long) As Long
    	
    ' Your code here
    
    Select Case uMsg
      Case 0
        ' React to message 0 
      Case 1
        ' React to message 1
    End Select
    		
    WindowProc = 0 ' Return a value to the caller
    	
   End Function

在此函数中，hwnd 是调用方尝试联系的窗口的句柄；uMsg 是消息标识符，它说明调用是关于什么的；wParam 和lParam 用于调用方和窗口之间商定的任何用途。句柄 hwnd 不是地址，而是由 Windows 用于查找地址。

例如，如果我们要设置窗体标题栏中显示的文本，可以使用以下代码

  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
          (ByVal hwnd As Long, _ 
           ByVal wMsg As Long, _
           ByVal wParam As Integer, _
           ByVal lParam As Any) As Long
    
    Private Const WM_SETTEXT = &HC
    
  Private Sub Form_Load()  
    SendMessage Me.hwnd, WM_SETTEXT, 0&, "This is a test"
  End Sub

The receiver will get this message via its window function, which will look something like this:

  Public Function WindowProc(ByVal hwnd As Long, _
                             ByVal uMsg As Long, _
                             ByVal wParam As Long, _ 
                             ByVal lParam As Long) As Long
    	
    ' hwnd is now equal to Me.hwnd, 
    ' uMsg is WM_SETTEXT, 
    ' wParam is 0 
    ' lParam is the address of the text: "This is a test"
         	
    ' It doesn't actually look like this of course, but this gives 
    ' a good enough impression of what happens under the surface
    Select Case uMsg
    	Case WM_SETTEXT	
        Me.Caption = lParam
      'Case ...
        '... many more here
    End Select    
  End Function

'one thing i have to say is if you press alt+f11 in vbe subclass not remove when you use unsubclassform and convey to vbe so this function have to be updated

为什么要子类化

子类化的意义何在？

使用此技术，我们可以完全用自己的窗口函数替换程序的窗口函数。然后，我们可以以 Visual Basic 不允许的方式响应消息，我们可以选择将消息进一步发送到原始窗口函数，也可以不发送，我们可以根据自己的喜好以任何方式修改它们。

示例

要指定要使用我们的窗口函数，我们使用API 调用SetWindowLong。研究以下示例，并将其放在一个基本模块中

  Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
          (ByVal hwnd As Long, _
           ByVal nIndex As Long, _  
           ByVal dwNewLong As Long) As Long
  
  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
    
  Declare Function SetClipboardViewer Lib "user32" _
          (ByVal hwnd As Long) As Long
    
  Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
          (ByVal hwnd As Long, _
           ByVal wMsg As Long, _ 
           ByVal wParam As Integer, _
           ByVal lParam As Any) As Long
    
  Public Const WM_SETTEXT = &HC
  Public Const GWL_WNDPROC = (-4)
    
  Private PrevProc As Long ' The address of the original window function
    
  Public Sub SubclassForm(F As Form)  
    ' AddressOf WindowProc = finds the address of a function
    PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
  End Sub
    
  Public Sub UnSubclassForm(F As Form)    
    ' It is _very_ important that we restore the original window function,
    ' because VB will crash if we don't.
    SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
  End Sub
    
  Public Function WindowProc(ByVal hwnd As Long, _
                             ByVal uMsg As Long, _
                             ByVal wParam As Long, _ 
                             ByVal lParam As Long) As Long
        
    Dim sTemp As String
        
    If uMsg = WM_SETTEXT Then
      ' Don't let the text get through, replace it with our own. Also, because all
      ' strings in VB are of the format UTF-16 (Unicode) and the receiving method
      ' expects a zero-terminated ASCII-string, it is necessary to convert it before
      ' passing it further down the chain.
      sTemp = StrConv("Subclassing" & Chr(0), vbFromUnicode)
      lParam = StrPtr(sTemp) ' get the address of our text
    End If
        
    ' Call the original function
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
  End Function

添加一个带有一个按钮cmdTest 的窗体，并添加以下代码

  Private Sub cmdTest_Click()
    SendMessage Me.hwnd, WM_SETTEXT, 0&, "This is a test"
  End Sub
    
  Private Sub Form_Load()    
    ' Start subclassing
    SubclassForm Me    
  End Sub
    
  Private Sub Form_Unload(Cancel As Integer)
    ' WARNING: If you stop the project (for example with the stop button) without calling this, 
    ' your program, as well as the VB IDE, will most likely crash.
    UnSubclassForm Me
  End Sub

当您单击cmdTest 按钮时，您会看到显示的文本不是“这是一个测试”，而是“子类化”。

上一个: Windows_API

下一个: External_Processes