VB.NETのWebBrowserコントロールでページ全体をキャプチャする方法

VB.NETのWebBrowserコントロールでページ全体をキャプチャする方法です。

ネットショップなどの購入履歴を管理する必要があります。
注文履歴の画面を、いちいち印刷するのが面倒なので、
画面をキャプチャして、データベースに画像を保存することにしました。

まずは、ユーザーコントロールを追加します。
CaptureWebBrowser.vbという名前で、ユーザーコントロールを作ります。

そして、以下のコードを書きます。
このコードは、どこかのサイトからとってきたものですが、
どこからとってきたかわからなくなってしまいました。

Imports System.Runtime.InteropServices
Imports System.Security.Permissions
Class CaptureWebBrowser
    Inherits WebBrowser

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

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

    Overloads Sub DrawToBitmap(ByVal Bitmap As Bitmap)
        'Webページのビットマップを取得
        Dim HtmlImage As Bitmap = Nothing
        Dim pUnk As IntPtr
        Dim HtmlGraph As Graphics = Nothing
        Dim hDc As IntPtr
        Try
            HtmlImage = New Bitmap(Me.Width, Me.Height)
            pUnk = Marshal.GetIUnknownForObject(Me.ActiveXInstance)
            HtmlGraph = Graphics.FromImage(HtmlImage)
            hDc = HtmlGraph.GetHdc
            OleDraw(pUnk, DVASPECT.CONTENT, hDc, New Rectangle(0, 0, HtmlImage.Width, HtmlImage.Height))
        Finally
            If Not hDc.Equals(IntPtr.Zero) Then HtmlGraph.ReleaseHdc(hDc)
            If HtmlGraph IsNot Nothing Then HtmlGraph.Dispose()
            If Not pUnk.Equals(IntPtr.Zero) Then Marshal.Release(pUnk)
        End Try
        '取得したビットマップを縮小
        Dim ImageGraph As Graphics = Nothing
        Try
            ImageGraph = Graphics.FromImage(Bitmap)
            ImageGraph.SmoothingMode = Drawing2D.SmoothingMode.HighQuality '高画質に処理
            ImageGraph.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality '高画質に処理
            ImageGraph.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic '高画質に縮小
            ImageGraph.DrawImage(HtmlImage, 0, 0, Bitmap.Width, Bitmap.Height)
        Finally
            If ImageGraph IsNot Nothing Then ImageGraph.Dispose()
        End Try

    End Sub
  
End Class

Imports System.Runtime.InteropServices

Imports System.Security.Permissions

Class CaptureWebBrowser

Inherits WebBrowser

Public Enum DVASPECT

CONTENT = 1

THUMBNAIL = 2

ICON = 4

DOCPRINT = 8

End Enum

<DllImport("ole32.dll")> _

Public Shared Function OleDraw( _

ByVal pUnk As IntPtr, _

ByVal dwAspect As DVASPECT, _

ByVal hdcDraw As IntPtr, _

ByRef lprcBounds As Rectangle) _

As Integer

End Function

Overloads Sub DrawToBitmap(ByVal Bitmap As Bitmap)

'Webページのビットマップを取得

Dim HtmlImage As Bitmap = Nothing

Dim pUnk As IntPtr

Dim HtmlGraph As Graphics = Nothing

Dim hDc As IntPtr

Try

HtmlImage = New Bitmap(Me.Width, Me.Height)

pUnk = Marshal.GetIUnknownForObject(Me.ActiveXInstance)

HtmlGraph = Graphics.FromImage(HtmlImage)

hDc = HtmlGraph.GetHdc

OleDraw(pUnk, DVASPECT.CONTENT, hDc, New Rectangle(0, 0, HtmlImage.Width, HtmlImage.Height))

Finally

If Not hDc.Equals(IntPtr.Zero) Then HtmlGraph.ReleaseHdc(hDc)

If HtmlGraph IsNot Nothing Then HtmlGraph.Dispose()

If Not pUnk.Equals(IntPtr.Zero) Then Marshal.Release(pUnk)

End Try

'取得したビットマップを縮小

Dim ImageGraph As Graphics = Nothing

Try

ImageGraph = Graphics.FromImage(Bitmap)

ImageGraph.SmoothingMode = Drawing2D.SmoothingMode.HighQuality '高画質に処理

ImageGraph.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality '高画質に処理

ImageGraph.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic '高画質に縮小

ImageGraph.DrawImage(HtmlImage, 0, 0, Bitmap.Width, Bitmap.Height)

Finally

If ImageGraph IsNot Nothing Then ImageGraph.Dispose()

End Try

End Sub

End Class

ビルドするとツールボックスにCaptureWebBrowserコントロールが現れます。
これを、フォームの好きなところに貼り付けます。
そして、呼び出すときは、こんな感じです。

WebNetShopという名前で追加しました。

Dim s As Size
        'ドックスタイルを一時的にNoneにします。
        WebNetShop.Dock = DockStyle.None
        '表示されているページのサイズを取得します。
        s = WebNetShop.Document.Body.ScrollRectangle.Size
        WebNetShop.Width = s.Width
        WebNetShop.Height = s.Height
        '表示されているページと同じサイズのビットマップを作成
        Dim Bitmap As New Bitmap(s.Width, s.Height)
        Me.WebNetShop.DrawToBitmap(Bitmap)
        Me.Size = Bitmap.Size
        'アプリケーションのフォルダにファイルをJpegで保存
        Bitmap.Save(My.Application.Info.DirectoryPath & "\test.jpg", Imaging.ImageFormat.Jpeg)
        'ドックスタイルを元に戻す
        WebNetShop.Dock = DockStyle.Fill

Dim s As Size

'ドックスタイルを一時的にNoneにします。

WebNetShop.Dock = DockStyle.None

'表示されているページのサイズを取得します。

s = WebNetShop.Document.Body.ScrollRectangle.Size

WebNetShop.Width = s.Width

WebNetShop.Height = s.Height

'表示されているページと同じサイズのビットマップを作成

Dim Bitmap As New Bitmap(s.Width, s.Height)

Me.WebNetShop.DrawToBitmap(Bitmap)

Me.Size = Bitmap.Size

'アプリケーションのフォルダにファイルをJpegで保存

Bitmap.Save(My.Application.Info.DirectoryPath & "\test.jpg", Imaging.ImageFormat.Jpeg)

'ドックスタイルを元に戻す

WebNetShop.Dock = DockStyle.Fill

これで、簡単にネットショップの注文履歴を管理できるようになりました。