在VBA中使用WinAPI创建的列表框不起作用 [英] ListBox created with WinAPI in VBA doesn't work

问题描述

我想用WinAPI在VBA中创建一个列表框.我设法创建了它，但是ListBox没有响应动作-没有滚动，没有选择.这些都不起作用.似乎已被禁用.如何使其对动作做出反应? 以下代码用于创建和填充ListBox.

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函数

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

结果:

推荐答案

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

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:

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

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

以及声明:

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&

这篇关于在VBA中使用WinAPI创建的列表框不起作用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！