vba - 在 VBA 中使用 WinAPI 创建的列表框不起作用

Question

我想使用 WinAPI 在 VBA 中创建一个列表框。我设法创建它，但 ListBox 不响应操作 - 不滚动，不选择。这些都不起作用。看起来像是被禁用了。如何让它响应 Action ？以下代码用于创建和填充ListBox。

WinAPI函数

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long

Declare Function CreateWindow Lib "user32.dll" Alias "CreateWindowExA" ( _
     ByVal dwExStyle As WindowStylesEx, _
     ByVal lpClassName As String, _
     ByVal lpWindowName As String, _
     ByVal dwStyle As Long, _
     ByVal x As Long, _
     ByVal y As Long, _
     ByVal nWidth As Long, _
     ByVal nHeight As Long, _
     ByVal hWndParent As Long, _
     ByVal hMenu As Long, _
     ByVal hInstance As Long, _
     ByVal lpParam As Long) As Long

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Any) As Long

创建列表框:

Private hlist As Long
hlist = WinAPI.CreateWindow( _
        dwExStyle:=WS_EX_CLIENTEDGE, _
        lpClassName:="LISTBOX", _
        lpWindowName:="MYLISTBOX", _
        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:=WinAPI.FindWindow("ThunderDFrame", Me.Caption), _
        hMenu:=0, _
        hInstance:=Application.hInstance, _
        lpParam:=0 _
    )

填充列表框:

Dim x As Integer
For x = 10 To 1 Step -1
    Call WinAPI.SendMessage(hlist, LB_INSERTSTRING, 0, CStr(x))
Next

结果:

Answer 1

您的列表框不可交互，因为它没有接收发送到窗口的消息。似乎所有消息都由子容器处理:

要使其正常工作，请调用 CreateWindow 并将 hWndParent 设置为此容器的句柄:

Private Sub UserForm_Initialize()
    Dim hWin, hClient, hList, i As Long

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

    ' get first child '
    hClient = GetWindow(hWin, GW_CHILD)

    ' create the list box '
    hList = CreateWindow( _
        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 '
    For i = 1 To 13
        SendMessage hList, LB_ADDSTRING, 0, StrPtr(CStr(i))
    Next

End Sub

对于声明:

Public Declare PtrSafe Function GetWindow Lib "user32.dll" ( _
    ByVal hWnd As LongPtr, _
    ByVal uCmd As Long) As LongPtr

Public Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowW" ( _
    ByVal lpClassName As LongPtr, _
    ByVal lpWindowName As LongPtr) As Long

Public Declare PtrSafe Function CreateWindow 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

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&