2011-03-23 35 views
1

我想製作一個程序,該程序會在網站上加載TWebBrowser組件的各個區域的屏幕截圖。如何在TWebBrowser中捕獲頁面區域?

到目前爲止,我只找到'如何製作整個頁面的截圖'的解決方案,但我無法讓它工作捕捉特定區域,它只是在任何方向上拉伸頁面。

http://www.delphifaq.com/faq/f408.shtml

我一直在使用網站上面提供的代碼。

有沒有辦法修改代碼,所以它會做我所需要的?我試過但我失敗了。

如果有人能告訴我如何解決這個問題,我將不勝感激。

感謝

回答

4

我建議使用HTML Elemwnt的IHTMLElementRender接口來代替。您可以輕鬆找到光標下的元素並將其渲染爲位圖。

在我TWebBrowser解說我實現這樣的:

function TWebBrowserIBMA.ElementAsBitmap(pElement : IHTMLElement2) : TBitmap; 
var 
    pRender  : IHTMLElementRender; 
    oBmpPart  : TBitmap; 
    nClientWidth : Integer; 
    nClientHeight : Integer; 
    nX   : Integer; 
    nLastX  : Integer; 
    bDoneX  : Boolean; 
    nY   : Integer; 
    nLastY  : Integer; 
    bDoneY  : Boolean; 
begin 
    Result := TBitmap.Create; 

    try 
    Result.Height := pElement.scrollHeight; 
    Result.Width := pElement.scrollWidth; 
    except 
    exit; 
    end; 

    LockWindowUpdate(Handle); 

    if (pElement.QueryInterface(IID_IHTMLElementRender, pRender) = S_OK) then begin 
    try 
     oBmpPart  := TBitmap.Create; 
     oBmpPart.Width := pElement.scrollWidth; 
     oBmpPart.Height := pElement.scrollHeight; 
     nClientWidth := pElement.clientWidth; 
     nClientHeight := pElement.clientHeight; 

     try 
     nX  := pElement.scrollWidth; 
     nLastX := -1; 
     bDoneX := false; 

     while not bDoneX do begin 
      pElement.scrollLeft := nX; 
      nX := pElement.scrollLeft; 
      if nLastX = -1 then begin 
      nLastX := nX + nClientWidth; 
      end; 
      nY  := pElement.scrollHeight; 
      nLastY := (-1); 
      bDoneY := false; 

      while not bDoneY do begin 
      pElement.scrollTop := nY; 
      nY := pElement.scrollTop; 

      if nLastY = -1 then begin 
       nLastY := nY + nClientHeight; 
      end; 

      if (pRender.DrawToDC(oBmpPart.Canvas.Handle) = S_OK) then begin 
       BitBlt(Result.Canvas.Handle, nX, nY, nLastX-nX, nLastY-nY, oBmpPart.Canvas.Handle, 2, 2,SRCCOPY); 
      end; 

      bDoneY := (nY = 0); 
      nLastY := nY; 
      Dec(nY, nClientHeight-4); 
      end; 

      bDoneX := (nX = 0); 
      nLastX := nX; 
      Dec(nX, (nClientWidth-4)); 
     end; 
     finally 
     FreeAndNil(oBmpPart); 
     end; 
    finally 
     pRender := nil; 
    end; 
    end; 

    LockWindowUpdate(0); 
end; 
+0

這並沒有爲我工作。 – 2017-07-28 10:59:47

0

你有沒有嘗試設置sourceDrawRect與負頂部和左,右側和底部過去的位圖的寬度和高度的矩形,你讓的ViewObject繪製到,使全區你想瀑布到這個位圖上?

1

您可以使用sourceBitmap.Canvas.CopyRect