Как захватить регионы страниц в TWebBrowser? - PullRequest
1 голос
/ 23 марта 2011

Я пытаюсь создать программу, которая бы делала скриншоты различных областей сайта, загруженных внутри TWebBrowser компонента.

Пока что я нашел только решения о том, «как сделать скриншотвсю страницу », но я просто не мог заставить его работать для захвата определенного региона, он просто растягивает страницу в любом направлении.

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

Я использовал код, представленный всайт выше.

Есть ли способ изменить код, чтобы он делал то, что мне нужно?Я пытался, но у меня не получилось.

Буду признателен, если кто-нибудь хотя бы подскажет, как решить эту проблему.

Спасибо

Ответы [ 3 ]

4 голосов
/ 24 марта 2011

Я рекомендую вместо этого использовать IHTMLElementRender интерфейс HTML Elemwnt. Вы можете легко найти элемент под курсором и отобразить его как растровое изображение.

В моем дескрипторе 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;
1 голос
/ 23 марта 2011

Вы можете использовать sourceBitmap.Canvas.CopyRect

0 голосов
/ 23 марта 2011

Вы пытались установить sourceDrawRect для прямоугольника с отрицательной верхней и левой частями, а также справа и снизу за шириной и высотой растрового изображения, на которое вы позволяете объекту рисования рисовать, чтобы область, на которую вы хотите, попала в это растровое изображение?

...