質問者
VB2005 WebBrowserコントロール 画像を表示しない

質問
すべての返信
-
VB6.0 用なので、VB2005 でも動作するかは未確認ですが、下記のサイトの投稿記事が
少しは参考になるかと思います。
http://hanatyan.sakura.ne.jp/logbbs1/wforum.cgi?mode=allread&no=4349&page=330
-
テキストのみのブラウザの趣旨が不明ですが、インターネットオプションで画像の表示/非表示の切替でよければレジストリの値を触るのも手かな?と思います。
レジストリを調べてみるとHKEY_CURRENT_USERのSoftware\Microsoft\Internet Explorer\Mainの中に、Display Inline Imagesの値を画像の表示のときは"yes",非表示の時は"no"になる様です。
VBで簡単に書いてみると非表示にする場合は
Dim regkey As Microsoft.Win32.RegistryKey = _
Microsoft.Win32.Registry.CurrentUser.OpenSubKey _
("Software\Microsoft\Internet Explorer\Main", True)
regkey.SetValue("Display Inline Images", "no") 'レジストリ画像の非表示
regkey.Close()
当然画像表示する場合は
regkey.SetValue("Display Inline Images", "yes")
ですが、プログラムを開始するときに"no"
終了時に"yes"と使用したらいいと思います。 -
遅いレスで申し訳ありません。
VB2005で作ってみました。少し長いのですが,言葉で説明する方が大変だと思ったのでコードを投稿します。(コードまるごと投稿には賛否両論あるとは思いますが...)
ただ,WebBrowserコントロールをデザイナでフォームに配置し,そのWebBrowserコントロールを引数にしてWebBrowserControlerオブジェクトをNewするとエラーになってしまいます。理由はわかりませんが,ActiveXInstanceプロパティでうまく基になるActiveXオブジェクトを参照できないようです。
Imports System.Runtime.InteropServices
Public Class Form1
Dim WebBrowerCtrl As WebBrowserControler
Dim WebBrowser1 As New WebBrowser
Dim WithEvents Button1 As New Button
Dim WithEvents Button2 As New ButtonPrivate Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.WebBrowser1.Dock = DockStyle.Fill
Me.Button1.Location = New Point(0, 0)
Me.Button2.Location = New Point(Me.Button1.Size.Width, 0)
Me.Button1.Text = "画像非表示"
Me.Button2.Text = "画像表示"
Me.Controls.Add(Me.Button1)
Me.Controls.Add(Me.Button2)
Me.Controls.Add(Me.WebBrowser1)
WebBrowerCtrl = New WebBrowserControler(Me.WebBrowser1)
Me.WebBrowser1.Navigate("http://www.yahoo.co.jp")
End SubPrivate Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Me.WebBrowerCtrl.DlControl = Me.WebBrowerCtrl.DlControl And Not DLCTL.DLIMAGES
End SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Me.WebBrowerCtrl.DlControl = Me.WebBrowerCtrl.DlControl Or DLCTL.DLIMAGES
End SubEnd Class
<ComVisible(True)> _
Public Class WebBrowserControler
Inherits Control
Implements IOleClientSitePrivate Const DISPID_AMBIENT_DLCONTROL As Integer = -5512
Private _WebBrowser As WebBrowser
Private _DlControl As DLCTL = DLCTL.DLIMAGES Or DLCTL.BGSOUNDS Or DLCTL.VIDEOSPublic 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 FunctionPrivate Sub OnAmbientPropertyChange()
DirectCast(Me._WebBrowser.ActiveXInstance.Application, IOleControl).OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL)
End SubPublic 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 PropertyPublic 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 SubEnd 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 IOleControlSub 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 IOleClientSiteSub 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 IOleObjectSub 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