在 VBA 中使用 WinAPI 创建的 ListBox 不起作用

Question

我想用 WinAPI 在 VBA 中创建一个 ListBox。我设法创建它，但 ListBox 不响应操作 - 没有滚动，没有选择。这些都不起作用。它看起来像它被禁用了。如何让它响应动作？ 以下代码用于创建和填充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&

Answer 2

答案是致电SetParent 感谢David Hefferman 指出这一点。

所以根本不需要子类化。

用户窗体类

Option Explicit

Private Declare Function SetParent Lib "user32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Private Const GWL_WNDPROC As Long = -4

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

Private 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

Private 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 Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_VSCROLL As Long = &H200000

Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_SIZEBOX As Long = WS_THICKFRAME

Private Const WS_BORDER            As Long = &H800000 '* From WinUser.h

Private Const LB_INSERTSTRING      As Long = &H181

Private Enum ListboxStyle
    '* From WinUser.h
    LBS_NOTIFY = &H1
    LBS_HASSTRINGS = &H40
End Enum

Private Enum WindowStylesEx
    '* From WinUser.h
    WS_EX_CLIENTEDGE = &H200
End Enum

Private mlHwndList As Long


Sub JohnyL_Listbox()


    Dim lHwndForm As Long
    lHwndForm = FindWindow("ThunderDFrame", Me.Caption)

    mlHwndList = 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:=110, _
            nHeight:=110, _
            hWndParent:=FindWindow("ThunderDFrame", Me.Caption), _
            hMenu:=0, _
            hInstance:=Application.hInstance, _
            lpParam:=0 _
        )

    SetParent mlHwndList, lHwndForm
End Sub


Private Sub UserForm_Initialize()

    JohnyL_Listbox

    Dim X As Integer
    For X = 10 To 1 Step -1
        Call SendMessage(mlHwndList, LB_INSERTSTRING, 0, CStr(X))
    Next


End Sub