Imports System.Runtime.InteropServices
<ComVisible(True)> _
Public Class WebBrowserControler
Inherits Control
Implements IOleClientSite
Private Const DISPID_AMBIENT_DLCONTROL As Integer = -5512
Private _WebBrowser As WebBrowser
Private _DlControl As DLCTL = DLCTL.DLIMAGES Or DLCTL.BGSOUNDS Or DLCTL.VIDEOS
Public Sub New(ByVal WebBrowser As WebBrowser)
Me._WebBrowser = WebBrowser
DirectCast(Me._WebBrowser.ActiveXInstance, IOleObject).SetClientSite(Me)
End Sub
<DispId(DISPID_AMBIENT_DLCONTROL)> _
Public Function Didpid_Ambient_DlControl() As Integer
Return Me._DlControl
End Function
Private Sub OnAmbientPropertyChange()
DirectCast(Me._WebBrowser.ActiveXInstance.Application, IOleControl).OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL)
End Sub
Public Property DlControl() As DLCTL
Get
Return Me._DlControl
End Get
Set(ByVal value As DLCTL)
Me._DlControl = value
Me.OnAmbientPropertyChange()
Me._WebBrowser.Refresh()
End Set
End Property
Public Sub GetContainer(ByRef ppContainer As Object) Implements IOleClientSite.GetContainer
End Sub
Public Sub GetMoniker(ByVal dwAssign As Integer, ByVal dwWhichMoniker As Integer, ByRef ppmk As Object) Implements IOleClientSite.GetMoniker
End Sub
Public Sub OnShowWindow(ByVal fShow As Boolean) Implements IOleClientSite.OnShowWindow
End Sub
Public Sub RequestNewObjectLayout() Implements IOleClientSite.RequestNewObjectLayout
End Sub
Public Sub SaveObject() Implements IOleClientSite.SaveObject
End Sub
Public Sub ShowObject() Implements IOleClientSite.ShowObject
End Sub
End Class
Public Enum DLCTL As Integer
BGSOUNDS = &H40 'BGMを再生する
DLIMAGES = &H10 'サーバーから画像をダウンロードする
DOWNLOADONLY = &H800 'コンポーネントをダウンロードするが表示しない
FORCEOFFLINE = &H10000000 '常にオフラインモード
NO_BEHAVIORS = &H8000
NO_CLIENTPULL = &H20000000
NO_DLACTIVEXCTLS = &H400 'ActiveXコントロールをダウンロードしない
NO_FRAMEDOWNLOAD = &H1000 'フレームをダウンロードしない
NO_JAVA = &H100 'JAVAアプレットを実行しない
NO_METACHARSET = &H10000
NO_RUNACTIVEXCTLS = &H200 'ActiveXコントロールを実行しない
NO_SCRIPTS = &H80 'スクリプトを実行しない
OFFLINE = &H80000000
OFFLINEIFNOTCONNECTED = &H80000000
PRAGMA_NO_CACHE = &H4000
RESYNCHRONIZE = &H2000
SILENT = &H40000000 'ダイアログを表示しない
URL_ENCODING_DISABLE_UTF8 = &H20000
URL_ENCODING_ENABLE_UTF8 = &H40000
VIDEOS = &H20 'ビデオクリップを再生する
End Enum
<GuidAttribute("B196B288-BAB4-101A-B69C-00AA00341D07"), _
InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IOleControl
Sub GetControlInfo(ByRef pCI As Object)
Sub OnMnemonic(ByRef pMsg As Object)
Sub OnAmbientPropertyChange(ByVal dispID As Integer)
Sub FreezeEvents(ByVal bFreeze As Boolean)
End Interface
<Guid("00000118-0000-0000-C000-000000000046"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IOleClientSite
Sub SaveObject()
Sub GetMoniker(ByVal dwAssign As Integer, ByVal dwWhichMoniker As Integer, ByRef ppmk As Object)
Sub GetContainer(ByRef ppContainer As Object)
Sub ShowObject()
Sub OnShowWindow(ByVal fShow As Boolean)
Sub RequestNewObjectLayout()
End Interface
<Guid("00000112-0000-0000-C000-000000000046"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IOleObject
Sub SetClientSite(ByVal pClientSite As IOleClientSite)
Sub GetClientSite(ByRef ppClientSite As IOleClientSite)
Sub SetHostNames(ByVal szContainerApp As Object, ByVal szContainerObj As Object)
Sub Close(ByVal dwSaveOption As Integer)
Sub SetMoniker(ByVal dwWhichMoniker As Integer, ByVal pmk As Object)
Sub GetMoniker(ByVal dwAssign As Integer, ByVal dwWhichMoniker As Integer, ByVal ppmk As Object)
Sub InitFromData(ByVal pDataObject As IDataObject, ByVal fCreation As Boolean, ByVal dwReserved As Integer)
Sub GetClipboardData(ByVal dwReserved As Integer, ByRef ppDataObject As IDataObject)
Sub DoVerb(ByVal iVerb As Integer, ByVal lpmsg As Integer, ByVal pActiveSite As Object, ByVal lindex As Integer, ByVal hwndParent As Integer, ByVal lprcPosRect As Integer)
Sub EnumVerbs(ByRef ppEnumOleVerb As Object)
Sub Update()
Sub IsUpToDate()
Sub GetUserClassID(ByVal pClsid As Integer)
Sub GetUserType(ByVal dwFormOfType As Integer, ByVal pszUserType As Integer)
Sub SetExtent(ByVal dwDrawAspect As Integer, ByVal psizel As Integer)
Sub GetExtent(ByVal dwDrawAspect As Integer, ByVal psizel As Integer)
Sub Advise(ByVal pAdvSink As Object, ByVal pdwConnection As Integer)
Sub Unadvise(ByVal dwConnection As Integer)
Sub EnumAdvise(ByRef ppenumAdvise As Object)
Sub GetMiscStatus(ByVal dwAspect As Integer, ByVal pdwStatus As Integer)
Sub SetColorScheme(ByVal pLogpal As Object)
End Interface
