WebBrowserコントロールではMouseClickイベントがサポートされていません。HtmlDocumentオブジェクトやHtmlElementオブジェクトにClick等のマウスイベントがありますが,XBUTTON1やXBUTTON2(マウスの第4・第5ボタン)はサポートしていません。
WebBrowserの派生クラスではControl.MouseButtonsが機能せず,常にNoneが返されます。そこで,NativeWindowクラスを使ってサブクラス化して,WebBrowserへのウィンドウメッセージを受け取り,WM_MOUSEACTIVATEのタイミングでGetAsyncKeyState関数でマウスの状態を取得し,MouseClickイベントを発火するようにします。
下のサンプルではWebBrowserコントロール上でマウスをクリックしたときに,メッセージを表示します。また,XBUTTON1で「戻る」,XBUTTON2で「進む」機能を付加します。
下のコードをフォームのコードにコピー・貼り付けをすれば動作します。
Option Explicit On
Option Strict On
Imports System.ComponentModel
Imports System.IO
Imports System.Runtime.InteropServices
Imports Microsoft.Win32
Public Class Form1
Private WebBrowser1 As New WebBrowser
Private WithEvents WebBrowserMouseClick As New WebBrowserMouseClick(WebBrowser1)
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
BrowserEmulation.CreateRenderingModeRegkey(BrowserEmulation.Emulation.IE11Edge)
Me.WebBrowser1.Dock = DockStyle.Fill
Me.WebBrowser1.GoHome()
Me.Text = "WebBrowserMouseClickEvent"
Me.Controls.Add(Me.WebBrowser1)
End Sub
Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
BrowserEmulation.DeleteRenderingModeRegkey()
End Sub
Private Sub WebBrowserMouseClick_MouseClick(sender As Object, e As MouseEventArgs) Handles WebBrowserMouseClick.MouseClick
MessageBox.Show(e.Button.ToString)
End Sub
End Class
Public Class BrowserEmulation
Public Enum Emulation
IE11Edge = 11001
IE11 = 11000
IE10Std = 10001
IE10 = 10000
IE9Std = 9999
IE9 = 9000
IE8Std = 8888
IE8 = 8000
IE7 = 7000
End Enum
Private Const FEATURE_BROWSER_EMULATION As String = "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION"
Public Shared Sub CreateRenderingModeRegkey(EmulationMode As Emulation)
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
Regkey.SetValue(GetReleaseBuildName, EmulationMode, RegistryValueKind.DWord)
Regkey.SetValue(GetDebugBuildName, EmulationMode, RegistryValueKind.DWord)
End Using
End Sub
Public Shared Sub DeleteRenderingModeRegkey()
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
Regkey.DeleteValue(GetReleaseBuildName)
Regkey.DeleteValue(GetDebugBuildName)
End Using
End Sub
Private Shared Function GetReleaseBuildName() As String
Return Path.GetFileName(Application.ExecutablePath)
End Function
Private Shared Function GetDebugBuildName() As String
Return GetReleaseBuildName.Replace(".exe", ".svhost.exe")
End Function
End Class
Public Class WebBrowserMouseClick
Inherits NativeWindow
Enum VirtualKeyCodes As Integer
VK_LBUTTON = &H1
VK_RBUTTON = &H2
VK_MBUTTON = &H4
VK_XBUTTON1 = &H5
VK_XBUTTON2 = &H6
End Enum
<DllImport("user32")>
Private Shared Function GetAsyncKeyState(<[In]()> ByVal vKey As VirtualKeyCodes) As Short
End Function
Public Event MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs)
Private WithEvents WebBrowser As WebBrowser
Public Sub New(WebBrowser As WebBrowser)
Me.WebBrowser = WebBrowser
End Sub
Private Sub WebBrowser_HandleCreated(sender As Object, e As EventArgs) Handles WebBrowser.HandleCreated
AssignHandle(DirectCast(sender, WebBrowser).Handle)
End Sub
Private Sub WebBrowser_HandleDestroyed(sender As Object, e As EventArgs) Handles WebBrowser.HandleDestroyed
ReleaseHandle()
End Sub
Protected Sub OnMouseClick(ByVal e As System.Windows.Forms.MouseEventArgs)
If e.Button = Windows.Forms.MouseButtons.XButton1 Then
Me.WebBrowser.GoBack()
End If
If e.Button = Windows.Forms.MouseButtons.XButton2 Then
Me.WebBrowser.GoForward()
End If
RaiseEvent MouseClick(Me, e)
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
Const WM_MOUSEACTIVATE = &H21
If m.Msg = WM_MOUSEACTIVATE Then
Dim x As Integer = Control.MousePosition.X
Dim y As Integer = Control.MousePosition.Y
If GetAsyncKeyState(VirtualKeyCodes.VK_LBUTTON) < 0 Then
OnMouseClick(New MouseEventArgs(Windows.Forms.MouseButtons.Left, 1, x, y, 0))
End If
If GetAsyncKeyState(VirtualKeyCodes.VK_RBUTTON) < 0 Then
OnMouseClick(New MouseEventArgs(Windows.Forms.MouseButtons.Right, 1, x, y, 0))
End If
If GetAsyncKeyState(VirtualKeyCodes.VK_MBUTTON) < 0 Then
OnMouseClick(New MouseEventArgs(Windows.Forms.MouseButtons.Middle, 1, x, y, 0))
End If
If GetAsyncKeyState(VirtualKeyCodes.VK_XBUTTON1) < 0 Then
OnMouseClick(New MouseEventArgs(Windows.Forms.MouseButtons.XButton1, 1, x, y, 0))
End If
If GetAsyncKeyState(VirtualKeyCodes.VK_XBUTTON2) < 0 Then
OnMouseClick(New MouseEventArgs(Windows.Forms.MouseButtons.XButton2, 1, x, y, 0))
End If
End If
MyBase.WndProc(m)
End Sub
End Class
※このTipsは2005年頃にNiftyの@homepageで公開していたもの一部変更して再掲載しました。
http://homepage1.nifty.com/yasunari/VB/VB2005/WebBrowserMouseClickEvent.htm