| procedure GenerateJPEGfromBrowser(browser: iWebBrowser2;
jpegFQFilename: string; srcHeight:
integer; srcWidth: integer;
tarHeight: integer; tarWidth: integer);
var
sourceDrawRect: TRect;
targetDrawRect: TRect;
sourceBitmap : TBitmap;
targetBitmap : TBitmap;
aJPG : TJPEGImage;
aViewObject : IViewObject;
begin
sourceBitmap := TBitmap.Create;
targetBitmap := TBitmap.Create;
aJPG := TJPEGImage.Create;
try
try
sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);
sourceBitmap.Width := srcWidth;
sourceBitmap.Height := srcHeight;
aViewObject := browser as IViewObject;
if aViewObject=nil then
Exit;
OleCheck(aViewObject.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);
aJPG.Assign(targetBitmap);
aJPG.SaveToFile(jpegFQFilename)
finally
aJPG.Free;
sourceBitmap.Free;
targetBitmap.Free
end;
except
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
IDoc1: IHTMLDocument2;
Web : iWebBrowser2;
tmpX,
tmpY : integer;
begin
with WebBrowser1 do
begin
Document.QueryInterface(IHTMLDocument2, IDoc1);
Web := ControlInterface;
tmpX := Height;
tmpY := Width;
Height := OleObject.Document.ParentWindow.Screen.Height;
Width := OleObject.Document.ParentWindow.Screen.Width;
GenerateJPEGfromBrowser(Web, '.\test.jpg',
Height, Width,
Height, Width);
Height := tmpX;
Width := tmpY;
Image1.Picture.LoadFromFile('.\test.jpg')
end;
end;
| |