Option Explicit On
Option Strict On

Imports System.Runtime.InteropServices
Imports Microsoft.Win32
Imports System.IO

Public Class Form1

    Private WithEvents WebBrowser1 As ExWebBrowser

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.BackgroundImageLayout = ImageLayout.Zoom
        ExWebBrowser.CreateRenderingModeRegkey(ExWebBrowser.Emulation.IE11Edge)
        Me.WebBrowser1 = New ExWebBrowser
        Me.WebBrowser1.GoHome()
    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        ExWebBrowser.DeleteRenderingModeRegkey()
    End Sub

    Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
        Dim Browser As ExWebBrowser = DirectCast(sender, ExWebBrowser)
        If e.Url = Browser.Url Then
            'スクロールバーを消す（ScrollBarsEnabled=Falseでは消えない）
            Browser.Document.Body.Style = "overflow-x:hidden;overflow-y:hidden"
            Dim Rect As Rectangle = Browser.Document.Body.ScrollRectangle
            Browser.Size = Rect.Size '
            Dim Bmp As New Bitmap(Rect.Width, Rect.Height)
            Me.WebBrowser1.DrawToBitmap(Bmp)
            Me.BackgroundImage = Bmp
            DrawImageRectangle(Browser, Bmp)
        End If
    End Sub

    Private Sub DrawImageRectangle(Browser As WebBrowser, Image As Image)
        Using g As Graphics = Graphics.FromImage(Image)
            For Each el As HtmlElement In Browser.Document.GetElementsByTagName("img")
                g.DrawRectangle(Pens.Red, New Rectangle(GetLocation(el), el.OffsetRectangle.Size))
            Next
        End Using
    End Sub

    Private Function GetLocation(el As HtmlElement) As Point
        If el.OffsetParent Is Nothing OrElse el.OffsetParent.Equals(el.Document.Body) Then
            Return el.OffsetRectangle.Location
        Else
            Return Point.Add(el.OffsetRectangle.Location, Point.op_Explicit(GetLocation(el.OffsetParent)))
        End If
    End Function

End Class

Public Class ExWebBrowser
    Inherits WebBrowser

    Public Enum DVASPECT
        CONTENT = 1
        THUMBNAIL = 2
        ICON = 4
        DOCPRINT = 8
    End Enum

    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"

    <DllImport("ole32.dll")>
    Private Shared Function OleDraw(
        ByVal pUnk As IntPtr,
        ByVal dwAspect As DVASPECT,
        ByVal hdcDraw As IntPtr,
        ByRef lprcBounds As Rectangle) _
        As Integer
    End Function

    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

    Overloads Sub DrawToBitmap(ByVal Bitmap As Bitmap)
        Using HtmlImage As Bitmap = New Bitmap(Me.Width, Me.Height)
            Using g As Graphics = Graphics.FromImage(HtmlImage)
                Dim pUnk As IntPtr
                Dim hDc As IntPtr
                Try
                    pUnk = Marshal.GetIUnknownForObject(Me.ActiveXInstance)
                    hDc = g.GetHdc
                    OleDraw(pUnk, DVASPECT.CONTENT, hDc, New Rectangle(0, 0, HtmlImage.Width, HtmlImage.Height))
                Finally
                    If Not hDc.Equals(IntPtr.Zero) Then
                        g.ReleaseHdc(hDc)
                    End If
                    If Not pUnk.Equals(IntPtr.Zero) Then
                        Marshal.Release(pUnk)
                    End If
                End Try
            End Using
            Using g As Graphics = Graphics.FromImage(Bitmap)
                g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
                g.DrawImage(HtmlImage, 0, 0, Bitmap.Width, Bitmap.Height)
            End Using
        End Using
    End Sub

End Class