瀏覽器頁面內容另存為圖檔

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls,
  SHDocVw, MSHTML, ActiveX, Vcl.Imaging.jpeg;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; const [Ref] URL: OleVariant);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SaveWebPageAsImage(WebBrowser: TWebBrowser; FileName: string; AFullPage:Boolean=True);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.SaveWebPageAsImage(WebBrowser: TWebBrowser; FileName: string; AFullPage:Boolean=True);
var
  HTMLDocument: IHTMLDocument2;
  HTMLBody: IHTMLElement2;
  ViewObject: IViewObject;
  Bitmap: TBitmap;
  JpegImage: TJpegImage;
  vRect: TRect;
  DC: HDC;
  orgWidth, orgHeight:Integer;
  orgAlign:TAlign;
begin
  if not Assigned(WebBrowser.Document) then
    Exit;
  

  with WebBrowser do
  begin
    Visible := False;
    orgWidth := Width;
    orgHeight := Height;
    orgAlign := Align;
    Align := alCustom;
  end;

  HTMLDocument := WebBrowser.Document as IHTMLDocument2;
  HTMLBody := HTMLDocument.body as IHTMLElement2;

  // Create a bitmap to hold the webpage content
  Bitmap := TBitmap.Create;
  try
    // Get the view object of the document
    if HTMLDocument.QueryInterface(IViewObject, ViewObject) = S_OK then
    begin
      // Get the bounding rectangle of the WebBrowser
      if AFullPage then
      begin
        WebBrowser.Width := HTMLBody.scrollWidth;
        WebBrowser.Height := HTMLBody.scrollHeight+30;
      end;

      vRect := Rect(0, 0, WebBrowser.Width, WebBrowser.Height);
      Bitmap.Width := WebBrowser.Width;
      Bitmap.Height := WebBrowser.Height;

      // Get a device context (DC) for the bitmap canvas
      DC := Bitmap.Canvas.Handle;

      // Draw the content of the WebBrowser into the bitmap
      ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, 0, DC, @vRect, nil, nil, 0);
    end;

    // Create a TJpegImage and assign the bitmap to it
    JpegImage := TJpegImage.Create;
    try
      JpegImage.Assign(Bitmap);
      JpegImage.SaveToFile(FileName);
    finally
      JpegImage.Free;
    end;

  finally
    Bitmap.Free;
    with WebBrowser do
    begin
      Width := orgWidth;
      Height := orgHeight;
      Align := orgAlign;
      Visible := True;
    end;
  end;

end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const [Ref] URL: OleVariant);
begin
  SaveWebPageAsImage(TWebBrowser(ASender), 'c:\temp\test.jpg');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.Silent := True;
  Webbrowser1.Navigate('https://www.google.com.tw');
end;

end.