| View previous topic :: View next topic |
| Author |
Message |
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
 Posted: Wed Apr 01, 2009 9:01 pm Post subject: to compare pages by 'screenshot' |
 |
|
I would like to be able to watch the Google Maps maps:
- for looking at when the details of my zone are improved
- for looking at when the Street View (orange man) is added to my zone
- for looking at when new places are "tagged" for example on this map: http://www.portel.it/mappe
All these tasks could be performed by WW easily by taking and comparing screenshots of the page, or of a given rectangular part of the page. |
|
| Back to top |
|
 |
Martin Aignesberger
Site Admin
Joined: 11 May 2005
Posts: 4867
|
| Posted: Thu Apr 02, 2009 9:16 am Post subject: |
|
|
Interesting idea, but I don't think that it's possible to get a really well working solution...
Also I'm not sure yet if it is possible to load the page in a hidden window and make a screenshot of that hidden window...
_________________
Martin Aignesberger [SUPPORT] |
|
| Back to top |
|
|
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
|
| Back to top |
|
|
Martin Aignesberger
Site Admin
Joined: 11 May 2005
Posts: 4867
|
| Posted: Mon Apr 20, 2009 1:31 pm Post subject: |
|
|
I currently don't have an experts-exchange account. Does this message work with the IE control?
_________________
Martin Aignesberger [SUPPORT] |
|
| Back to top |
|
|
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
| Posted: Tue Apr 21, 2009 4:22 pm Post subject: |
|
|
| Martin Aignesberger wrote: | | I currently don't have an experts-exchange account. Does this message work with the IE control? |
Ah, sorry.
I copy&paste it:
"I, too have explored the issue of making a program render to an off-screen bitmap, and had at best mixed results. One try is to send the window a WM_PRINTCLIENT message:
WM_PRINTCLIENT Message
http://msdn.microsoft.com/en-us/library/dd145217(VS.85).aspx
But not all windows handle that message, and anyway, if it is not your own application (e.g., an external webbrowser) then there are serious problems in setting up the DC in that app's address space, etc.
See these EE links:
http://www.experts-exchange.com/Programming/System/Windows__Programming/MFC/Q_20780945.html
http://www.experts-exchange.com/Programming/Languages/CPP/Q_20309208.html
Your best bet would be to display the window visibly (breifly) and take the snapshot, then hide it again.
Assuming the window must remain hidden, your next best bet would be to try embedding a webbrowser control into your own app and sending the WM_PRINTCLIENT message to it. But I'm not at all certain how successful that will be." |
|
| Back to top |
|
|
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
| Posted: Thu Apr 30, 2009 8:36 am Post subject: |
|
|
I re-made the question specifically for Delphi:
"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?"
I received this answer in E-E:
"Hi,
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"
If you want I can intermediate a discussion with him for you. |
|
| Back to top |
|
|
Martin Aignesberger
Site Admin
Joined: 11 May 2005
Posts: 4867
|
| Posted: Thu Apr 30, 2009 10:47 am Post subject: |
|
|
I know this solution, but this code only makes a screenshot of the visible content. Large/long pages where you have to scroll cannot be captured completely with that solution.
_________________
Martin Aignesberger [SUPPORT] |
|
| Back to top |
|
|
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
| Posted: Thu Apr 30, 2009 9:30 pm Post subject: |
|
|
Hmmm... I received these other messages from another contributor in the thread:
EddieShipman:
"Well, I don't think that TWebbrowser will allow you to navigate if it is not visible. I've tried it by placing it on a Panel and setting the Panel's Visible to False. I've tried it by having it in an invisible secondary form. Both would not allow WB to navigate and thus you can't take the screenshots.
The delphi3000.com article mentioned above doesn't show you how they actually navigate to the page you are trying to capture. Besides, using the viewObject does not handle pages that are larger that the viewable area of the webbrowser.
If you want to really try out something you can check out my post here:
http://www.delphipages.com/tips/thread.cfm?ID=292
It does FULL page screenshots but TWebbrowser needs to be visible."
Me:
"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?"
EddieShipman:
"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..."
again EddieShipman after 20 minutes:
"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." |
|
| Back to top |
|
|
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
| Posted: Sat May 02, 2009 9:05 pm Post subject: |
|
|
Good news!
I just received this other message from EddieShipman/rllibby that seems to confirm the possibility of taking screenshots of webpages in hidden state in Delphi:
"OK, I have a solution for you and you should write a thank you note to Russell Libby for this.
[...]
Let me first explain some of the nuances to the web control (which will help to explain the solution). First, you *could* hide the browser control by placing the control on a panel and then hiding the panel. But, if the browser control is hidden then the readystate property will never change to READYSTATE_COMPLETE. If it never reaches this state, then you won't be able to get it to render on a canvas handle. You also can't change the width/height to zero, as it WILL reach reach a readystate = READYSTATE_COMPLETE, but it has nothing to render.
The trick is to place the browser control on another control like TPanel, leave the width and height alone, BUT then set the width and/or height of the owner control (TPanel) to zero. The parent control is in effect hidden, but the 2 requirements are fulfilled:
1. Browser has WS_VISIBLE flag set
2. Browser has dimensions greater than (0, 0)
[...]
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."
| Code: |
{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
|
Please let me know if it works and it's useful to enable the graphical comparison of pages in Website Watcher (useful for example to watch Google Maps pages and in many other situations).
Thanks |
|
| Back to top |
|
|
Martin Aignesberger
Site Admin
Joined: 11 May 2005
Posts: 4867
|
| Posted: Mon May 04, 2009 7:30 am Post subject: |
|
|
| Quote: | | Please let me know if it works |
Thanks for this information, I'll try it when I have a bit time... At the moment I'm fully stretched with other features...
_________________
Martin Aignesberger [SUPPORT] |
|
| Back to top |
|
|
Martin Aignesberger
Site Admin
Joined: 11 May 2005
Posts: 4867
|
| Posted: Mon May 04, 2009 6:22 pm Post subject: |
|
|
| Quote: | | Please let me know if it works |
No, it didn't work correctly. At least not with all pages. Some pages worked, but the maps you want to monitor didn't work with that solution.
Anyway, I think I could find my own solution to make a screenshot of the whole page...
_________________
Martin Aignesberger [SUPPORT] |
|
| Back to top |
|
|
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
| Posted: Tue May 05, 2009 10:47 am Post subject: |
|
|
| Martin Aignesberger wrote: | | Quote: | | Please let me know if it works |
No, it didn't work correctly. At least not with all pages. Some pages worked, but the maps you want to monitor didn't work with that solution.
Anyway, I think I could find my own solution to make a screenshot of the whole page... |
Thanks for the feedback. I really hope that you will succeed ėn it.
I think that the main need is for Google Maps and for pages entirely in Flash or in complex ajax (for example the data grids). |
|
| Back to top |
|
|
outmarcus
Joined: 06 Aug 2005
Posts: 413
|
| Posted: Tue May 05, 2009 3:38 pm Post subject: |
|
|
I informed him that it doesn't work correctly with Google Maps and I received these two messages, that supposedly solve the problem:
1st message:
"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.
| Code: |
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;
|
"
2nd message:
"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.
| Code: |
{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.
|
" |
|
| Back to top |
|
|
Martin Aignesberger
Site Admin
Joined: 11 May 2005
Posts: 4867
|
| Posted: Wed May 06, 2009 8:23 am Post subject: |
|
|
Thanks for your updated postings. I haven't tried them yet because I already have my own solution for creating screenshots. If I run into problems with my solution, I'll try your code...
_________________
Martin Aignesberger [SUPPORT] |
|
| Back to top |
|
|
Vladimir Galushko
Joined: 12 May 2005
Posts: 113
Location: Minsk, Republic of Belarus
|
| Posted: Sat Jun 06, 2009 4:52 am Post subject: |
|
|
| With this method at creation of a bookmark does not work "Name: Autofill with the first check". |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Search
Register
Profile
Log in
