VB 中的 HTML 转图像
4.17/5 (5投票s)
这是“C# 中的 HTML 转图像”的替代方案
引言
在本文中，我将向您展示如何使用 WebBrowser 对象和 IViewObject.Draw 方法将 HTML 文档捕获为图像。根据 MSDN 的描述，该方法将对象的表示形式绘制到指定的设备上下文中。 在我们开始之前，我想提到的是，获得的结果与使用商业库获得的结果相同，所以我希望这对某人有用。
IViewObject 接口
我们首先要做的事情是定义 IViewObject 接口。
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices.ComTypes
Imports System.Drawing
<ComVisible(True), ComImport> _
<GuidAttribute("0000010d-0000-0000-C000-000000000046")> _
<InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IViewObject
<PreserveSig()> _
Function Draw(<MarshalAs(UnmanagedType.U4)> dwDrawAspect As UInt32, lindex As Integer, _
pvAspect As IntPtr, <[In]()> ptd As IntPtr, hdcTargetDev As IntPtr, hdcDraw As IntPtr, _
<MarshalAs(UnmanagedType.Struct)> ByRef lprcBounds As Rectangle, _
<MarshalAs(UnmanagedType.Struct)> ByRef lprcWBounds As Rectangle, _
pfnContinue As IntPtr, <MarshalAs(UnmanagedType.U4)> dwContinue As UInt32) _
As <MarshalAs(UnmanagedType.I4)> Integer
<PreserveSig()> _
Function GetColorSet(<[In](), MarshalAs(UnmanagedType.U4)> dwDrawAspect As Integer, _
lindex As Integer, pvAspect As IntPtr, <[In]()> ptd As IntPtr, _
hicTargetDev As IntPtr, <Out()> ppColorSet As IntPtr) As Integer
<PreserveSig()> _
Function Freeze(<[In](), MarshalAs(UnmanagedType.U4)> dwDrawAspect As Integer, _
lindex As Integer, pvAspect As IntPtr, <Out()> pdwFreeze As IntPtr) As Integer
<PreserveSig()> _
Function Unfreeze(<[In](), MarshalAs(UnmanagedType.U4)> dwFreeze As Integer) As Integer
Sub SetAdvise(<[In](), MarshalAs(UnmanagedType.U4)> aspects As Integer, <[In](), _
MarshalAs(UnmanagedType.U4)> advf As Integer, <[In](), _
MarshalAs(UnmanagedType.[Interface])> pAdvSink As IAdviseSink)
Sub GetAdvise(<[In](), Out(), MarshalAs(UnmanagedType.LPArray)> paspects As Integer(), _
<[In](), Out(), MarshalAs(UnmanagedType.LPArray)> advf As Integer(), _
<[In](), Out(), MarshalAs(UnmanagedType.LPArray)> pAdvSink As IAdviseSink())
End Interface
以下是 Draw 方法接受的参数的摘要说明（这是我们将使用的唯一方法）
UInt32 dwDrawAspect- 指定要绘制的方面。有效值取自DVASPECT和DVASPECT2枚举。 在此示例中，我使用DVASPECT.CONTENT，因此传递的值为 1。int lindex- 绘制操作中对象中感兴趣的部分。当前仅支持 -1。IntPtr pvAspect- 指向附加信息的指针。IntPtr ptd- 描述将渲染对象的设备。我们将针对默认目标设备进行渲染，因此传递的值将为IntPtr.Zero。IntPtr hdcTargetDev- 指示ptd参数的目标设备的上下文信息。IntPtr hdcDraw- 要在其上绘制的设备上下文。ref Rectangle lprcBounds- 捕获图像的大小。ref Rectangle lprcWBounds- 我们想要捕获的WebBrowser对象区域。IntPtr pfnContinue- 指向回调函数的指针（此处未使用）。UInt32 dwContinue- 作为参数传递给函数的值（此处未使用）。
HtmlCapture 类
现在我们已经定义了 IViewObject 接口，是时候创建一个类来捕获网页为图像了。
Imports System.Windows.Forms
Imports System.Drawing
Public Class HtmlCapture
Private _Web As WebBrowser
Private _Timer As Timer
Private _Screen As Rectangle
Private _ImgSize As System.Nullable(Of Size) = Nothing
'an event that triggers when the html document is captured
Public Delegate Sub HtmlCaptureEvent(sender As Object, url As Uri, image As Bitmap)
Public Event HtmlImageCapture As HtmlCaptureEvent
'class constructor
Public Sub New()
'initialise the webbrowser and the timer
_web = New WebBrowser()
_Timer = New Timer()
_Timer.Interval = 2000
_Screen = Screen.PrimaryScreen.Bounds
'set the webbrowser width and hight
_web.Width = _Screen.Width
_web.Height = _Screen.Height
'suppress script errors and hide scroll bars
_web.ScriptErrorsSuppressed = True
_web.ScrollBarsEnabled = False
'attached events
AddHandler _web.Navigating, AddressOf web_Navigating
AddHandler _web.DocumentCompleted, AddressOf web_DocumentCompleted
AddHandler _Timer.Tick, AddressOf tready_Tick
End Sub
#Region "Public methods"
Public Sub Create(url As String)
_ImgSize = Nothing
_web.Navigate(url)
End Sub
Public Sub Create(url As String, imgsz As Size)
Me._ImgSize = imgsz
_web.Navigate(url)
End Sub
#End Region
#Region "Events"
Private Sub web_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs)
'start the timer
_Timer.Start()
End Sub
Private Sub web_Navigating(sender As Object, e As WebBrowserNavigatingEventArgs)
'stop the timer
_Timer.[Stop]()
End Sub
Private Sub tready_Tick(sender As Object, e As EventArgs)
'stop the timer
_Timer.[Stop]()
'get the size of the document's body
Dim body As Rectangle = _Web.Document.Body.ScrollRectangle
'check if the document width/height is greater than screen width/height
Dim docRectangle As New Rectangle() With { _
.Location = New Point(0, 0), _
.Size = New Size(If(body.Width > _Screen.Width, body.Width, _Screen.Width), _
If(body.Height > _Screen.Height, body.Height, _Screen.Height)) _
}
'set the width and height of the WebBrowser object
_Web.Width = docRectangle.Width
_Web.Height = docRectangle.Height
'if the imgsize is null, the size of the image will
'be the same as the size of webbrowser object
'otherwise set the image size to imgsize
Dim imgRectangle As Rectangle
If _ImgSize Is Nothing Then
imgRectangle = docRectangle
Else
imgRectangle = New Rectangle() With { _
.Location = New Point(0, 0), _
.Size = _ImgSize.Value _
}
End If
'create a bitmap object
Dim bitmap As New Bitmap(imgRectangle.Width, imgRectangle.Height)
'get the viewobject of the WebBrowser
Dim ivo As IViewObject = TryCast(_Web.Document.DomDocument, IViewObject)
Using g As Graphics = Graphics.FromImage(bitmap)
'get the handle to the device context and draw
Dim hdc As IntPtr = g.GetHdc()
ivo.Draw(1, -1, IntPtr.Zero, IntPtr.Zero, IntPtr.Zero, hdc, _
imgRectangle, docRectangle, IntPtr.Zero, 0)
g.ReleaseHdc(hdc)
End Using
'invoke the HtmlImageCapture event
RaiseEvent HtmlImageCapture(Me, _Web.Url, bitmap)
End Sub
#End Region
End Class
如您所见，我正在使用 Timer 对象来确定 HTML 文档是否已完全加载并可以捕获。 我这样做的原因是 HTML 文档可以多次触发 DocumentCompleted 事件。 文档完全加载后，将调用 tready_Tick 方法。
使用代码
HtmlCapture 具有一个重载的 Create 方法。 如果您使用 Create(string url) 方法，则图像的大小将与 HTML 文档的大小相同。 如果您想创建 HTML 文档的缩略图，请使用 Create(string url,Size imgsz)。
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim hc As New HtmlCapture()
AddHandler hc.HtmlImageCapture, AddressOf hc_HtmlImageCapture
hc.Create("https://codeproject.org.cn")
''or
'hc.Create("https://codeproject.org.cn", New Size(200, 300))
End Sub
Private Sub hc_HtmlImageCapture(sender As Object, url As Uri, image As Bitmap)
image.Save(OutputDirectory + url.Authority + ".bmp")
Process.Start(OutputDirectory)
End Sub