WebBrowserコントロールをWM_APPCOMMANDメッセージに対応させる

VB.NET Tips　>>　記事詳細

2018/06/11	WebBrowserコントロールをWM_APPCOMMANDメッセージに対応させる	\| by:YAS

　WebBrowserコントロールはマウスの第４・第５ボタンやキーボードの「戻る」「進む」ボタンに対応しておらず，入力しても反応がありません。また，WebBrowserコントロールはMouseClickイベント等のマウス関係のイベントやKeyDownイベント等のキー入力関係のイベントをサポートしていないのでそれらのイベントを利用した実装もできません。
　前述のボタンやキーの入力をするとWebBrowserコントロールにウィンドウメッセージWM_APPCOMMANDが送られてきます。そのメッセージのlParamを調べることでアプリケーションコマンドを特定することができます。
　下のサンプルでは，WndProcをオーバーライドし，WebBrowserコントロールをマウスやキーボードのアプリケーション用ボタンによる操作を可能としました。
　下のコードをフォームのコードにコピー・貼り付けをすれば動作します。

Option Explicit On
Option Strict On

Imports System.ComponentModel
Imports System.IO
Imports Microsoft.Win32

Public Class Form1

    Dim WithEvents WebBrowser As New ExWebBrowser

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        BrowserEmulation.CreateRenderingModeRegkey(BrowserEmulation.Emulation.IE11Edge)
        Me.WebBrowser.Dock = DockStyle.Fill
        Me.Text = "WM_APPCOMMANDに対応したWebBrowser"
        Me.Controls.Add(WebBrowser)
        Me.WebBrowser.GoHome()
    End Sub

    Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
        BrowserEmulation.DeleteRenderingModeRegkey()
    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 ExWebBrowser
    Inherits WebBrowser

    Sub New()
        MyBase.New()
    End Sub

    'WinUser.h
    Enum APPCOMMAND As Short
        BROWSER_BACKWARD = 1
        BROWSER_FORWARD = 2
        BROWSER_REFRESH = 3
        BROWSER_STOP = 4
        BROWSER_SEARCH = 5
        BROWSER_FAVORITES = 6
        BROWSER_HOME = 7
    End Enum

    'WinUser.h
    '#define GET_APPCOMMAND_LPARAM(lParam) ((short)(HIWORD(lParam) & ~FAPPCOMMAND_MASK))
    Private Function GET_APPCOMMAND_LPARAM(ByVal lParam As IntPtr) As Short
        Const FAPPCOMMAND_MASK As UInt16 = &HF000
        Return CShort(((CType(lParam, Integer) And &HFFFF0000) >> 16) And (Not FAPPCOMMAND_MASK))
    End Function

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Const WM_APPCOMMAND = &H319
        If m.Msg = WM_APPCOMMAND Then
            Select Case GET_APPCOMMAND_LPARAM(m.LParam)
                Case APPCOMMAND.BROWSER_BACKWARD
                    Me.GoBack()
                    Return
                Case APPCOMMAND.BROWSER_FORWARD
                    Me.GoForward()
                    Return
                Case APPCOMMAND.BROWSER_REFRESH
                    Me.Refresh()
                    Return
                Case APPCOMMAND.BROWSER_STOP
                    Me.Stop()
                    Return
                Case APPCOMMAND.BROWSER_SEARCH
                    Me.GoSearch()
                    Return
                Case APPCOMMAND.BROWSER_HOME
                    Me.GoHome()
                    Return
            End Select
        End If
        MyBase.WndProc(m)
    End Sub

End Class

※このTipsは2005年頃にNiftyの@homepageで公開していたもの一部変更して再掲載しました。
　http://homepage1.nifty.com/yasunari/VB/VB2005/WebBrowserWM_APPCOMMAND.htm

22:11 | コメント(0) | WebBrowser

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