unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, SHDocVw, MSHTML, ActiveX, ComObj, JPEG;
type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure JPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: string; srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);
var
sourceDrawRect, targetDrawRect: TRect;
sourceBitmap, 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));
targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
targetBitmap.Height := tarHeight;
targetBitmap.Width := tarWidth;
targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);
jpeg.Assign(targetBitmap);
jpeg.SaveToFile(jpegFQFilename);
finally
jpeg.Free;
sourceBitmap.Free;
targetBitmap.Free;
end;
except
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
IDoc1: IHTMLDocument2;
Web: ShDocVW.IWebBrowser2;
tmpX, tmpY: Integer;
begin
with WebBrowser1 do
begin
Document.QueryInterface(IHTMLDocument2, iDoc1);
Web := ControlInterface;
tmpX := Height;
tmpY := Width;
WebBrowser1.Visible := false;
Height := OleObject.Document.ParentWindow.Screen.Height;
Width := OleObject.Document.ParentWindow.Screen.Width;
// Height := OleObject.Document.body.ScrollHeight;
// Width := OleObject.Document.body.ScrollWidth;
JPEGfromBrowser(Web,'c:\zzz\browser.jpg', Height, Width, Height, Width);
Height := tmpX;
Width := tmpY;
WebBrowser1.Visible := true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://www.howto.pe.kr', EmptyParam, EmptyParam, EmptyParam, EmptyParam);
end;
end. |
|
