save a Webbrowser page to a bitmap?

Author: Donall Burns  

uses

 MSHTML_TLB, JPEG, ActiveX, ComObj;

procedure generateJPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: string;

 srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);

var

 sourceDrawRect: TRect;

 targetDrawRect: TRect;

 sourceBitmap: TBitmap;

 targetBitmap: TBitmap;

 jpeg: TJPEGImage;

 viewObject: IViewObject;

begin

 sourceBitmap := TBitmap.Create;

 targetBitmap := TBitmap.Create;

 jpeg := TJPEGImage.Create;

 try

   try

     sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);

     sourceBitmap.Width  := srcWidth;

     sourceBitmap.Height := srcHeight;

     viewObject := browser as IViewObject;

     if viewObject = nil then

       Exit;

     OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Form1.Handle,

       sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0));

     // Resize the src bitmap to the target bitmap

     targetDrawRect := Rect(0, 0, tarWidth, tarHeight);

     targetBitmap.Height := tarHeight;

     targetBitmap.Width  := tarWidth;

     targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

     // Create a JPEG from the Bitmap and save it

     jpeg.Assign(targetBitmap);

     jpeg.SaveToFile(jpegFQFilename);

   finally

     jpeg.Free;

     sourceBitmap.Free;

     targetBitmap.Free;

   end;

 except

   // Error Code

 end;

end;

procedure TForm1.btnButton1Click(Sender: TObject);

var

 IDoc1: IHTMLDocument2;

 Web: ShDocVW_TLB.IWebBrowser2;

 tmpX, tmpY: Integer;

begin

 with WebBrowser1 do

 begin

   Document.QueryInterface(IHTMLDocument2, iDoc1);

   Web := ControlInterface;

   tmpX := Height;

   tmpY := Width;

   TControl(WebBrowser1).Visible := Boolean(0);

   Height := OleObject.Document.ParentWindow.Screen.Height;

   Width := OleObject.Document.ParentWindow.Screen.Width;

   generateJPEGfromBrowser(Web,'c:\test.jpg',Height, Width, Height, Width);

   Height := tmpX;

   Width := tmpY;

   TControl(WebBrowser1).Visible := Boolean(1);

 end;

end;