Как получить Handle элемента управления пользовательской формы?

''©©©©©©©©©©©©©©©©©©© Список классов Window ©©©©©©©©©©©©©©©©©
''©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©©
''Имя класса
''---------
''BUTTON
 
''COMBOBOX
 
''EDIT
 
''LISTBOX
 
''MDICLIENT
 
''RICHEDIT
 
''RICHEDIT_CLASS
 
''SCROLLBAR
 
''STATIC
Option Explicit
Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, 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, lpParam As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'нет описания
Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
 
Public Type WNDCLASS
    style As Long
    lpfnwndproc As Long
    cbClsextra As Long
    cbWndExtra2 As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
End Type
 
Public Type POINTAPI
    x As Long
    y As Long
End Type
 
Public Type Msg
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
Public Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2
Public Const CW_USEDEFAULT = &H80000000
Public Const ES_MULTILINE = &H4&
Public Const WS_BORDER = &H800000
Public Const WS_CHILD = &H40000000
Public Const WS_OVERLAPPED = &H0&
Public Const WS_CAPTION = &HC00000 'WS_BORDER Or WS_DLGFRAME
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME _
Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const WS_EX_CLIENTEDGE = &H200&
Public Const COLOR_WINDOW = 5
Public Const WM_DESTROY = &H2
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const IDC_ARROW = 32512&
Public Const IDI_APPLICATION = 32512&
Public Const GWL_WNDPROC = (-4)
Public Const SW_SHOWNORMAL = 1
Public Const MB_OK = &H0&
Public Const MB_ICONEXCLAMATION = &H30&
Public Const gClassName = "MyClassName"
Public Const gAppName = "VBA-Проект: Создание формы при помощи API"
Public gButOldProc As Long ''Will hold address of the old window proc for the button
Public gHwnd As Long, gButtonHwnd As Long, gEditHwnd As Long ''You don't necessarily need globals, _
but if you're planning to gettext and stuff, then you're gona have to store the hwnds.
 
Public Sub Main()
    Dim wMsg As Msg
    'Регистрируем имя класса окна. В случае ошибки выходим
    If RegisterWindowClass = False Then Exit Sub
    'Создаем окно
    If CreateWindows Then
        ''Loop will exit when WM_QUIT is sent to the window.
        Do While GetMessage(wMsg, 0&, 0&, 0&)
            ''TranslateMessage takes keyboard messages and converts
            ''them to WM_CHAR for easier processing.
            Call TranslateMessage(wMsg)
            ''Dispatchmessage calls the default window procedure
            ''to process the window message. (WndProc)
            Call DispatchMessage(wMsg)
        Loop
    End If
    Call UnregisterClass(gClassName$, Application.hInstance)
End Sub
 
Public Function RegisterWindowClass() As Boolean
    Dim wc As WNDCLASS
    'Регистрируем новое окно
    wc.style = CS_HREDRAW Or CS_VREDRAW
    wc.lpfnwndproc = GetAddress(AddressOf WndProc) ''Address in memory of default window procedure.
    wc.hInstance = Application.hInstance
    wc.hIcon = LoadIcon(0&, IDI_APPLICATION) 'значок по умолчанию
    wc.hCursor = LoadCursor(0&, IDC_ARROW) 'стандартный курсор
    wc.hbrBackground = COLOR_WINDOW 'стандартный цвет окна
    wc.lpszClassName = gClassName$
    RegisterWindowClass = RegisterClass(wc) <> 0
End Function
 
Public Function CreateWindows() As Boolean
    'Создаем само окно формы
    gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, _
    CW_USEDEFAULT, 500, 190, 0&, 0&, Application.hInstance, ByVal 0&)
    'Создаем окно-кнопку
    gButtonHwnd& = CreateWindowEx(0&, "Button", "Нажми", WS_CHILD, 190, 95, 125, 40, gHwnd&, 0&, _
    Application.hInstance, 0&)
    'Создаем текстовое поле с окантовкой (WS_EX_CLIENTEDGE) и мультистрочным (ES_MULTILINE)
    gEditHwnd& = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "Это текстовое поле." & vbCrLf & "Оно многострочное.", _
    WS_CHILD Or ES_MULTILINE, 50, 5&, 400, 80, gHwnd&, 0&, Application.hInstance, 0&)
    ''Since windows are hidden, show them. You can use UpdateWindow to
    ''redraw the client area.
    Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
    Call ShowWindow(gButtonHwnd&, SW_SHOWNORMAL)
    Call ShowWindow(gEditHwnd&, SW_SHOWNORMAL)
    ''Get the memory address of the default window
    ''procedure for the button and store it in gButOldProc
    ''This will be used in ButtonWndProc to call the original
    ''window procedure for processing.
    gButOldProc& = GetWindowLong(gButtonHwnd&, GWL_WNDPROC)
    ''Set default window procedure of button to ButtonWndProc. Different
    ''settings of windows is listed in the MSDN Library. We are using GWL_WNDPROC
    ''to set the address of the window procedure.
    Call SetWindowLong(gButtonHwnd&, GWL_WNDPROC, GetAddress(AddressOf ButtonWndProc))
    CreateWindows = (gHwnd& <> 0)
End Function
 
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam _
As Long) As Long
    ''This our default window procedure for the window. It will handle all
    ''of our incoming window messages and we will write code based on the
    ''window message what the program should do.
    Dim strTemp As String
    Select Case uMsg&
    Case WM_DESTROY:
        ''Since DefWindowProc doesn't automatically call
        ''PostQuitMessage (WM_QUIT). We need to do it ourselves.
        ''You can use DestroyWindow to get rid of the window manually.
        Call PostQuitMessage(0&)
        Application.Visible = 1 'Восстанавливаем лист
    End Select
    'Пусть windows вызывает оконные процедуры по умолчанию
    WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)
End Function
 
Public Function ButtonWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal _
lParam As Long) As Long
    On Error Resume Next
    Select Case uMsg&
    Case WM_LBUTTONUP:
        ''Left mouse button went up (user clicked the button)
        ''You can use WM_LBUTTONDOWN for the MouseDown event.
        ''We use the MessageBox API call because the built in
        ''function 'MsgBox'stops thread processes, which causes
        ''flickering.
        Call MessageBox(gHwnd&, "Вы нажали на кнопку!", Application.ThisWorkbook.Name, MB_OK Or MB_ICONEXCLAMATION)
    End Select
    ''Since in MyCreateWindow we made the default window proc
    ''this procedure, we have to call the old one using CallWindowProc
    ButtonWndProc = CallWindowProc(gButOldProc&, hwnd&, uMsg&, wParam&, lParam&)
End Function
 
Public Function GetAddress(ByVal lngAddr As Long) As Long
    ''Used with AddressOf to return the address in memory of a procedure.
    GetAddress = lngAddr&
End Function