DOBON.NET DOBON.NETプログラミング掲示板過去ログ

WebBrowserコントロールでページ全体をキャプチャしたい

分類:[.NET]

VisualBasic2005でwebbrowserに表示させたページ全体をキャプチャしたいのですがどのようにしたらよいのでしょうか?
表示されている部分だけをキャプチャするのはできたのですが、表示されていない部分も含めたキャプチャの方法がわかりません。
「WebBrowser キャプチャ」でGoogleで検索しました。

http://musi-chan.at.webry.info/200605/article_10.html
http://musi-chan.at.webry.info/200605/article_11.html

C#ですが、VBでも同じことができるはずです。
(動作確認はしていません)
お返事ありがとうございます。
実はそのページに記載されている方法も試してみたのですが、
IoleObjectのSetExtentのところでエラーが発生してしまい、正しく処理をすることができませんでした。

Imports System.Runtime.InteropServices


<Guid("00000112-0000-0000-C000-000000000046"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IOleObject
Sub SetExtent(ByVal dwDrawAspect As Integer, ByRef psizel As Size)
Sub GetExtent(ByVal dwDrawAspect As Integer, ByRef psizel As Size)
End Interface



Public Class Form1

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

<DllImport("gdi32", entrypoint:="GetDeviceCaps")> _
Private Shared Function GetDeviceCaps(ByVal hdc As IntPtr, ByVal caps As Double) As Integer
End Function

Private Enum DVASPECT As Integer
DVASPECT_CONTENT = 1
DVASPECT_THUMBNAIL = 2
DVASPECT_ICON = 4
DVASPECT_DOCPRINT = 8
End Enum

Private Enum DeviceCaps
LOGPIXELSX = 88 ' Logical pixels/inch in X
LOGPIXELSY = 90 ' Logical pixels/inch in Y
End Enum

Dim htmldocument As HtmlDocument = WebBrowser1.Document
Dim htmlelement As HtmlElement = htmldocument.Body
Dim rectangle As Rectangle = New Rectangle(New Point(0, 0), htmlelement.ScrollRectangle.Size)

Dim bmp As Bitmap = New Bitmap(rectangle.Size.Width, rectangle.Size.Height)
Dim g As Graphics = Graphics.FromImage(bmp)


Dim oleObject As IOleObject
oleObject = DirectCast(htmldocument.DomDocument, IOleObject)

Dim imageDC As IntPtr = g.GetHdc()
Dim pUnk As IntPtr = System.Runtime.InteropServices.Marshal.GetIUnknownForObject(WebBrowser1.ActiveXInstance)
Try
Dim currentSize As Size = New Size()
oleObject.GetExtent(DVASPECT.DVASPECT_CONTENT, currentSize)

Dim drawingSize As Size = convertPixelToHIMETRIC(rectangle.Size, imageDC)

oleObject.SetExtent(DVASPECT.DVASPECT_CONTENT, drawingSize)

OleDraw(pUnk, DVASPECT.DVASPECT_CONTENT, imageDC, rectangle)
oleObject.SetExtent(DVASPECT.DVASPECT_CONTENT, currentSize)
Marshal.Release(pUnk)
g.ReleaseHdc(imageDC)

bmp.Save("sample.png", System.Drawing.Imaging.ImageFormat.Jpeg)
g.Dispose()
bmp.Dispose()

Finally

End Try
End Sub


Private Function convertPixelToHIMETRIC(ByVal size As Size, ByVal hdc As IntPtr) As Size
Const HIMETRIC_PER_INCH As Integer = 2540
Dim newSize As New Size()


newSize.Width = (size.Width * HIMETRIC_PER_INCH / GetDeviceCaps(hdc, DeviceCaps.LOGPIXELSX) + 0.5)
newSize.Height = ((size.Height * HIMETRIC_PER_INCH / GetDeviceCaps(hdc, DeviceCaps.LOGPIXELSY) + 0.5))

Return newSize
End Function
前に作ろうとしたことがありますので,参考にしてください。
GetBitmapFromWebの第2引数でWebページの大きさを第3引数でBitmapの大きさを
指定しますが,NothingにすればWebページの全体をキャプチャします。
ただ,やはりフレームがあると全体をキャプチャできません。

'WebページをBitmapで取得する
Imports System.Runtime.InteropServices

Public Class Form1

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim Img As Image
        Img = GetBitmapFromWeb("http://www.yahoo.co.jp", Nothing, Nothing)
        Me.BackgroundImage = Img
    End Sub

    <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

    Public Function GetBitmapFromWeb(ByVal Url As String, ByVal HtmlSize As Size, ByVal BitmapSize As Size) As Image
        Dim WebBrowser1 As WebBrowser = Nothing
        Dim ImageGraph As Graphics = Nothing
        Dim Stopwatch1 As Stopwatch = Nothing
        Try
            'WebBrowserコントロールの初期化
            WebBrowser1 = New WebBrowser
            WebBrowser1.Visible = False '非表示にしないと実際に表示されている以上の大きさの画像が取得できない
            WebBrowser1.ScriptErrorsSuppressed = True
            WebBrowser1.Navigate(Url)
            Stopwatch1 = New Stopwatch
            Stopwatch1.Start()
            Do Until WebBrowser1.ReadyState = WebBrowserReadyState.Complete
                Application.DoEvents()
                If Stopwatch1.ElapsedMilliseconds > 10000 Then Throw New Exception '10秒待ってナビゲートできなければ例外処理
            Loop
            Stopwatch1.Stop()
            WebBrowser1.Document.Body.Style = "overflow-x:hidden;overflow-y:hidden" 'スクロールバーを消す(ScrollBarsEnabled=Falseでは消えない)
            If HtmlSize = Nothing Then
                Dim Rect As Rectangle = WebBrowser1.Document.Body.ScrollRectangle 'ページの大きさを取得する(不完全な実装)
                HtmlSize = New Size(Rect.Width, Rect.Height)
            End If
            WebBrowser1.Size = HtmlSize
            'OleDrawでビットマップを取得
            Dim HtmlImage As Bitmap = Nothing
            Dim Browser As Object = Nothing
            Dim pUnk As IntPtr
            Dim HtmlGraph As Graphics = Nothing
            Dim hDc As IntPtr
            Try
                HtmlImage = New Bitmap(HtmlSize.Width, HtmlSize.Height)
                Browser = WebBrowser1.ActiveXInstance
                pUnk = Marshal.GetIUnknownForObject(Browser)
                HtmlGraph = Graphics.FromImage(HtmlImage)
                hDc = HtmlGraph.GetHdc
                OleDraw(pUnk, DVASPECT.CONTENT, hDc, New Rectangle(0, 0, HtmlImage.Width, HtmlImage.Height))
            Catch ex As Exception
                Debug.Print(ex.Message)
            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)
                If Browser IsNot Nothing AndAlso Marshal.IsComObject(Browser) Then Marshal.ReleaseComObject(Browser)
            End Try
            '取得したビットマップを縮小
            If BitmapSize = Nothing OrElse BitmapSize.Width < 1 OrElse BitmapSize.Height < 1 Then
                BitmapSize = New Size(HtmlSize.Width, HtmlSize.Height)
            End If
            Dim Image = New Bitmap(BitmapSize.Width, BitmapSize.Height)
            ImageGraph = Graphics.FromImage(Image)
            ImageGraph.SmoothingMode = Drawing2D.SmoothingMode.HighQuality '高画質に処理
            ImageGraph.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality '高画質に処理
            ImageGraph.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic '高画質に縮小
            ImageGraph.DrawImage(HtmlImage, 0, 0, Image.Width, Image.Height)
            Return Image
        Catch ex As Exception
            Debug.Print(ex.Message)
            Return Nothing
        Finally
            If ImageGraph IsNot Nothing Then ImageGraph.Dispose()
            If WebBrowser1 IsNot Nothing Then WebBrowser1.Dispose()
        End Try
    End Function

End Class

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

DOBON.NET | プログラミング道 | プログラミング掲示板