追蹤
跟著傑森去旅行
關於部落格
一位熱愛旅行、拍照和嚐美食的玩家,跟你一同分享生活中有趣的發現。
  • 32225

    累積人氣

  • 0

    今日人氣

    1

    追蹤人氣

把網頁存成圖片的方法

http://www.bsalsa.com/forum/showthread.php?t=201
(*****************************************************************************
  TIEBitmap - use it to get screenshot of the whole web page loaded in WB.

  Example 1: Create instance of TIEBitmap and call Prepare method
    B.Prepare('www.bsalsa.com');
    B.SaveToFile(C:B1a.BMP');
    B.Prepare('www.google.com');
    B.SaveToFile(C:B1b.BMP');
  Example 2: Create and prepare directly from constructor:
    TIEBitmap.Create('www.borland.com').SaveToFile('C:B2.BMP');
  Example 3: Use Delay to have animation on page captured in later stage
    TIEBitmap.Create('www.borland.com', 2000).SaveToFile('C:B3.BMP');

                                Code by Sleeper
 *****************************************************************************)
unit IEBitmap;

interface

uses
  Windows, Classes, SysUtils, Graphics, MsHtml, SHDocVw, Forms, ActiveX;

type
  TIEBitmap = class(Graphics.TBitmap)
  private
    FWebBrowser: TWebBrowser;
    FForm: TForm;
    FReady: Boolean;
    FDelay: Cardinal;
    procedure OnDocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure SetBitmap;
  public
    constructor Create; overload; override;
    constructor Create(const URL: string; const Delay: Cardinal = 0); reintroduce; overload;
    destructor Destroy; override;
    procedure Prepare(const URL: String; const Delay: Cardinal = 0);
  end;

implementation

(*
 * Main Constructor
 *)
constructor TIEBitmap.Create;
begin
  inherited;
  (* Create Form to be parent of WB and put the form away from screen *)
  FForm:= TForm.Create(nil);
  FForm.Height:= 0;
  FForm.Width:= 0;
  FForm.Top:= -1000;
  FForm.Left:= -1000;
  FForm.Visible:= False;
  (* Create WB and insert it on Form *)
  FWebBrowser:= TWebBrowser.Create(FForm);
  FForm.InsertControl(FWebBrowser);
  FWebBrowser.Height:= 0;
  FWebBrowser.Width:= 0;
  (* Assign Event *)
  FWebBrowser.OnDocumentComplete:= OnDocumentComplete;
end;

(*
 * Overloaded constructor for one line call...
 * You can try with:
 * Image1.Picture.Assign(TIeBitmap.Create('www.google.com');
 *)
constructor TIEBitmap.Create(const URL: string; const Delay: Cardinal);
begin
  Create;
  Prepare(URL, Delay);
end;

(*
 * Destructor
 *)
destructor TIEBitmap.Destroy;
begin
  FWebBrowser.Stop;
  FForm.RemoveControl(FWebBrowser);
  FreeAndNil(FForm);
  inherited;
end;

(*
 * use Prepare to create more than one capture using same TIEBitmap
 *)
procedure TIEBitmap.Prepare(const URL: String; const Delay: Cardinal);
begin
  (* Remember Delay *)
  FDelay:= Delay;
  (* Not done *)
  FReady:= False;
  (* Show FForm in order to have WebBrowser working ok *)
  FForm.Visible:= True;
  (* Navigate to the URL *)
  FWebBrowser.Navigate(URL);
  (* Wait for document complete *)
  while not FReady do
  begin
    Application.ProcessMessages;
  end;
end;

(*
 * DocumentComplete Event
 *)
procedure TIEBitmap.OnDocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  (* Delay in miliseconds, before taking capture *)
  Sleep(FDelay);
  (* Capture whole web page *)
  SetBitmap;
end;

(*
 * Save WebPage to Bitmap (Self)
 *)
procedure TIEBitmap.SetBitmap;
var
  Bmp: TBitmap;
  R: TRect;
  ViewObject: IViewObject2;
  Doc: IHTMLDocument2;
  Body: OleVariant;
  H, W: Integer;
begin
  (* Get WB Document *)
  Doc := IHTMLDocument2(FWebBrowser.Document);
  (* Get Body and set body style *)
  Body := Doc.Body;
  Body.NoWrap := True;
  (* Hide Scrollbars *)
  Body.Style.BorderStyle := 'none';
  Body.Scroll := 'no';
  (* Calculate width and height of whole document *)
  W := Body.ScrollWidth + Body.LeftMargin + Body.RightMargin;
  H := Body.ScrollHeight + Body.TopMargin + Body.BottomMargin;
  (* Set width and height to WB *)
  FWebBrowser.Width := W;
  FWebBrowser.Height := H;
  (* Set rectangle dimension *)
  R := Rect(0, 0, W, H);
  (* Create Temp Bitmap *)
  Bmp := TBitmap.Create;
  try
    (* Set Width and Height here too *)
    Bmp.Width := FWebBrowser.Width;
    Bmp.Height := FWebBrowser.Height;
    (* Get IViewObject2 interface from WB Document *)
    FWebBrowser.Document.QueryInterface(IViewObject2, ViewObject);
    if ViewObject <> nil then
      try
        (* Draw it to the temp bitmap *)
        ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil,
          Application.Handle, Bmp.Canvas.Handle, @R, nil, nil, 0);
      finally
        ViewObject._Release;
      end;
    (* Assign the result *)
    Self.Assign(Bmp);
  finally
    (* Free Temp Bitmap *)
    Bmp.Free;
    (* Hide the Form *)
    FForm.Visible:= False;
    (* Ready to continue *)
    FReady:= True;
  end;
end;

end.
相簿設定
標籤設定
相簿狀態