VB中如何保存Webbrowser中的页面到图片

Question

VB中如何保存Webbrowser中的整个页面到一幅图片 ?请大虾指教

Answer 1

Creating an image of the current HTML 
Turning the contents of the WebBrowser into an image is not as straight forward as you may expect. Looking at the IHTMLXxx interfaces does turn up an IHTMLElementRenderer interface. IHTMLElementRenderer contains: IHTMLElementRenderer::Draw(HDC hDC);You can try to use this method, but I have found that it is not very reliable and reacts inconsistently depending on the type of HDC you give it. A more reliable method uses an older OLE method. IViewObject supports the ability to render to an HDC. The IWebBrowser2::Document property can be QueryInterfaced for IViewObject. Two things to note while using this method, (1) you will probably want to turn off the scrollbars and 3D border since they will show up in the image and (2) you will want to resize the WebBrowser to the size of the contained HTML if you want to capture the entire content in the image. You may want to only make these changes temporarily and change them back after the image is captured: 
IHTMLDocument2* pDoc = ...;
IHTMLElement* pBodyElem = 0;
HRESULT hr = pDoc->get_body(&pBodyElem);
if (SUCCEEDED(hr)) {
   IHTMLBodyElement* pBody = 0;
   hr = pBodyElem->QueryInterface(IID_IHTMLBodyElement, (void**)&pBody);
   if (SUCCEEDED(hr)) {
      // hide 3D border
      IHTMLStyle* pStyle;
      hr = pBodyElem->get_style(&pStyle);
      if (SUCCEEDED(hr)) {
         pStyle->put_borderStyle(CComBSTR("none"));
         pStyle->Release();
      }      // hide scrollbars
      pBodyElement->put_scroll(CComBSTR("no"));      // resize the browser component to the size of the HTML content
      IHTMLElement2* pBodyElement2;
      hr = Body->QueryInterface(IID_IHTMLElement2, (void**)&BodyElement2)
      if (SUCCEEDED(hr)) {
         long iScrollWidth = 0;
         pBodyElement2->get_scrollWidth(&iScrollWidth);         long iScrollHeight = 0;
         pBodyElement2->get_scrollHeight(&iScrollHeight);         // these lines depend on your WebBrowser wrapper
         pWebBrowser->SetWidth(iScrollWidth);
         pWebBrowser->SetHeight(iScrollHeight);         pBodyElement2->Release();         IViewObject* pViewObject;
         pDoc->QueryInterface(IID_IViewObject, (void**)&pViewObject);
         if (pViewObject) {
            /* however you want to make your image HDC.
               You can size it using iScrollHeight & iScrollWidth */
            HDC hImageDC = ... // could be bitmap or enhanced metafile
            HDC hScreenDC = ::GetDC(0);
            RECT rcSource = {0, 0, iScrollWidth, iScrollHeight};
            hr = pViewObject->Draw(DVASPECT_CONTENT, 1, NULL, NULL,
                                   hScreenDC, hImageDC, rcSource,
                                   NULL, NULL, 0);
            ::ReleaseDC(0, hScreenDC);
            pViewObject->Release();
         }
      }
      pBody->Release();
   }
   pBodyElem->Release();
}pDoc->Release();
As you can see, there is a lot of things you can do using the MSHTML object model. Some of it can be tricky. Other things just aren't supported as well as they should be for an application developer. I guess you could say that application developers have their own list of issues for IE. 

Answer 2

把网页抓图保存成JPG文件(针对单框架网页)。http://www.tomore.com/dispdocprow.php?id=1363

Answer 3

http://www.tomore.com/dispdocprow.php?id=1363中的DELPHI的，麻烦搞个VB的！分不够再加！

Answer 4

这个非常的简单的
用webbrowser+xmlhttp+stream就可以搞定的,你用google搜索xmlhttp http://www.jaron.cn/chs_Products/60/2004-07/20040731091851-101708.htmlhttp://www.itonline.gd.cn/ittech/list.asp?id=650呵呵,这个代码,你看看,都是vbs的,但是vb里一样可以用的,还有不需要学他们用正则的,你用webbrowser的话要快很多

Answer 5

那也简单,前几天研究一个东西,想出来的,你把webbrowser放到屏幕之外,你知道用dhtml可以判断你的网页的大小吧??然后用抓屏,就能干掉的,屏幕之外的抓屏

Answer 6

liuxiaoyi666,请把你的屏幕外抓屏的大致方法说以下,thank

Answer 7

至于上面的用C和delphi语言实现的事情谁有没有用VB实现的代码,望不吝赐教

Answer 8

好东西啊,简单的翻译了一下,
首先需要下载一个库,http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip,
新建工程,并引用这个库,然后窗体上放webbrwser1,picture1,command1,代码如下Option ExplicitPrivate Sub Command1_Click()
Dim tIv As IViewObject
Dim trc As RECT
trc.Right = 100
trc.bottom = 100Set tIv = WebBrowser1.Document
tIv.Draw DVASPECT_CONTENT, 1, ByVal 0, ByVal 0, _
    Picture1.hDC, Picture1.hDC, trc, trc, ByVal 0, ByVal 0End SubPrivate Sub Form_Load()
WebBrowser1.Navigate "www.google.com"
End SubPrivate Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
Cancel = True
End Sub
启动程序,页面装载完了后,就按command1,然后就画出来了

Answer 9

http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip

Answer 10

lingll的方法不能保存"""完整"""的页面，只能保存一显示出来的部分，有更好的方法吗？

Answer 11

这个应该可以了,首先picture1.autoredraw=true,visible=false,form1.scalemode=3Option 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 LongPrivate Sub Command1_Click()
Dim tDoc As MSHTML.HTMLDocument
Dim tIV As IViewObjectDim tRc As RECTDim tOw&, tOh&, tSw&, tSh&tOw = WebBrowser1.Width
tOh = WebBrowser1.HeightSet tDoc = WebBrowser1.Document
Set tIV = tDoctDoc.body.Scroll = "no"tSw = tDoc.body.scrollWidth + 4
tSh = tDoc.body.scrollHeight + 4Dim tHdl&
tHdl = GetWebHwnd()MoveWindow tHdl, 0, 0, tSw, tSh, 0tRc.Right = tSw
tRc.Bottom = tShPicture1.Cls
Picture1.Move Picture1.Left, Picture1.Top, tSw, tShtIV.Draw DVASPECT_CONTENT, 1, ByVal 0, ByVal 0, _
        0&, Picture1.hDC, tRc, tRc, ByVal 0, ByVal 0tDoc.body.Scroll = "yes"
MoveWindow tHdl, 0, 0, tOw, tOh, 1
SavePicture Picture1.Image, "c:\web.bmp"
Picture1.ClsEnd Sub
Private Sub Command2_Click()
Dim t As New WshShell
t.Run "msgbox"
End SubPrivate Sub Form_Load()
WebBrowser1.Navigate "www.pconline.com.cn"
End SubPrivate 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

Answer 12

帖多了点东西,这段不要Private Sub Command2_Click()
Dim t As New WshShell
t.Run "msgbox"
End Sub