to take a screenshot of a web page using an hidden window?
In a Delphi Windows application, is it possible to load a web page with the IE rendering engine in a hidden window and take a screenshot of that hidden page? if so, how?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
EddieShipman, does you definition of "navigate" include the first opening page?
in other words, is it impossible to take the screenshot of a definite URL/page too? or only of subsequent pages following a navigation?
in other words, is it impossible to take the screenshot of a definite URL/page too? or only of subsequent pages following a navigation?
Yep, even about:blank, it will not do that either. I found that WB would not navigate to any URL if it was not visible.
Remember, it has to have a canvas to render to, right?
Let me try one more thing, however...
Remember, it has to have a canvas to render to, right?
Let me try one more thing, however...
Well, I also tried moving the secondary form off the screen and still no luck.
Sorry, you are just going to have to show the webbrowser.
Sorry, you are just going to have to show the webbrowser.
ASKER
Thanks EddieShipman!
Hypo, do you have anything to add or you agree with EddieShipman?
Hypo, do you have anything to add or you agree with EddieShipman?
Give this a try and see if it works for you.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MSHTML, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, ComCtrls;
const
IID_IHTMLElementRender: TGUID = '{3050F669-98B5-11CF-BB82-00AA00BDCE0B}';
type
IHTMLElementRender = interface(IUnknown)
['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}']
function DrawToDC
( _hDC: HDC
): HResult; stdcall;
end;
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
wb: TWebBrowser;
Panel1: TPanel;
Panel2: TPanel;
edtURL: TEdit;
btnGet: TButton;
ScrollBox1: TScrollBox;
Image1: TImage;
procedure wbDocumentComplete(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure btnGetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CreateWBSnapshot
( Browser: TWebBrowser
; OutputSize: TPoint
): TBitmap;
var pDoc: IHTMLDocument2;
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;
// Check browser document
if Assigned(Browser.Document) and (Browser.Document.QueryInterface(IHTMLDocument2, pDoc) = S_OK) then
begin
// Lock update
LockWindowUpdate(Browser.Handle);
// Resource protection
try
// Check document body
if Assigned(pDoc.Body) and (pDoc.Body.QueryInterface(IHTMLElement2, pElement) = S_OK) then
begin
// Resource protection
try
// Get the renderer
if (pElement.QueryInterface(IID_IHTMLElementRender, pRender) = S_OK) 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;
// Get client width and height
dwClientWidth:=OutputSize.x; //pElement.clientWidth;
dwClientHeight:=OutputSize.y; //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 interface
pRender:=nil;
end;
end;
finally
// Release interface
pElement:=nil;
end;
end;
finally
// Unlock update
LockWindowUpdate(0);
// Release interface
pDoc:=nil;
end;
end;
end;
procedure TForm1.btnGetClick
( Sender: TObject
);
begin
PageControl1.ActivePageIndex := 1;
Screen.Cursor := crHourGlass;
if Length(Trim(edtURL.Text)) > 0 then
begin
wb.Navigate(edtURL.Text);
end
else
ShowMessage('URL can not be blank');
end;
procedure TForm1.wbDocumentComplete
( Sender: TObject
; const pDisp: IDispatch
; var URL: OleVariant
);
var
pDoc: IHTMLDocument2;
pElement: IHTMLElement2;
x, y: Integer;
begin
if URL <> 'about:blank' then
begin
pDoc := wb.Document as IHTMLDocument2;
pElement := pDoc.body as IHTMLElement2;
y := pElement.scrollHeight;
x := pElement.scrollWidth;
Image1.Picture.Bitmap.Assign(CreateWBSnapshot(wb, Point(x, y)));
Screen.Cursor := crDefault;
PageControl1.ActivePageIndex := 0;
end;
end;
procedure TForm1.FormCreate
( Sender: TObject
);
begin
wb.Navigate('about:blank');
end;
end.ASKER
Before trying it, could you please tell me what this code is supposed/hoped to do? it's supposed to take a screenshot of a webpage in *hidden* state?
You've already been told that that is not possible with TWebbrowser.
This one has a pagecontrol and changes to the page with the webbrowser to navigate and when it is finished loading the page, it does the screenshot and then switches back.
Can you not see in the code what is happening?
This one has a pagecontrol and changes to the page with the webbrowser to navigate and when it is finished loading the page, it does the screenshot and then switches back.
Can you not see in the code what is happening?
ASKER
I needed to do it necessariliy with hidden browser
OK, I have a solution for you and you should write a thank you note to Russell Libby for this.
(https://www.experts-exchange.com/questions/21665161/HTML-Page-Preview-or-even-better-thumbnail-viewer-of-a-folder-with-html-files.html#15491088)
The code below has a Webbrowser that is aligned alNone on a Panel with width=0/ height-0
so that makes the webbrowser reach it's readystate and thus being able to render.
(https://www.experts-exchange.com/questions/21665161/HTML-Page-Preview-or-even-better-thumbnail-viewer-of-a-folder-with-html-files.html#15491088)
The code below has a Webbrowser that is aligned alNone on a Panel with width=0/ height-0
so that makes the webbrowser reach it's readystate and thus being able to render.
{Unit Code}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MSHTML, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, ComCtrls;
const
IID_IHTMLElementRender: TGUID = '{3050F669-98B5-11CF-BB82-00AA00BDCE0B}';
type
IHTMLElementRender = interface(IUnknown)
['{3050F669-98B5-11CF-BB82-00AA00BDCE0B}']
function DrawToDC
( _hDC: HDC
): HResult; stdcall;
end;
TForm1 = class(TForm)
wb: TWebBrowser;
Panel1: TPanel;
edtURL: TEdit;
btnGet: TButton;
ScrollBox1: TScrollBox;
Image1: TImage;
procedure wbDocumentComplete(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure btnGetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function CreateWBSnapshot
( Browser: TWebBrowser
; OutputSize: TPoint
): TBitmap;
var pDoc: IHTMLDocument2;
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;
// Check browser document
if Assigned(Browser.Document) and (Browser.Document.QueryInterface(IHTMLDocument2, pDoc) = S_OK) then
begin
// Lock update
LockWindowUpdate(Browser.Handle);
// Resource protection
try
// Check document body
if Assigned(pDoc.Body) and (pDoc.Body.QueryInterface(IHTMLElement2, pElement) = S_OK) then
begin
// Resource protection
try
// Get the renderer
if (pElement.QueryInterface(IID_IHTMLElementRender, pRender) = S_OK) 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;
// Get client width and height
dwClientWidth:=OutputSize.x; //pElement.clientWidth;
dwClientHeight:=OutputSize.y; //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 interface
pRender:=nil;
end;
end;
finally
// Release interface
pElement:=nil;
end;
end;
finally
// Unlock update
LockWindowUpdate(0);
// Release interface
pDoc:=nil;
end;
end;
end;
procedure TForm1.btnGetClick
( Sender: TObject
);
begin
Screen.Cursor := crHourGlass;
if Length(Trim(edtURL.Text)) > 0 then
begin
wb.Navigate(edtURL.Text);
end
else
ShowMessage('URL can not be blank');
end;
procedure TForm1.wbDocumentComplete
( Sender: TObject
; const pDisp: IDispatch
; var URL: OleVariant
);
var
pDoc: IHTMLDocument2;
pElement: IHTMLElement2;
x, y: Integer;
begin
if URL <> 'about:blank' then
begin
pDoc := wb.Document as IHTMLDocument2;
pElement := pDoc.body as IHTMLElement2;
y := pElement.scrollHeight;
x := pElement.scrollWidth;
Image1.Picture.Bitmap.Assign(CreateWBSnapshot(wb, Point(x, y)));
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.FormCreate
( Sender: TObject
);
begin
wb.Navigate('about:blank');
end;
end.
{DFM}
object Form1: TForm1
Left = 331
Top = 117
Width = 783
Height = 540
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 104
Top = 8
Width = 0
Height = 0
Caption = 'Panel1'
TabOrder = 0
object wb: TWebBrowser
Left = 1
Top = 1
Width = 598
Height = 798
TabOrder = 0
OnDocumentComplete = wbDocumentComplete
ControlData = {
4C000000CE3D00007A5200000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
end
object edtURL: TEdit
Left = 24
Top = 16
Width = 169
Height = 21
TabOrder = 1
Text = 'http://www.google.com'
end
object btnGet: TButton
Left = 216
Top = 16
Width = 75
Height = 25
Caption = 'btnGet'
TabOrder = 2
OnClick = btnGetClick
end
object ScrollBox1: TScrollBox
Left = 24
Top = 64
Width = 665
Height = 393
TabOrder = 3
object Image1: TImage
Left = 0
Top = 0
Width = 661
Height = 389
Align = alClient
AutoSize = True
end
end
end
ASKER
Thanks EddieShipman!
I passed it to my developer colleague who will test it one of the next days.
I'll surely thank you both if it works and I will award you last message.
I passed it to my developer colleague who will test it one of the next days.
I'll surely thank you both if it works and I will award you last message.
ASKER
My developer answered this: "it didn't work correctly. At least not with all pages. Some pages worked, but the Google Maps you want to monitor didn't work with this solution."
I will take a look at it. It may be that the timing or the AJAX that Google Maps uses is the issue.
ASKER
Thanks Eddie
I have no idea what is causing that one. I've tried everything I know to get it with no luck.
Please tell me more about the sites you want to capture.
Using IViewObject works somewhat on Google Maps. There are still areas that aren't painted correctly.
In the code below, I use a button to take the snapshot and have a checkbox to use the IViewObject.
This code saves the snapshots to a file.
In the code below, I use a button to take the snapshot and have a checkbox to use the IViewObject.
This code saves the snapshots to a file.
var
sourceBitmap: TBitmap;
sourceDrawRect: TRect;
viewObject: IViewObject;
Doc: IHTMLDocument2;
body: OleVariant;
intHeight, intWidth: Integer;
begin
sourceBitmap := TBitmap.Create;
Doc := wb.Document as IHTMLDocument2;
body := Doc.Body;
intWidth := body.ScrollWidth + body.LeftMargin + body.RightMargin;
intHeight := body.ScrollHeight + body.TopMargin + body.BottomMargin;
wb.Width := intWidth;
wb.Height := intHeight;
try
if chkIViewObject.Checked then
begin
body.NoWrap := True;
{hide scrollbars}
body.Style.BorderStyle := 'none';
body.Scroll := 'no';
sourceDrawRect := Rect(0, 0, intWidth, intHeight);
sourceBitmap.Width := wb.Width;
sourceBitmap.Height := wb.Height;
wb.Document.QueryInterface(IViewObject, ViewObject);
if ViewObject <> nil then
begin
try
ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle,
sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
finally
ViewObject._Release;
end;
end;
end
else
begin
sourcebitmap.Assign(CreateWBSnapshot(wb, Point(intWidth, intHeight)));
end;
finally
sourceBitmap.SaveToFile('c:\aaa.bmp');
sourceBitmap.Free;
end;
end;
Ok, I think I may have found something. Take a look at the comments in this unit that I posted on Delphi Pages back in 2005. All you have to do is include this unit and modify the form code I posted above like shown below.
It may be that the Google Maps pages needed to get the Parent .vs the Body to correctly render.
I did some tests and it seems to work.
It may be that the Google Maps pages needed to get the Parent .vs the Body to correctly render.
I did some tests and it seems to work.
{Modified form code}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MSHTML, StdCtrls, ExtCtrls, OleCtrls, SHDocVw, ComCtrls;
type
TForm1 = class(TForm)
wb: TWebBrowser;
Panel1: TPanel;
edtURL: TEdit;
btnGet: TButton;
ScrollBox1: TScrollBox;
Image1: TImage;
procedure wbDocumentComplete(Sender: TObject; const pDisp: IDispatch;
var URL: OleVariant);
procedure btnGetClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses WebUtils;
{$R *.dfm}
procedure TForm1.btnGetClick
( Sender: TObject
);
begin
Screen.Cursor := crHourGlass;
if Length(Trim(edtURL.Text)) > 0 then
begin
wb.Navigate(edtURL.Text);
end
else
ShowMessage('URL can not be blank');
end;
procedure TForm1.wbDocumentComplete
( Sender: TObject
; const pDisp: IDispatch
; var URL: OleVariant
);
var
pDoc: IHTMLDocument2;
pElement: IHTMLElement2;
x, y: Integer;
begin
if URL <> 'about:blank' then
begin
Image1.Picture.Bitmap.Assign(CreateScaledImage(wb, 1.0));
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.FormCreate
( Sender: TObject
);
begin
wb.Navigate('about:blank');
end;
end.
{WebUtils unit}
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:
//
// http://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(const 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.ASKER
Passed to the developer. Thanks!
I'll let you know.
I'll let you know.
it is possible to do what you want. Check out this article at delphi3000: http://www.delphi3000.com/articles/article_4132.asp?SK=
It describes how you capture the output from a TWebBrowser control to a Canvas handle, which is then saved to a jpeg file on disk. In the article, the WebBrowser control is on the main form, but you could easily change the code so that it paints a WebBrowser from a hidden window. I tried it myself and it worked fine. :)
NOTE:
I had to tweak the code in the example somewhat for it to work, for instance, I didn't have the unit MSHTML_TLB, but instead you can replace it with the unit MSHTML in the uses list. Also in the function TForm1.btnButton1Click, the web variable has the type ShDocVW_TLB.IWebBrowser2, but I didn't have ShDocVW_TLB, so that could just be replaced with IWebBrowser2, since it exists in the MSHTML unit. Orhter than that, it worked flawless. :)
regards
Hypo