在 VBA 中收听控制中的 Windows 消息，使用 WinAPI 创建 [英] Listen to Windows messages in control, created with WinAPI, in VBA

问题描述

我有一个很好的帮助了解如何使用 WinAPI 在 VBA 中正确创建控件(特别是 ListBox).所以，根据结构，VBA如何处理窗口，我们有3个句柄:

1. hWin - 用户窗体的句柄
2. hClient - 用户窗体子句柄(服务器)
3. hList - ListBox 的句柄

问题是 - 如何收听 Windows 消息，从 Windows 传入并由 ListBox 生成?

解决方案

要监听消息，重写处理发送到窗口的消息的函数，在本例中为 hClient.p>

要监听 UserForm1 中的选择变化:

选项显式私人 hWin As LongPtr私有 hClient As LongPtr私有 hList As LongPtr私有子 UserForm_Initialize()'获取顶部窗口句柄'hWin = FindWindowEx(0, 0, StrPtr("ThunderDFrame"), StrPtr(Me.Caption))If hWin Then Else Err.Raise 5, , "Top window not found"'获取第一个子/客户窗口'hClient = FindWindowEx(hWin, 0, 0, 0)If hClient Then Else Err.Raise 5, , "Client window not found"'创建列表框'hList = CreateWindowEx(_dwExStyle:=WS_EX_CLIENTEDGE, _lpClassName:=StrPtr("LISTBOX"), _lpWindowName:=0, _dwStyle:=WS_CHILD 或 WS_VISIBLE 或 WS_VSCROLL 或 WS_SIZEBOX 或 LBS_NOTIFY 或 LBS_HASSTRINGS，_x:=10, _y:=10, _nWidth:=100, _nHeight:=100, _hwndParent:=hClient, _hMenu:=0, _hInstance:=0, _lpParam:=0)'添加一些值'SendMessage hList, LB_ADDSTRING, 0, StrPtr("item a")SendMessage hList, LB_ADDSTRING, 0, StrPtr("item b")SendMessage hList, LB_ADDSTRING, 0, StrPtr("item c")'拦截消息'UserForm1_Register Me, hClient结束子Public Sub WndProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr)选择案例 uMsg案例 WM_COMMAND选择大小写 (wParam  65536) 和 65535 ' HIWORD '案例 LBN_SELCHANGEDebug.Print "选择改变"结束选择结束选择结束子

在一个模块中:

选项显式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 LongPtrPublic Declare PtrSafe Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExW" (_ByVal dwExStyle 只要，_ByVal lpClassName As LongPtr, _ByVal lpWindowName As LongPtr, _ByVal dwStyle 只要，_ByVal x 只要，_ByVal y 只要，_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公开声明 PtrSafe 函数 SendMessage Lib "user32.dll" Alias "SendMessageW" (_ByVal hwnd As LongPtr, _ByVal wMsg 只要，_ByVal wParam As LongPtr, _ByVal lParam As LongPtr) As LongPtrPrivate Declare PtrSafe Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcW" (_ByVal lpPrevWndFunc As LongPtr, _ByVal hwnd As LongPtr, _ByVal 消息只要，_ByVal wParam As LongPtr, _ByVal lParam As LongPtr) As LongPtr#如果 Win64 则Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongPtrW" (_ByVal hwnd As LongPtr, _ByVal nIndex 只要，_ByVal dwNewLong As LongPtr) 只要#别的Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongW" (_ByVal hwnd As LongPtr, _ByVal nIndex 只要，_ByVal dwNewLong As LongPtr) 只要#万一公共常量 WS_EX_CLIENTEDGE = &H200&公共常量 WS_CHILD = &H40000000公共常量 WS_VISIBLE = &H10000000公共常量 WS_VSCROLL = &H200000公共常量 WS_SIZEBOX = &H40000公共常量 LBS_NOTIFY = &H1&公共常量 LBS_HASSTRINGS = &H40&公共常量 LB_ADDSTRING = &H180&公共常量 GW_CHILD = &O5&公共常量 GWL_WNDPROC 只要 = -4公共常量 WM_COMMAND = &H111&公共常量 LBN_SELCHANGE = 1私有 UserForm1_Form 作为 UserForm1Private UserForm1_Func As LongPtrPublic Sub UserForm1_Register(form As UserForm1, ByVal hwnd As LongPtr)设置 UserForm1_Form = formUserForm1_Func = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf UserForm1_WinProc)If UserForm1_Func = 0 Then Err.Raise 1, , "Failed to register"结束子私有函数 UserForm1_WinProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtrUserForm1_Form.WndProc hwnd、uMsg、wParam、lParamUserForm1_WinProc = CallWindowProc(UserForm1_Func, hwnd, uMsg, wParam, lParam)结束功能

I had a great help with understanding how to correctly create controls (particularly, ListBox) in VBA with WinAPI. So, according to the structure, how VBA handles windows, we have three handles:

1. hWin - UserForm's handle
2. hClient - UserForm child's handle (Server)
3. hList - ListBox's handle

The question is - how to listen to Windows messages, incoming from Windows and generated by ListBox?

解决方案

To listen to the messages, override the function that processes messages sent to a window, which is in this case hClient.

To listen to a change of selection in 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

and in a module:

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

这篇关于在 VBA 中收听控制中的 Windows 消息，使用 WinAPI 创建的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！