How to capture page regions in TWebBrowser?
-
28-10-2019 - |
Question
I am trying to make a program which would make screenshots of various areas on the site that is loaded inside TWebBrowser
component.
So far i have found only solutions to 'how to make screenshot of the whole page', but i just could not make it work to capture specific region, it just stretches the page in whatever direction.
http://www.delphifaq.com/faq/f408.shtml
I have been using the code presented in the site above.
Is there a way to modify the code so it would do what i need? I tried but i failed.
I would appreciate if anybody could at least give me a direction to how to solve this.
Thanks
Solution
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;
OTHER TIPS
You can use sourceBitmap.Canvas.CopyRect
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?