ListBox created with WinAPI in VBA doesn't wor

问题:

I want to create a ListBox in VBA with WinAPI. I managed to create it, but ListBox doesn't respond to actions - no scrolling, no selecting. None of this works. It looks like it's disabled. How to make it respond to actions? The following code was used to create and fill ListBox.

WinAPI functions

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

Creating ListBox:

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 _
    )

Filling ListBox:

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

Result:

回答1:

Your listbox is not interactable because it doesn't receive the messages sent to the window. It seems that all the messages are handled by a child container:

To make it work, call CreateWindow with hWndParent set to handle of this container :

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

and for the declarations:

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&

回答2:

The answer is to call SetParent thanks to David Hefferman for pointing that out.

So no need to subclass at all.

The Userform class

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