WebBrowserコントロールにMouseClickイベントを拡張する

VB.NET Tips　>>　記事詳細

2018/06/13	WebBrowserコントロールにMouseClickイベントを拡張する	\| by:YAS

　WebBrowserコントロールではMouseClickイベントがサポートされていません。HtmlDocumentオブジェクトやHtmlElementオブジェクトにClick等のマウスイベントがありますが，XBUTTON1やXBUTTON2（マウスの第４・第５ボタン）はサポートしていません。
　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

01:22 | コメント(0)

< 前の記事へ次の記事へ >一覧へ戻る