Option Explicit On
Option Strict On

Imports System.ComponentModel
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Security.Permissions
Imports Microsoft.Win32

Public Class Form1

    Private WithEvents TabBrowser1 As New WebTabControl
    Private StatusStrip1 As New StatusStrip
    Private ToolStripStatusLabel1 As New ToolStripStatusLabel
    Private ToolStripProgressBar1 As New ToolStripProgressBar

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        BrowserEmulation.CreateRenderingModeRegkey(BrowserEmulation.Emulation.IE11Edge)
        'ToolStripStatusLabel1
        Me.ToolStripStatusLabel1.Spring = True
        Me.ToolStripStatusLabel1.TextAlign = ContentAlignment.MiddleLeft
        'StatusStrip1
        Me.StatusStrip1.Items.Add(Me.ToolStripStatusLabel1)
        Me.StatusStrip1.Items.Add(Me.ToolStripProgressBar1)
        'TabBrowser1
        Me.TabBrowser1.Dock = DockStyle.Fill
        'Form1
        Me.Text = "BasicTabBrowser"
        Me.WindowState = FormWindowState.Maximized
        Me.Controls.Add(Me.StatusStrip1)
        Me.Controls.Add(TabBrowser1)
        '
        TabBrowser1.SelectedTab.WebBrowser.GoHome()
    End Sub

    Private Sub Form1_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
        BrowserEmulation.DeleteRenderingModeRegkey()
    End Sub

    Private Sub TabBrowser_StatusTextChanged(ByVal sender As Object, ByVal e As EventArgs) Handles TabBrowser1.StatusTextChanged
        Try
            Me.ToolStripStatusLabel1.Text = DirectCast(sender, WebBrowser).StatusText
        Catch ex As UnauthorizedAccessException
            Me.ToolStripStatusLabel1.Text = String.Empty
        End Try
    End Sub

    Private Sub TabBrowser_ProgressChanged(ByVal sender As Object, ByVal e As WebBrowserProgressChangedEventArgs) Handles TabBrowser1.ProgressChanged
        If e.CurrentProgress = -1 Then Exit Sub
        Me.ToolStripProgressBar1.Maximum = CInt(If(e.MaximumProgress > e.CurrentProgress, e.MaximumProgress, e.CurrentProgress))
        Me.ToolStripProgressBar1.Value = CInt(e.CurrentProgress)
    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 WebTabControl
    Inherits TabControl

    Public Event DocumentCompleted As WebBrowserDocumentCompletedEventHandler
    Public Event ProgressChanged As WebBrowserProgressChangedEventHandler
    Public Event StatusTextChanged As EventHandler

    Sub New()
        MyBase.New()
        AddNewWebTabPage()
    End Sub

    Private Sub WebTabPage_NewWindow2(ByVal sender As Object, ByVal e As WebBrowserNewWindow2EventArgs)
        Dim WebTabPage As WebTabPage = AddNewWebTabPage()
        e.ppDisp = WebTabPage.WebBrowser.Application
        WebTabPage.WebBrowser.RegisterAsBrowser = True
    End Sub

    Private Sub WebTabPage_WindowClosing(ByVal sender As Object, ByVal e As EventArgs)
        If Me.SelectedIndex > 0 Then 'タブページが残り１つの場合は閉じない
            Dim SelectedTab As TabPage = Me.SelectedTab
            Me.SelectedIndex -= 1
            Me.Controls.Remove(SelectedTab)
            SelectedTab.Dispose()
        End If
    End Sub

    Private Sub WebTabPage_DocumentCompleted(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
        RaiseEvent DocumentCompleted(sender, e)
    End Sub

    Private Sub WebTabPage_StatusTextChanged(ByVal sender As Object, ByVal e As EventArgs)
        RaiseEvent StatusTextChanged(sender, e)
    End Sub

    Private Sub WebTabPage_ProgressChanged(ByVal sender As Object, ByVal e As WebBrowserProgressChangedEventArgs)
        RaiseEvent ProgressChanged(sender, e)
    End Sub

    Private Function AddNewWebTabPage() As WebTabPage
        Dim WebTabPage As New WebTabPage
        Me.Controls.Add(WebTabPage)
        Me.SelectedTab = WebTabPage
        AddHandler WebTabPage.NewWindow2, AddressOf WebTabPage_NewWindow2
        AddHandler WebTabPage.DocumentCompleted, AddressOf WebTabPage_DocumentCompleted
        AddHandler WebTabPage.WindowClosing, AddressOf WebTabPage_WindowClosing
        AddHandler WebTabPage.StatusTextChanged, AddressOf WebTabPage_StatusTextChanged
        AddHandler WebTabPage.ProgressChanged, AddressOf WebTabPage_ProgressChanged
        Return WebTabPage
    End Function

    Shadows Property SelectedTab() As WebTabPage
        Get
            Return DirectCast(MyBase.SelectedTab, WebTabPage)
        End Get
        Set(ByVal value As WebTabPage)
            MyBase.SelectedTab = DirectCast(value, TabPage)
        End Set
    End Property

End Class

Public Class WebTabPage
    Inherits TabPage

    Private WithEvents _WebBrowser As New ExWebBrowser2
    Private ToolStrip As New ToolStrip
    Private lblAddress As New ToolStripLabel
    Private WithEvents btnClose As New ToolStripButton

    Public Event DocumentCompleted As WebBrowserDocumentCompletedEventHandler
    Public Event NewWindow2 As WebBrowserNewWindow2EventHandler
    Public Event ProgressChanged As WebBrowserProgressChangedEventHandler
    Public Event StatusTextChanged As EventHandler
    Public Event WindowClosing As EventHandler

    Overloads Property Text() As String
        Get
            Return MyBase.Text
        End Get
        Set(ByVal value As String)
            If String.IsNullOrEmpty(value) Then
                MyBase.Text = String.Empty
            Else
                MyBase.Text = String.Format(value, "{0,-10}").Substring(0, 10)
            End If
        End Set
    End Property

    ReadOnly Property WebBrowser() As ExWebBrowser2
        Get
            Return Me._WebBrowser
        End Get
    End Property

    Sub New()
        MyBase.New()
        Me.SuspendLayout()
        'Toolstrip1
        Me.Controls.Add(ToolStrip)
        With ToolStrip
            .BackColor = Color.White
            .GripStyle = ToolStripGripStyle.Hidden
            .RenderMode = ToolStripRenderMode.System
        End With
        'lblTitle
        Me.lblAddress.Overflow = ToolStripItemOverflow.Never
        Me.ToolStrip.Items.Add(lblAddress)
        'btnClose
        Me.ToolStrip.Items.Add(btnClose)
        With btnClose
            .Alignment = ToolStripItemAlignment.Right
            .Overflow = ToolStripItemOverflow.Never
            .Font = New Font("Marlett", 9)
            .Text = "r"
        End With
        'WebBrowser1
        Me.Controls.Add(_WebBrowser)
        _WebBrowser.Dock = DockStyle.Fill
        _WebBrowser.BringToFront()
        Me.ResumeLayout()
    End Sub

    Private Sub WebBrowser_Navigated(ByVal sender As Object, ByVal e As System.Windows.Forms.WebBrowserNavigatedEventArgs) Handles _WebBrowser.Navigated
        Me.lblAddress.Text = e.Url.ToString
    End Sub

    Private Sub btnClose_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnClose.Click
        RaiseEvent WindowClosing(sender, e)
    End Sub

    Private Sub WebBrowser_DocumentTitleChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles _WebBrowser.DocumentTitleChanged
        Try
            Me.Text = DirectCast(sender, WebBrowser).DocumentTitle
        Catch ex As UnauthorizedAccessException
            Me.Text = String.Empty
        End Try
    End Sub

    Private Sub WebBrowser_DocumentCompleted(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs) Handles _WebBrowser.DocumentCompleted
        RaiseEvent DocumentCompleted(sender, e)
    End Sub

    Private Sub WebBrowser_StatusTextChanged(ByVal sender As Object, ByVal e As EventArgs) Handles _WebBrowser.StatusTextChanged
        RaiseEvent StatusTextChanged(sender, e)
    End Sub

    Private Sub WebBrowser_ProgressChanged(ByVal sender As Object, ByVal e As WebBrowserProgressChangedEventArgs) Handles _WebBrowser.ProgressChanged
        RaiseEvent ProgressChanged(sender, e)
    End Sub

    Private Sub WebBrowser_NewWindow2(ByVal sender As Object, ByVal e As WebBrowserNewWindow2EventArgs) Handles _WebBrowser.NewWindow2
        RaiseEvent NewWindow2(sender, e)
    End Sub

    Private Sub WebBrowser_WindowClosing(ByVal sender As Object, ByVal e As EventArgs) Handles _WebBrowser.WindowClosing
        RaiseEvent WindowClosing(sender, e)
    End Sub

End Class

Public Class ExWebBrowser2
    Inherits ExWebBrowser

    Sub New()
        MyBase.New()
    End Sub

    'WindowClosingイベントの拡張
    Enum GETWINDOWCMD
        GW_HWNDFIRST = 0
        GW_HWNDLAST = 1
        GW_HWNDNEXT = 2
        GW_HWNDPREV = 3
        GW_OWNER = 4
        GW_CHILD = 5
        GW_ENABLEDPOPUP = 6
    End Enum

    <DllImport("user32.dll")>
    Private Shared Function GetWindow(ByVal hWnd As IntPtr, ByVal uCmd As GETWINDOWCMD) As IntPtr
    End Function

    Public Event WindowClosing As EventHandler

    Protected Overridable Sub OnWindowClosing(ByVal e As EventArgs)
        RaiseEvent WindowClosing(Me, e)
    End Sub

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        Const WM_PARENTNOTIFY = &H210
        Const WM_DESTROY = &H2
        If m.Msg = WM_PARENTNOTIFY Then
            If m.WParam.ToInt32 = WM_DESTROY Then
                If m.LParam = GetWindow(Me.Handle, GETWINDOWCMD.GW_CHILD) Then
                    Dim e As New EventArgs
                    OnWindowClosing(e)
                    Return
                End If
            End If
        End If
        MyBase.WndProc(m)
    End Sub

    'NewWindow2イベントの拡張
    Private cookie As AxHost.ConnectionPointCookie
    Private helper As WebBrowser2EventHelper

    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
    <DispIdAttribute(200)>
    Public ReadOnly Property Application() As Object
        Get
            If IsNothing(Me.ActiveXInstance) Then
                Throw New AxHost.InvalidActiveXStateException("Application", AxHost.ActiveXInvokeKind.PropertyGet)
            End If
            Return DirectCast(Me.ActiveXInstance, IWebBrowser2).Application
        End Get
    End Property

    <DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden)>
    <DispIdAttribute(552)>
    Public Property RegisterAsBrowser() As Boolean
        Get
            If IsNothing(Me.ActiveXInstance) Then
                Throw New AxHost.InvalidActiveXStateException("RegisterAsBrowser", AxHost.ActiveXInvokeKind.PropertyGet)
            End If
            Return DirectCast(Me.ActiveXInstance, IWebBrowser2).RegisterAsBrowser
        End Get
        Set(ByVal value As Boolean)
            If IsNothing(Me.ActiveXInstance) Then
                Throw New AxHost.InvalidActiveXStateException("RegisterAsBrowser", AxHost.ActiveXInvokeKind.PropertySet)
            End If
            DirectCast(Me.ActiveXInstance, IWebBrowser2).RegisterAsBrowser = value
        End Set
    End Property

    <PermissionSetAttribute(SecurityAction.LinkDemand, Name:="FullTrust")>
    Protected Overrides Sub CreateSink()
        MyBase.CreateSink()
        helper = New WebBrowser2EventHelper(Me)
        cookie = New AxHost.ConnectionPointCookie(Me.ActiveXInstance, helper, GetType(DWebBrowserEvents2))
    End Sub

    <PermissionSetAttribute(SecurityAction.LinkDemand, Name:="FullTrust")>
    Protected Overrides Sub DetachSink()
        If cookie IsNot Nothing Then
            cookie.Disconnect()
            cookie = Nothing
        End If
        MyBase.DetachSink()
    End Sub

    Public Event NewWindow2 As WebBrowserNewWindow2EventHandler

    Protected Overridable Sub OnNewWindow2(ByVal e As WebBrowserNewWindow2EventArgs)
        RaiseEvent NewWindow2(Me, e)
    End Sub

    Private Class WebBrowser2EventHelper
        Inherits StandardOleMarshalObject
        Implements DWebBrowserEvents2

        Private parent As ExWebBrowser2

        Public Sub New(ByVal parent As ExWebBrowser2)
            Me.parent = parent
        End Sub

        Public Sub NewWindow2(ByRef ppDisp As Object, ByRef cancel As Boolean) Implements DWebBrowserEvents2.NewWindow2
            Dim e As New WebBrowserNewWindow2EventArgs(ppDisp)
            Me.parent.OnNewWindow2(e)
            ppDisp = e.ppDisp
            cancel = e.Cancel
        End Sub
    End Class

End Class

'NewWindow2イベント
Public Delegate Sub WebBrowserNewWindow2EventHandler(ByVal sender As Object, ByVal e As WebBrowserNewWindow2EventArgs)

Public Class WebBrowserNewWindow2EventArgs
    Inherits CancelEventArgs

    Private ppDispValue As Object

    Public Sub New(ByVal ppDisp As Object)
        Me.ppDispValue = ppDisp
    End Sub

    Public Property ppDisp() As Object
        Get
            Return ppDispValue
        End Get
        Set(ByVal value As Object)
            ppDispValue = value
        End Set
    End Property
End Class

<ComImport(), Guid("34A715A0-6587-11D0-924A-0020AFC7AC4D"),
InterfaceType(ComInterfaceType.InterfaceIsIDispatch),
TypeLibType(TypeLibTypeFlags.FHidden)>
Public Interface DWebBrowserEvents2

    Enum DISPID
        NEWWINDOW2 = 251
    End Enum

    <DispId(DISPID.NEWWINDOW2)> Sub NewWindow2(
        <InAttribute(), OutAttribute(), MarshalAs(UnmanagedType.IDispatch)> ByRef ppDisp As Object,
        <InAttribute(), OutAttribute()> ByRef cancel As Boolean)

End Interface

<ComImport(), Guid("D30C1661-CDAF-11D0-8A3E-00C04FC9E26E"),
InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>
Public Interface IWebBrowser2

    ReadOnly Property Application() As <MarshalAs(UnmanagedType.IDispatch)> Object
    Property RegisterAsBrowser() As <MarshalAs(UnmanagedType.VariantBool)> Boolean

End Interface

Public Class ExWebBrowser
    Inherits WebBrowser

    Sub New()
        MyBase.New()
    End Sub

    'キーボードショートカットの処理を再定義
    Public Overrides Function PreProcessMessage(ByRef msg As System.Windows.Forms.Message) As Boolean
        Const WM_KEYDOWN As Integer = &H100
        If msg.Msg = WM_KEYDOWN Then
            Dim keyCode As Keys = CType(msg.WParam, Keys) And Keys.KeyCode
            If My.Computer.Keyboard.CtrlKeyDown Then
                Select Case keyCode
                    Case Keys.N
                        If Me.ReadyState >= WebBrowserReadyState.Loading Then
                            Me.Navigate(Me.Url, True)
                        End If
                        Return True
                    Case Keys.P
                        Me.ShowPrintPreviewDialog()
                        Return True
                End Select
            End If
        End If
        Return MyBase.PreProcessMessage(msg)
    End Function

    'WM_APPCOMMANDメッセージに対応
    '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