unit1.pas

连到某网站

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Panel1: TPanel;
    Edit1: TEdit;
    Label1: TLabel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses u_showimg;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Doc: IHTMLDocument2;
  ViewObject: IViewObject;
  sourceDrawRect: TRect;
  a, getjpg: TBitMap;
  i, m: integer;
  pdest, psour: hbitmap;
  jpg: tjpegimage;
begin
  Doc := WebBrowser1.Document as IHTMLDocument2;
  if WebBrowser1.Document <> nil then
  try
    WebBrowser1.Document.QueryInterface(IViewObject, ViewObject);
    if ViewObject <> nil then
    try
      Doc.Get_ParentWindow.Scroll(0, 0); //跳到网页头
      getjpg := TBitMap.Create();
      getjpg.PixelFormat := pf24bit;
      getjpg.Height := doc.Body.getAttribute('scrollHeight', 0);
      getjpg.Width := doc.Body.getAttribute('scrollwidth', 0);
      pdest := getjpg.Canvas.Handle;
      m := Trunc(doc.Body.getAttribute('ScrollHeight', 0) / (doc.Body.getAttribute('offsetHeight', 0) - 20));
      i := Trunc(doc.Body.getAttribute('Scrollwidth', 0) / (doc.Body.getAttribute('offsetwidth', 0) - 20));
      for i := 0 to i do
      begin
        for m := 0 to m + 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('demo.jpg');
      jpg.Free;
    finally
      ViewObject._Release;
    end;
    try
      frm_showimg:=Tfrm_showimg.create(application);
      frm_showimg.Image1.Picture.LoadFromFile('demo.jpg');
      frm_showimg.showmodal;
    finally
      frm_showimg.free;
    end;
  except
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WebBrowser1.Navigate(Edit1.Text);
end;

end.