ListBox created with WinAPI in VBA doesn't work - vba

Question

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:

Answer 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&

Answer 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