请问如何实现超出屏幕范围的窗口的抓图

[apache57]

想将网页上的内容直接转换成图片。

[apache57]

类似于用HyperSnap，勾选了AUTO SCROLL的功能

[apache57]

各位大侠帮帮忙，在线等ing....

[才子鸣]

这个...


基本上...




很难....

[apache57]

看到一个软件，URL2BMP,感觉上采用的方法是：在窗体上放置一个TWEBBrowser，用一个edit记录需要转换的页面的URL，然后webbrowser.navigate 到edit.txt指定的URL,在程序中打开这个URL。但是，如何将twebbrowser中浏览的页面输出，我不熟悉，请指教。另外这个方法只适合导出超出屏幕范围的网页，其他的超出屏幕的窗口如何输出，请各位大虾不吝赐教

[hqhhh]

超出屏幕，不是太好搞！

[apache57]

呵呵，同事帮俺搞定了，用TWEBBrowser连接MSHTML库，然后实现了导出。
在窗体上放一个Twebbrowser，一个edit用于记录URL,然后放置3个按钮，分别对应 button1 NAVIGATOR到EDIT中记录的URL,BUTTON2 将TWEBBROWSER中的页面另存为HTML文件 BUTTON3将页面导出成BMP文件
代码如下：
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
b: TWebBrowser;
Button3: TButton;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
Uses ActiveX,MSHTML, ComCtrls;

{$R *.dfm}

function CapturePage(var bitmap : TBitmap) : integer;
var
ViewObject:IViewObject;
sourceDrawRect:TRect;
begin
result := -1;
if not assigned(bitmap) then
exit;
with form1.b do
begin
if assigned(Document) then
begin
try
Document.QueryInterface(IViewObject,ViewObject);
except
showmessage('DOCUMENT QUERY INTERFACE ERROR!');
exit;
end;

if ViewObject<>nil then
begin
try
bitmap.Width := form1.b.Width;
bitmap.PixelFormat := pf24bit;
bitmap.Height:= form1.b.Height;
sourceDrawRect:=Rect(0,0,form1.b.Width,form1.b.Height);
ViewObject.Draw(DVASPECT_CONTENT,1,nil,nil,0,bitmap.canvas.Handle,@sourceDrawRect,nil,nil,0);
result := 0;
finally
ViewObject._Release;
end
end
else
result:=0;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
b.Navigate(edit1.text);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin
HTMLDocument := b.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
savedialog1.Filter := 'HTML|*.html;*.htm';
if savedialog1.Execute then
begin
PersistFile.Save(StringToOleStr(savedialog1.FileName), System.True);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
bmp : Tbitmap;
begin
bmp := Tbitmap.Create;
try
try
CapturePage(bmp);
except
showmessage('error occur when CapturePage');
end;

savedialog1.Filter := 'BMP|*.bmp';
if savedialog1.Execute then
begin
bmp.SaveToFile(savedialog1.FileName);
end;
finally
bmp.Free;
end;
end;

[apache57]

对于URL页面超出屏幕的page用上述方法可以实现抓图了，但是对于窗口超出屏幕范围的如何处理，还请大侠们指教，关注有分。

[xixuemao]

对于URL页面超出屏幕的page用上述方法可以实现抓图了，但是对于窗口超出屏幕范围的如何处理

二者有啥区别啊？

不懂，学习.........

[apache57]

超出屏幕范围的部分要分批分批处理
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, OleCtrls, SHDocVw, Sockets, ExtCtrls,MSHTML,
ActiveX, JPEG;

type
TForm1 = class(TForm)
Panel1: TPanel;
TcpServer1: TTcpServer;
WebBrowser: TWebBrowser;
Label1: TLabel;
edtURL: TEdit;
btnNavigate: TBitBtn;
btnSave: TBitBtn;
procedure btnNavigateClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnNavigateClick(Sender: TObject);
begin
WebBrowser.Navigate(edtURL.Text);
end;

procedure TForm1.btnSaveClick(Sender: TObject);
var
Doc: IHTMLDocument2;
ViewObject: IViewObject;
sourceDrawRect: TRect;
a, getjpg: TBitMap;
i,j,k,m: integer;
pdest, psour: hbitmap;
jpg: tjpegimage;
begin
//获取WebBrowser的文档
Doc := WebBrowser.Document as IHTMLDocument2;
if Webbrowser.Document <> nil then
try
//获取文档的接口
webbrowser.Document.QueryInterface(IViewObject, ViewObject);
if ViewObject <> nil then
try
Doc.Get_ParentWindow.Scroll(0, 0); //跳到网页头
//建立一个Bitmap
getjpg := TBitMap.Create();
getjpg.PixelFormat := pf24bit;
getjpg.Height := doc.Body.getAttribute('scrollHeight', 0);
getjpg.Width := doc.Body.getAttribute('scrollwidth', 0);
pdest := getjpg.Canvas.Handle; //getjpg的handle
j := Trunc(doc.Body.getAttribute('ScrollHeight', 0) /
(doc.Body.getAttribute('offsetHeight', 0) - 20));
k := Trunc(doc.Body.getAttribute('Scrollwidth', 0) /
(doc.Body.getAttribute('offsetwidth', 0) - 20));
for i := 0 to k do
begin
for m := 0 to j + 1 do
begin
a := TBitMap.Create();
a.Height := doc.Body.getAttribute('offsetHeight', 0);
a.Width := doc.Body.getAttribute('offsetwidth', 0);
psour := a.Canvas.handle;
sourceDrawRect := Rect(0, 0, a.Width, a.Height);
ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle, a.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
bitblt(pdest, doc.Body.getAttribute('scrollLeft', 0), doc.Body.getAttribute('Scrolltop', 0), a.Width, a.Height, psour, 2, 2, srccopy);
Doc.Get_ParentWindow.Scroll(doc.Body.getAttribute('scrollLeft', 0), doc.Body.getAttribute('offsetHeight', 0) + doc.Body.getAttribute('Scrolltop', 0) - GetSystemMetrics(SM_CXVSCROLL) - 24);
a.Free;
end;
Doc.Get_ParentWindow.Scroll(doc.Body.getAttribute('offsetwidth', 0) + doc.Body.getAttribute('scrollLeft', 0) - GetSystemMetrics(SM_CXVSCROLL) - 24, 0);
end;
jpg := tjpegimage.Create;
jpg.Assign(getjpg);
getjpg.Free;
jpg.SaveToFile('test.jpg');
jpg.Free;
finally
ViewObject._Release;
end;
except
end;
end;

end.

[apache57]

唉，详细查看了URL2BMP这个工具，不是那么容易实现的。晕，暂时先用URL2BMP工具吧，等待各位大侠给我答案