asked on

Web Page Snapshot (BITMAP) in WebBrowser / Internet Explorer - FIX A BUG

Hello!
To "convert" a web page to a bitmap I have used excellent rllibby's code from
https://www.experts-exchange.com/questions/21608891/Web-Page-Snapshots-good-solution-but-help-needed.html
for example: CreateScaledImage(WebBrowser1,1).SaveToFile('C:\test.bmp');
It worked very well, but now...

In Internet Explorer 8 it does not work on MANY PAGES - for example
http://www.ableget.com
http://www.cnet.com
I spent lot of time trying to figure, what is wrong but I did not found the solution.

Does anybody has an idea, what is wrong? Did Microsoft changed something?

On simple pages this code works correctly - for example
http://www.google.com

I would be VERY GRATEFUL for suggestions.
Best regards
Bart

unit WebUtils;
////////////////////////////////////////////////////////////////////////////////
//
// Unit : WebUtils
// Date : 10.27.2005 (updated 10.28.2005)
// Description : Utility functions based on the TWebBrowser object
//
//
// function GetDocumentSize(Browser: TWebBrowser): TPoint;
//
// Returns the document's body size as a TPoint, where X = width and Y = height
//
// function GetBrowserElement(Browser: TWebBrowser; out Element: IHTMLElement2): HResult;
//
// Returns the actual element required to perform the rendering to a canvas handle.
// For most pages, this will be the body element. But for some, eg:
//
// https://www.experts-exchange.com
// http://www.msn.com
//
// the parent element will need to be used. The element to use is based on
// getting the parent and checking it for a clientwidth/height of zero. If zero,
// then the body element can be used. If not zero, then the parent must be used.
//
// function CreateThumbnailImage(Browser: TWebBrowser; OutputSize: TPoint): TBitmap;
//
// Returns a bitmap object of the document page where the width and height is
// determined by the point (x = width, y=height) passed in OutputSize.
//
// function CreateScaledImage(Browser: TWebBrowser; Scale: Double): TBitmap;
//
// Returns a scaled bitmap object of the document page. A scaling of 1.0 will
// return the page at its actual size. To return a 1/10 scaled image of the
// document for example, 0.1 would be passed to Scale.
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
// Include units
////////////////////////////////////////////////////////////////////////////////
uses
Windows, SysUtils, Classes, Graphics, ShdocVW, ActiveX, MSHTML;

////////////////////////////////////////////////////////////////////////////////
// Constants
////////////////////////////////////////////////////////////////////////////////
const
IID_IHTMLElementRender: TGUID = '{3050F669-98B5-11CF-BB82-00AA00BDCE0B}';

////////////////////////////////////////////////////////////////////////////////
// Interfaces
////////////////////////////////////////////////////////////////////////////////
type
IHTMLElementRender = interface(IUnknown)
['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}']
function DrawToDC(_hDC: HDC): HResult; stdcall;
function SetDocumentPrinter(bstrPrinterName: WideString; _hDC: HDC): HResult; stdcall;
end;

////////////////////////////////////////////////////////////////////////////////
// Utility functions
////////////////////////////////////////////////////////////////////////////////
function GetDocumentSize(Browser: TWebBrowser): TPoint;
function GetBrowserElement(Browser: TWebBrowser; out Element: IHTMLElement2): HResult;
function CreateThumbnailImage(Browser: TWebBrowser; OutputSize: TPoint): TBitmap;
function CreateScaledImage(Browser: TWebBrowser; Scale: Double): TBitmap;

implementation

function GetBrowserElement(Browser: TWebBrowser; out Element: IHTMLElement2): HResult;
var pDoc: IHTMLDocument2;
pElemParent: IHTMLElement;
pElement: IHTMLElement;
pElement2: IHTMLElement2;
begin

// Check browser document
if Assigned(Browser.Document) then
begin
// QI for document 2 interface
result:=Browser.Document.QueryInterface(IHTMLDocument2, pDoc);
// Check result
if Succeeded(result) then
begin
// Resource protection
try
// Check document body
if Assigned(pDoc.Body) then
begin
// QI for body element
result:=pDoc.Body.QueryInterface(IHTMLElement, pElement);
// Check result
if Succeeded(result) then
begin
// Resource protection
try
// Get parent element
pElemParent:=pElement.parentElement;
// Check parent
if Assigned(pElemParent) then
begin
// Resource protection
try
// Get the element 2 interface
if Succeeded(pElemParent.QueryInterface(IHTMLElement2, pElement2)) then
begin
// Check parent interface for zero client width or height
if (pElement2.clientWidth = 0) or (pElement2.clientHeight = 0) then
// QI for element 2 interface
result:=pElement.QueryInterface(IHTMLElement2, Element)
else
// We have the element we are after
Element:=pElement2;
end
else
// QI for element 2 interface
result:=pElement.QueryInterface(IHTMLElement2, Element);
finally
// Release the interface
pElemParent:=nil;
end;
end
else
// Return nearest COM error
result:=E_NOINTERFACE;
finally
// Release the interface
pElement:=nil;
end;
end;
end
else
// Return nearest COM error
result:=E_NOINTERFACE;
finally
// Release the interface
pDoc:=nil;
end;
end;
end
else
// Return nearest COM error
result:=E_NOINTERFACE;

end;

function GetDocumentSize(Browser: TWebBrowser): TPoint;
var pElement: IHTMLElement2;
begin

// Get the browser body element interface
if Succeeded(GetBrowserElement(Browser, pElement)) then
begin
// Resource protection
try
// Set result size
result:=Point(pElement.ScrollWidth, pElement.ScrollHeight);
finally
// Release the interface
pElement:=nil;
end;
end

end;

function CreateScaledImage(Browser: TWebBrowser; Scale: Double): TBitmap;
var ptActual: TPoint;
ptScale: TPoint;
begin

// Get actual size
ptActual:=GetDocumentSize(Browser);

// Apply the scaling to it
ptScale.x:=Round(ptActual.x * Scale);
ptScale.y:=Round(ptActual.y * Scale);

// Get the image
result:=CreateThumbnailImage(Browser, ptScale);

end;

function CreateThumbnailImage(Browser: TWebBrowser; OutputSize: TPoint): TBitmap;
var pElement: IHTMLElement2;
pRender: IHTMLElementRender;
bmpRender: Array [0..1] of TBitmap;
dwClientWidth: Integer;
dwClientHeight:Integer;
dwIndex: Integer;
dwX: Integer;
dwLastX: Integer;
bDoneX: Boolean;
dwY: Integer;
dwLastY: Integer;
bDoneY: Boolean;
begin

// Create resulting image
result:=TBitmap.Create;

// Set size
result.Width:=OutputSize.x;
result.Height:=OutputSize.y;

// Lock update
LockWindowUpdate(Browser.Handle);

// Resource protection
try
// Get the browser body element interface
if Succeeded(GetBrowserElement(Browser, pElement)) then
begin
// Resource protection
try
// Get the renderer
if Succeeded(pElement.QueryInterface(IID_IHTMLElementRender, pRender)) then
begin
// Resource protection
try
// Create images to blit the parts to
for dwIndex:=0 to 1 do
begin
bmpRender[dwIndex]:=TBitmap.Create;
bmpRender[dwIndex].Width:=pElement.scrollWidth;
bmpRender[dwIndex].Height:=pElement.scrollHeight;
end;
// Set render "printer"
pRender.SetDocumentPrinter('Bitmap', bmpRender[0].Canvas.Handle);
// Get client width and height
dwClientWidth:=pElement.clientWidth;
dwClientHeight:=pElement.clientHeight;
// Resource protection
try
// Set starting X variables
dwX:=pElement.scrollWidth;
dwLastX:=(-1);
bDoneX:=False;
// Loop while X not done
while not(bDoneX) do
begin
// Scroll
pElement.scrollLeft:=dwX;
// Get scroll
dwX:=pElement.scrollLeft;
// Check for (-1)
if (dwLastX = (-1)) then dwLastX:=dwX + dwClientWidth;
// Set starting Y variables
dwY:=pElement.scrollHeight;
dwLastY:=(-1);
bDoneY:=False;
// Loop while Y not done
while not(bDoneY) do
begin
// Scroll
pElement.scrollTop:=dwY;
// Get scroll
dwY:=pElement.scrollTop;
// Check for (-1)
if (dwLastY = (-1)) then dwLastY:=dwY + dwClientHeight;
// Draw to bitmap handle
if (pRender.DrawToDC(bmpRender[0].Canvas.Handle) = S_OK) then
begin
// Blit the image
BitBlt(bmpRender[1].Canvas.Handle, dwX, dwY, dwLastX-dwX, dwLastY-dwY, bmpRender[0].Canvas.Handle, 2, 2,SRCCOPY);
end;
// Update the Y variables
bDoneY:=(dwY = 0);
dwLastY:=dwY;
Dec(dwY, (dwClientHeight-4));
end;
// Update the X variables
bDoneX:=(dwX = 0);
dwLastX:=dwX;
Dec(dwX, (dwClientWidth-4));
end;
// Stretch draw the image to the resulting bitmap
StretchBlt(result.Canvas.Handle, 0, 0, OutputSize.x, OutputSize.y, bmpRender[1].Canvas.Handle, 0, 0, bmpRender[1].Width, bmpRender[1].Height, SRCCOPY);
finally
// Free the bitmap
for dwIndex:=0 to 1 do FreeAndNil(bmpRender[dwIndex]);
end;
finally
// Release the interface
pRender:=nil;
end;
end;
finally
// Release the interfaces
pElement:=nil;
end;
end;
finally
// Unlock update
LockWindowUpdate(0);
end;

end;

end.

Mahdi78

The following code will make jpeg Snapshot

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses  MSHTML, ComObj, ActiveX, jpeg;

{$R *.dfm}

procedure generateJPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: string;
  srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);
var
  sourceDrawRect: TRect;
  targetDrawRect: TRect;
  sourceBitmap: TBitmap;
  targetBitmap: TBitmap;
  jpeg: TJPEGImage;
  viewObject: IViewObject;
begin
  sourceBitmap := TBitmap.Create;
  targetBitmap := TBitmap.Create;
  jpeg := TJPEGImage.Create;
  try
    try
      sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);
      sourceBitmap.Width  := srcWidth;
      sourceBitmap.Height := srcHeight;

      viewObject := browser as IViewObject;

      if viewObject = nil then
        Exit;

      OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, 0,
        sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0));

      // Resize the src bitmap to the target bitmap
      targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
      targetBitmap.Height := tarHeight;
      targetBitmap.Width  := tarWidth;
      targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

      // Create a JPEG from the Bitmap and save it
      jpeg.Assign(targetBitmap);

      jpeg.SaveToFile(jpegFQFilename);
    finally
      jpeg.Free;
      sourceBitmap.Free;
      targetBitmap.Free;
    end;
  except
    // Error Code
  end;
end;

procedure Capture;
var
  IDoc1: IHTMLDocument2;
  Web: ShDocVW.IWebBrowser2;
  tmpX, tmpY: Integer;
  imagefl : string;
begin
imagefl := ExtractFilePath(Application.ExeName)+'\test.jpg' ;
  with Form1.WebBrowser1 do
  begin
    Document.QueryInterface(IHTMLDocument2, iDoc1);
    Web := ControlInterface;
    tmpX := Height;
    tmpY := Width;
    TControl(Form1.WebBrowser1).Visible := Boolean(0);
    Height := OleObject.Document.ParentWindow.Screen.Height;
    Width := OleObject.Document.ParentWindow.Screen.Width;

    generateJPEGfromBrowser(Web, imagefl,Height, Width, Height, Width);
    Height := tmpX;
    Width := tmpY;
    TControl(Form1.WebBrowser1).Visible := Boolean(1);
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Capture;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://www.google.com');
end;

end.

Open in new window

ASKER CERTIFIED SOLUTION

Mahdi78

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Bart_Michael

ASKER

Thank You VERY MUCH!
Your code works correctly. I have found on the Internet, that Internet Explorer 8 has bugs in IHTMLElementRender.DrawToDC

Your solution uses IViewObject.Draw, and it works fine (until a new bug will be introduced :-)

Best regards
Bart

pieterjansen

the suggested solution however only creates a screenshot of the part of the website visible in the browser, the first code makes a full copy of the website, regardless of the size of the TWebbrowser.