/* ----------------------------------------------------------------
	WSLib7_IeComponent.sbp

	IEコンポーネント(ショートカットを内部で自前処理)を
	簡単にクラスIE_COMPONENT。

	作成：淡幻星
	ベース：http://www.activebasic.com/forum/viewtopic.php?p=8861
　　※上記のWebページを参照にしたラッパークラスです。
---------------------------------------------------------------- */

#ifndef _IE_COMPONENT_
#define _IE_COMPONENT_



TypeDef HRESULT=Long
TypeDef BSTR=WordPtr

Interface IDispatch 
    Inherits IUnknown 

    Function GetTypeInfoCount(pctinfo As DWordPtr) As HRESULT 
    Function GetTypeInfo(iTInfo As DWord,lcid As DWord,ITypeInfo As VoidPtr) As HRESULT 
    Function GetIDsOfNames(riid As DWord,rgszNames As BytePtr,cNames As DWord,lcid As DWord,rgDispID As DWordPtr) As HRESULT 
    Function Invoke(dispIdMember As DWord,riid As DWord,lcid As DWord,wFlags As Word,pDispParams As DWordPtr,pVarResult As VoidPtr,pExcepInfo As DWordPtr,puArgErr As DWordPtr) As HRESULT 

End Interface 



Interface IWebBrowser 
    Inherits IDispatch 

    Function GoBack() As HRESULT 
    Function GoForward() As HRESULT 
    Function GoHome() As HRESULT 
    Function GoSearch() As HRESULT 
    Function Navigate(URL As BSTR,Flags As VoidPtr,TargetFrameName As VoidPtr,PostData As VoidPtr,Headers As VoidPtr) As HRESULT 
    Function Refresh() As HRESULT 
    Function Refresh2(Level As VoidPtr) As HRESULT 
    Function Stop() As HRESULT 
    Function get_Application(ppDisp As VoidPtr) As HRESULT 
    Function get_Parent(ppDisp As VoidPtr) As HRESULT 
    Function get_Container(ppDisp As VoidPtr) As HRESULT 
    Function get_Document(ppDisp As VoidPtr) As HRESULT 
    Function get_TopLevelContainer(pBool As VoidPtr) As HRESULT 
    Function get_Type(Type_ As *BSTR) As HRESULT 
    Function get_Left(pl As *Long) As HRESULT 
    Function put_Left(Left As Long) As HRESULT 
    Function get_Top(pl As *Long) As HRESULT 
    Function get_Top(Top As Long) As HRESULT 
    Function get_Width(pl As *Long) As HRESULT 
    Function get_Width(Width As Long) As HRESULT 
    Function get_Height(pl As *Long) As HRESULT 
    Function get_Height(Height As Long) As HRESULT 
    Function get_LocationName(LocationName As *BSTR) As HRESULT 
    Function get_LocationURL(LocationURL As *BSTR) As HRESULT 
    Function get_Busy() As HRESULT 

End Interface 



Interface IWebBrowserApp 
    Inherits IWebBrowser 

    Function Quit() As HRESULT 
    Function ClientToWindow() As HRESULT 
    Function PutProperty() As HRESULT 
    Function GetProperty() As HRESULT 
    Function get_Name() As HRESULT 
    Function get_HWND() As HRESULT 
    Function get_FullName() As HRESULT 
    Function get_Path() As HRESULT 
    Function get_Visible() As HRESULT 
    Function put_Visible(bBool As Long) As HRESULT 
    Function get_StatusBar() As HRESULT 
    Function put_StatusBar() As HRESULT 
    Function get_StatusText() As HRESULT 
    Function put_StatusText() As HRESULT 
    Function get_ToolBar() As HRESULT 
    Function put_ToolBar() As HRESULT 
    Function get_MenuBar() As HRESULT 
    Function put_MenuBar() As HRESULT 
    Function get_FullScreen() As HRESULT 
    Function put_FullScreen() As HRESULT 

End Interface 



Interface IWebBrowser2 
    Inherits IWebBrowserApp 

    Function Navigate2(URL As VoidPtr,Flags As VoidPtr,TargetFrameName As VoidPtr,PostData As VoidPtr,Headers As VoidPtr) As HRESULT 
    Function QueryStatusWB() As HRESULT 
    Function ExecWB() As HRESULT 
    Function ShowBrowserBar() As HRESULT 
    Function ReadyState() As HRESULT 
    Function get_Offline() As HRESULT 
    Function put_Offline() As HRESULT 
    Function get_Silent() As HRESULT 
    Function put_Silent() As HRESULT 
    Function get_RegisterAsBrowser() As HRESULT 
    Function put_RegisterAsBrowser() As HRESULT 
    Function get_RegisterAsDropTarget() As HRESULT 
    Function put_RegisterAsDropTarget() As HRESULT 
    Function get_TheaterMode() As HRESULT 
    Function put_TheaterMode() As HRESULT 
    Function get_AddressBar() As HRESULT 
    Function put_AddressBar() As HRESULT 
    Function get_Resizable() As HRESULT 
    Function put_Resizable() As HRESULT 

End Interface 



Interface IOleWindow 
    Inherits IUnknown 

    Function GetWindow(phwnd As *HWND) As HRESULT 
    Function ContextSensitiveHelp(fEnterMode As Long) As HRESULT 

End Interface 



Interface IOleInPlaceActiveObject 
    Inherits IOleWindow 

    Function TranslateAccelerator(lpmsg As *MSG) As HRESULT 
    Function OnFrameWindowActivate(fActivate As Long) As HRESULT 
    Function OnDocWindowActivate(fActivate As Long) As HRESULT 
    Function ResizeBorder(prcBorder As *RECT,pUIWindow As VoidPtr,fFrameWindow As Long) As HRESULT 
    Function EnableModeless(fEnable As Long) As HRESULT 

End Interface 



Declare Function AtlAxWinInit Lib "atl.dll" () As HRESULT
Declare Function AtlAxGetControl Lib "atl.dll" (hWnd As HWND,pp As VoidPtr) As HRESULT



Class IE_COMPONENT
	IsAtlAxWinInit As Char
	IsOleInPlaceActiveObjectRelease As Char

	hIE As HWND
	hIeServer As HWND

	pUnknown As *IUnknown
	pWebBrowser2 As *IWebBrowser2
	pOleInPlaceActiveObject As *IOleInPlaceActiveObject

Public
	Sub IE_COMPONENT()
		IsAtlAxWinInit = FALSE
		IsOleInPlaceActiveObjectRelease = TRUE

		hIE = NULL
		hIeServer = NULL

		pOleInPlaceActiveObject = NULL
	End Sub
	Sub ~IE_COMPONENT()
		DestroyIeBrowserWindow()
	End Sub

	Function CreateIeBrowserWindow( dwExStyle As DWord, pszInitUrl As BytePtr, dwStyle As DWord, x As Long, y As Long, nWidth As Long, nHeight As Long, hWndParent As HWND, hMenu As HMENU, hInstance As HINSTANCE, lpParam As VoidPtr ) As HWND
		Dim IID_IWebBrowser2 = [&HD30C1661,&HCDAF,&H11D0,[&H8A,&H3E,&H00,&HC0,&H4F,&HC9,&HE2,&H6E]] As GUID
		Dim IID_IOleInPlaceActiveObject=[&H00000117,&H0000,&H0000,[&HC0,&H00,&H00,&H00,&H00,&H00,&H00,&H46]] As GUID

		If FALSE = IsAtlAxWinInit Then
			AtlAxWinInit()
		End If

		hIE = CreateWindowEx( dwExStyle, "AtlAxWin", pszInitUrl, dwStyle, x, y, nWidth, nHeight, hWndParent, hMenu, hInstance, lpParam )
		AtlAxGetControl( hIE, VarPtr(pUnknown) )
		pUnknown->QueryInterface( VarPtr(IID_IWebBrowser2), VarPtr(pWebBrowser2) )
		pWebBrowser2->QueryInterface( VarPtr(IID_IOleInPlaceActiveObject), VarPtr(pOleInPlaceActiveObject) )
		pWebBrowser2->Release()
		pUnknown->Release()
		IsOleInPlaceActiveObjectRelease = FALSE

		CreateIeBrowserWindow = hIE
	End Function
	Function DestroyIeBrowserWindow()
		If FALSE = IsOleInPlaceActiveObjectRelease Then
			pOleInPlaceActiveObject->Release()
			IsOleInPlaceActiveObjectRelease = TRUE
		End If

		DestroyIeBrowserWindow = DestroyWindow( hIE )
		hIE = NULL
		hIeServer = NULL
	End Function

	Function TranslateIeBrowser( ByRef msgMain As MSG ) As Char
		'デフォルト
		TranslateIeBrowser = FALSE

		'IEコンポネントにフォーカスが当たっている場合。
		'※内部のIE Server窓で判別する必要があることに注意。
		If GetFocus() = GetBrowserHandle() And NULL <> pOleInPlaceActiveObject Then
			If S_OK = pOleInPlaceActiveObject->TranslateAccelerator( VarPtr(msgMain) ) Then
				TranslateIeBrowser = TRUE
			End If
		End If
	End Function

	Function GetTopWindowHandle() As HWND
		GetTopWindowHandle = hIE
	End Function
	Function GetBrowserHandle() As HWND
		'IEコンポネントの中の、IE Server窓を取得する。
		If NULL = hIeServer Then
			'未取得のときのみ、取得行う。
			'※hIEのCreateタイミングでは、まだServer窓が存在しない可能性がある（時間差作成）。
			If NULL <> hIE Then
				hIeServer = GetIeServerWindowHandle( hIE )
			End If
		End If

		GetBrowserHandle = hIeServer
	End Function
	Function SetFocusBrowser() As HWND
		If NULL <> hIE Then
			SetFocusBrowser = SetFocus( GetBrowserHandle() )
		Else
			SetFocusBrowser = NULL
		End If
	End Function

Private
	Function GetIeServerWindowHandle( hParent As HWND ) As HWND
		Dim hChildWnd As HWND
		Dim szClassName[256] As Byte

		hChildWnd = GetWindow( hParent,GW_CHILD )
		If hChildWnd Then
			GetClassName( hChildWnd, szClassName, 255 )
			If 0 = lstrcmp( szClassName,"Internet Explorer_Server" ) Then
				GetIeServerWindowHandle = hChildWnd
				Exit Function
			Else
				GetIeServerWindowHandle = GetIeServerWindowHandle( hChildWnd )
				Exit Function
			End If
		End If

		GetIeServerWindowHandle = NULL
	End Function

End Class



#endif