Come acquisire le aree della pagina in TWebBrowser?

Question

Sto cercando di creare un programma che crei screenshot di varie aree del sito che viene caricato all'interno del componente TWebBrowser.

Finora ho trovato solo soluzioni a "come fare screenshot dell'intera pagina", ma non sono riuscito a farlo funzionare per catturare una regione specifica, allunga semplicemente la pagina in qualsiasi direzione.

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

Sto utilizzando il codice presentato nel sito sopra.

C'è un modo per modificare il codice in modo che faccia ciò di cui ho bisogno?Ho provato ma non ci sono riuscito.

Apprezzerei se qualcuno potesse almeno darmi una direzione su come risolvere questo problema.

Grazie

Answer 1

I recommend to use the IHTMLElementRender interface of the HTML Elemwnt instead. You can easily find the element under the cursor and render this to a bitmap.

In my TWebBrowser descant I implemented it like this:

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;

Answer 2

You can use sourceBitmap.Canvas.CopyRect

Answer 3

Have you tried setting sourceDrawRect to a rectangle with negative top and left, and a right and bottom past the width and height of the bitmap you let the viewobject draw onto, so that the region you want falls onto this bitmap?