Mega Code Archive

 
Categories / Delphi / Graphic
 

How to save a Webbrowser page to a bitmap

Title: How to save a Webbrowser page to a bitmap 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;