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

Question

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

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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

Answer 5

呵呵，同事帮俺搞定了，用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;

Answer 6

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

Answer 7

对于URL页面超出屏幕的page用上述方法可以实现抓图了，但是对于窗口超出屏幕范围的如何处理二者有啥区别啊？不懂，学习.........

Answer 8

超出屏幕范围的部分要分批分批处理
unit Unit1;interfaceuses
  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.