ATL の ActiveX コンテナ

UserForm1.frm

Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" ( _
    ByVal IAcessible As Object, _
    ByRef hwnd As LongPtr _
) As Long

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

Private Declare _
Function SetParent Lib "user32.dll" ( _
    ByVal hWndChild As LongPtr, _
    ByVal hWndNewParent As LongPtr _
) As LongPtr

Private Type Rect
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

Private Declare _
Function GetClientRect Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    lpRect As Rect _
) As Long

Private Declare _
Function SetWindowPos Lib "user32.dll" ( _
    ByVal hwnd As LongPtr, _
    ByVal hWndInsertAfter As LongPtr, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal uFlags As Long _
) As Long

Private Declare _
Function AtlAxWinInit Lib "atl.dll" () As Long

Private Declare _
Function AtlAxAttachControl Lib "atl.dll" ( _
    ByVal pControl As stdole.IUnknown, _
    ByVal hwnd As LongPtr, _
    ppUnkContainer As LongPtr _
) As LongPtr
Private Declare PtrSafe Function GetTopWindow Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
Const GWL_STYLE = (-16)

Private WithEvents ie As SHDocVw.InternetExplorer
Private m_pContainer As LongPtr

Private Sub ie_NewProcess(ByVal lCauseFlag As Long, ByVal pWB2 As Object, Cancel As Boolean)
        Debug.Print "ie_NewProcess"
End Sub

Private Sub ie_OnQuit()
    Debug.Print "ie_OnQuit"
End Sub

Private Sub UserForm_Initialize()

    Dim pUnk As hoge.InternetExplorerManager
    Set pUnk = New InternetExplorerManager
    
    Dim hr As Long
    Dim u As UUID
    hr = hoge.IIDFromString(hoge.IID_IWebBrowser2, u)

    Set ie = pUnk.CreateObject(1, vbNullString, u)
    Set pUnk = Nothing

    Dim h As LongPtr
    WindowFromAccessibleObject Me, h
    h = GetTopWindow(h)
    
    Dim hwndie As LongPtr
    hwndie = ie.hwnd
    Dim ws As Long
    ws = WS_CHILD Or WS_VISIBLE
    SetWindowLongPtrW hwndie, GWL_STYLE, ws
    SetParent hwndie, h

    Dim rc As Rect
    GetClientRect h, rc

    SetWindowPos hwndie, 0, _
               0, 0, rc.right - rc.left, rc.bottom - rc.top + 20, 0
    Debug.Print Hex(AtlAxWinInit), "a"
    Debug.Print AtlAxAttachControl(ie, h, m_pContainer), "b"
    ie.Navigate "http://www.yahoo.co.jp/"
    
End Sub