在實際的工作中,有時我們需要對一些網頁進行截圖,一般的網頁截圖的代碼如下(VB2010)
Private Shared Function CaptureWeb(Settings As Object) As Object
Dim _Settings As clsCaptureSettings = CType(Settings, clsCaptureSettings)
Dim _Bmp As Bitmap = Nothing
Using _Web As New WebBrowser
_Web.ScrollBarsEnabled = False
_Web.Width = _Settings.Width
Dim _Time As Date = Now.AddSeconds(_Settings.TimeOut)
_Web.Navigate(_Settings.Url)
Do Until (_Web.ReadyState = WebBrowserReadyState.Complete) OrElse (Now > _Time)
Application.DoEvents()
Loop
_Web.Stop()
If _Web.Document.Body Is Nothing Then
_Web.Height = 40
Else
_Web.Height = _Web.Document.Body.ScrollRectangle.Height
End If
_Bmp = New Bitmap(_Web.Width, _Web.Height)
Dim R As Rectangle = New Rectangle(0, 0, _Web.Width, _Web.Height)
_Web.DrawToBitmap(_Bmp, R)
End Using
Return _Bmp
End Function
這段代碼用到了輔助類clsCaptureSettings。這個類有3個字段:Url:要訪問的網頁的地址;Width:要截圖的寬度,默認是1024;TimeOut:超時設置,默認是180秒;
以上代碼實現截圖的關鍵就是兩句話
_Web.Height = _Web.Document.Body.ScrollRectangle.Height
把WebBrowser的高度設置和網頁高度一致
_Web.DrawToBitmap(_Bmp, R)
將WebBrowser類中的內容畫到位圖對象
上面的代碼經測試,會有如下的兩個問題
1、當WebBrowser的高度設置超過20000(是個約數,沒有仔細測量過)時,DrawToBitmap方法會有一定幾率失效,沒法完成截圖。而且,WebBrowser的高度越大,失效的幾率越大。
2、WebBrowser的高度也不是能無限設置的,其上限是65536,超過這個上限的時候,Webbrowser類會自動設置高度為65536,而當高度設置為65536時,DrawToBitmap方法失效的幾率幾乎是100%
這樣,上面的代碼在截取超長網頁的時候就會出現問題,幾乎不能完成網頁的截圖。
於是,需要改動代碼。利用滾屏實現網頁截圖。
實現滾屏的技術難點在於,一是如何通過代碼滾動網頁?通過查閱資料,用如下的代碼即可。
_Web.Document.Window.Parent.ScrollTo(X, Y)
該代碼將網頁滾動到水平X,垂直Y的位置。
二是,如何獲得當前網頁滾動的垂直位置?代碼如下:
_Web.Document.Body.Parent.ScrollTop
因此,改進後的代碼如下:
Private Shared Function CaptureWeb(Settings As Object)As Object
Dim _Settings As clsCaptureSettings = CType(Settings, clsCaptureSettings)
Dim _Bmp As Bitmap =Nothing
Dim iAs Integer
Const WEB_HEIGHT As Integer = 10000
Using _Web As NewWebBrowser
_Web.ScrollBarsEnabled =False
_Web.Width = _Settings.Width
_Web.Height = WEB_HEIGHT
Dim _Time As Date = Now.AddSeconds(_Settings.TimeOut)
_Web.Navigate(_Settings.Url)
Do Until (_Web.ReadyState = WebBrowserReadyState.Complete) OrElse (Now > _Time)
Application.DoEvents()
Loop
_Web.Stop()
Dim _WebHeightAs Integer
If _Web.Document.BodyIs Nothing Then
_WebHeight = 500
Else
_WebHeight = _Web.Document.Body.ScrollRectangle.Height
End If
_Bmp = New Bitmap(_Web.Width, _WebHeight)
Dim R As Rectangle = New Rectangle(0, 0, _Web.Width, WEB_HEIGHT)
For i = 0 To _WebHeight - 1 Step WEB_HEIGHT
_Web.Document.Window.Parent.ScrollTo(0, i)
If _Web.Document.Body.Parent.ScrollTop = i Then
_Web.DrawToBitmap(_Bmp, R)
R.Offset(0, WEB_HEIGHT)
Else
R.Y = _Web.Document.Body.Parent.ScrollTop
_Web.DrawToBitmap(_Bmp, R)
End If
Next
End Using
Return _Bmp
End Function
此改進後的代碼相較之前的代碼增加了滾動網頁的代碼,因此在截相同的網頁的時候,效率會差點,但是可能截一些超長網頁。
什麼地方會出線超長網頁?很多大家不注意的地方,那就是論壇,一般論壇都是主題一個,每頁的回復數是30個。這樣,很容易整個網頁的長度就超過65536了。用之前的代碼是無法實現截圖的,而用改進後的代碼就可以實現這點。