|
 
- UID
- 1
- 帖子
- 274
- 積分
- 29
- 貢獻
- 29
- 金錢
- 129
- 在線時間
- 326 小時
- 註冊時間
- 2006-12-16
- 最後登錄
- 2010-8-7
|
VB中如何保存Webbrowser中的整個頁面到一幅圖片
這個應該可以了,首先picture1.autoredraw=true,visible=false,form1.scalemode=3
Option Explicit
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Sub Command1_Click()
Dim tDoc As MSHTML.HTMLDocument
Dim tIV As IViewObject
Dim tRc As RECT
Dim tOw&, tOh&, tSw&, tSh&
tOw = WebBrowser1.Width
tOh = WebBrowser1.Height
Set tDoc = WebBrowser1.Document
Set tIV = tDoc
tDoc.body.Scroll = "no"
tSw = tDoc.body.scrollWidth + 4
tSh = tDoc.body.scrollHeight + 4
Dim tHdl&
tHdl = GetWebHwnd()
MoveWindow tHdl, 0, 0, tSw, tSh, 0
tRc.Right = tSw
tRc.Bottom = tSh
Picture1.Cls
Picture1.Move Picture1.Left, Picture1.Top, tSw, tSh
tIV.Draw DVASPECT_CONTENT, 1, ByVal 0, ByVal 0, _
0&, Picture1.hDC, tRc, tRc, ByVal 0, ByVal 0
tDoc.body.Scroll = "yes"
MoveWindow tHdl, 0, 0, tOw, tOh, 1
SavePicture Picture1.Image, "c:\web.bmp"
Picture1.Cls
End Sub
Private Sub Command2_Click()
Dim t As New WshShell
t.Run "msgbox"
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "www.pconline.com.cn"
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
Cancel = True
End Sub
Private Function GetWebHwnd() As Long
Dim tHdl&
tHdl = FindWindowEx(Me.hwnd, 0, "Shell Embedding", "")
If tHdl <> 0 Then
tHdl = FindWindowEx(tHdl, 0, "Shell DocObject View", "")
If tHdl <> 0 Then
GetWebHwnd = tHdl
End If
End If
End Function |
|
發表於 2007-1-1 11:11
|