在VBA中侦听用WinAPI创建的控件中的Windows消息

我非常了解如何使用WinAPI在VBA中正确创建控件（尤其是ListBox）。 因此，根据VBA如何处理窗口的结构，我们有三个句柄：

hWin

-用户表单的句柄

hClient

-用户表单子级句柄（服务器）

hList

-列表框的句柄

---

问题是-如何侦听从Windows传入并由ListBox生成的Windows消息？

若要侦听消息，请覆盖处理发送到窗口的消息的函数，在本例中为

hClient

要在

UserForm1

中收听选择的更改：

Option Explicit

Private hWin As LongPtr
Private hClient As LongPtr
Private hList As LongPtr    

Private Sub UserForm_Initialize()

    ' get the top window handle '
    hWin = FindWindowEx(0, 0, StrPtr("ThunderDFrame"), StrPtr(Me.Caption))
    If hWin Then Else Err.Raise 5, , "Top window not found"

    ' get first child / client window '
    hClient = FindWindowEx(hWin, 0, 0, 0)
    If hClient Then Else Err.Raise 5, , "Client window not found"

    ' create the list box '
    hList = CreateWindowEx( _
        dwExStyle:=WS_EX_CLIENTEDGE, _
        lpClassName:=StrPtr("LISTBOX"), _
        lpWindowName:=0, _
        dwStyle:=WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_SIZEBOX Or LBS_NOTIFY Or LBS_HASSTRINGS, _
        x:=10, _
        y:=10, _
        nWidth:=100, _
        nHeight:=100, _
        hwndParent:=hClient, _
        hMenu:=0, _
        hInstance:=0, _
        lpParam:=0)

    ' add some values '
    SendMessage hList, LB_ADDSTRING, 0, StrPtr("item a")
    SendMessage hList, LB_ADDSTRING, 0, StrPtr("item b")
    SendMessage hList, LB_ADDSTRING, 0, StrPtr("item c")

    ' intercept messages '
    UserForm1_Register Me, hClient
End Sub

Public Sub WndProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr)
    Select Case uMsg
        Case WM_COMMAND
            Select Case (wParam \ 65536) And 65535 ' HIWORD '
                Case LBN_SELCHANGE
                    Debug.Print "Selection changed"

            End Select
    End Select
End Sub

在模块中：

Option Explicit

Public Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExW" ( _
    ByVal hwndParent As LongPtr, _
    ByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As LongPtr, _
    ByVal lpszWindow As LongPtr) As LongPtr

Public Declare PtrSafe Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExW" ( _
    ByVal dwExStyle As Long, _
    ByVal lpClassName As LongPtr, _
    ByVal lpWindowName As LongPtr, _
    ByVal dwStyle As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hwndParent As LongPtr, _
    ByVal hMenu As LongPtr, _
    ByVal hInstance As LongPtr, _
    ByVal lpParam As LongPtr) As LongPtr

Public Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageW" ( _
    ByVal hwnd As LongPtr, _
    ByVal wMsg As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr) As LongPtr

Private Declare PtrSafe Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcW" ( _
    ByVal lpPrevWndFunc As LongPtr, _
    ByVal hwnd As LongPtr, _
    ByVal Msg As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr) As LongPtr

#If Win64 Then
    Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongPtrW" ( _
      ByVal hwnd As LongPtr, _
      ByVal nIndex As Long, _
      ByVal dwNewLong As LongPtr) As Long
#Else
    Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongW" ( _
      ByVal hwnd As LongPtr, _
      ByVal nIndex As Long, _
      ByVal dwNewLong As LongPtr) As Long
#End If

Public Const WS_EX_CLIENTEDGE = &H200&
Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_VSCROLL = &H200000
Public Const WS_SIZEBOX = &H40000
Public Const LBS_NOTIFY = &H1&
Public Const LBS_HASSTRINGS = &H40&
Public Const LB_ADDSTRING = &H180&
Public Const GW_CHILD = &O5&
Public Const GWL_WNDPROC As Long = -4
Public Const WM_COMMAND = &H111&
Public Const LBN_SELCHANGE = 1

Private UserForm1_Form As UserForm1
Private UserForm1_Func As LongPtr

Public Sub UserForm1_Register(form As UserForm1, ByVal hwnd As LongPtr)
    Set UserForm1_Form = form
    UserForm1_Func = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf UserForm1_WinProc)
    If UserForm1_Func = 0 Then Err.Raise 1, , "Failed to register"
End Sub

Private Function UserForm1_WinProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
   UserForm1_Form.WndProc hwnd, uMsg, wParam, lParam
   UserForm1_WinProc = CallWindowProc(UserForm1_Func, hwnd, uMsg, wParam, lParam)
End Function

---

谢谢UserForm已成功创建并显示，但在我在ListBox中选择一个项目后，所有内容都冻结。我猜，这是一个变量类型的问题。例如，在

UserForm1\u WinProc

过程中，您对

wParam

使用

LongPtr

类型，但在

CallWindowProc

声明中使用

Long

。从文档中，我无法确定它是指针还是整数值。其次，对于32位和64位的窗口（由

别名
表示），您使用
SetWindowLong
，但我猜您的意思是针对Win64的
SetWindowLongPtrW
。我会进一步挖掘：）你说得对，在64位使用中签名不正确。当我使用Excel 32位运行它时，任何东西都不会冻结。你的办公室是64位的吗？是的，我使用Excel 2010 64位。今天我将在Excel2007（WindowsXP）中测试这段代码。我猜，我对类型做了一些错误：（我刚刚注意到，
CallWindowProc
中的
lpPrevWndFunc
也需要是
LongPtr
和
dwNewLong
与
SetWindowLongPtr