Listen to Windows messages in control, created wit

问题:

I had a great help with understanding how to correctly create controls (particularly, ListBox) in VBA with WinAPI. So, according to the structure, how VBA handles windows, we have three handles:

1. hWin - UserForm's handle
2. hClient - UserForm child's handle (Server)
3. hList - ListBox's handle

The question is - how to listen to Windows messages, incoming from Windows and generated by ListBox?

回答1:

To listen to the messages, override the function that processes messages sent to a window, which is in this case hClient.

To listen to a change of selection in UserForm1:

Option Explicit

Private hWin As LongPtr
Private hClient As LongPtr
Private hList As LongPtr    

Private Sub UserForm_Initialize()

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

    ' get first child / client window '
    hClient = FindWindowEx(hWin, 0, 0, 0)
    If hClient Then Else Err.Raise 5, , "Client window not found"

    ' create the list box '
    hList = CreateWindowEx( _
        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 '
    SendMessage hList, LB_ADDSTRING, 0, StrPtr("item a")
    SendMessage hList, LB_ADDSTRING, 0, StrPtr("item b")
    SendMessage hList, LB_ADDSTRING, 0, StrPtr("item c")

    ' intercept messages '
    UserForm1_Register Me, hClient
End Sub

Public Sub WndProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr)
    Select Case uMsg
        Case WM_COMMAND
            Select Case (wParam \ 65536) And 65535 ' HIWORD '
                Case LBN_SELCHANGE
                    Debug.Print "Selection changed"

            End Select
    End Select
End Sub

and in a module:

Option Explicit

Public Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExW" ( _
    ByVal hwndParent As LongPtr, _
    ByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As LongPtr, _
    ByVal lpszWindow As LongPtr) As LongPtr

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

Private Declare PtrSafe Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcW" ( _
    ByVal lpPrevWndFunc As LongPtr, _
    ByVal hwnd As LongPtr, _
    ByVal Msg As Long, _
    ByVal wParam As LongPtr, _
    ByVal lParam As LongPtr) As LongPtr

#If Win64 Then
    Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongPtrW" ( _
      ByVal hwnd As LongPtr, _
      ByVal nIndex As Long, _
      ByVal dwNewLong As LongPtr) As Long
#Else
    Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongW" ( _
      ByVal hwnd As LongPtr, _
      ByVal nIndex As Long, _
      ByVal dwNewLong As LongPtr) As Long
#End If

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&
Public Const GWL_WNDPROC As Long = -4
Public Const WM_COMMAND = &H111&
Public Const LBN_SELCHANGE = 1

Private UserForm1_Form As UserForm1
Private UserForm1_Func As LongPtr

Public Sub UserForm1_Register(form As UserForm1, ByVal hwnd As LongPtr)
    Set UserForm1_Form = form
    UserForm1_Func = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf UserForm1_WinProc)
    If UserForm1_Func = 0 Then Err.Raise 1, , "Failed to register"
End Sub

Private Function UserForm1_WinProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
   UserForm1_Form.WndProc hwnd, uMsg, wParam, lParam
   UserForm1_WinProc = CallWindowProc(UserForm1_Func, hwnd, uMsg, wParam, lParam)
End Function