TWebBrowser скрытно взять скриншот

[beegl]

Добрый час!

Как сделать скриншот сайта в TWebBrowser, не показывая его(TWebBrowser) пользователю?

P.S. показать на долю секунды TWebBrowser можно

[doktor255]

А можно узнать цель этой операции?

[Stilet]

http://www.programmersforum.ru/showthread.php?t=245078
http://www.programmersforum.ru/showthread.php?t=94574

[beegl]

doktor255, готовый отчет оформить



это окно моей программы:



что-то нашел, только не знаю какой модуль надо подключить для IViewObject

procedure WebBrowserScreenShot(const wb: TWebBrowser; const fileName: TFileName);
var
viewObject : IViewObject;
r : TRect;
bitmap : TBitmap;
begin
if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject) ;
    if Assigned(viewObject) then
      bitmap := TBitmap.Create;
      r := Rect(0, 0, wb.Width, wb.Height) ;
      bitmap.Height := wb.Height;
      bitmap.Width := wb.Width;
      viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0) ;
      bitmap.SaveToFile(filename);
      bitmap.Free;
      viewObject._Release;
end;
end;

[doktor255]

beegl ActiveX

[Stilet]

http://msdn.microsoft.com/en-us/library/aa911697.aspx
Library oleaut32.lib, uuid.lib
Соответствующие ДЛЛки найти, или модули, если в Делфи предусмотрено.

[beegl]

как переделать фунукию, чтоб прямо в Image1 сохраняло?

procedure TForm1.WebBrowserScreenShot(const wb: TWebBrowser;
  const fileName: TFileName);
var
viewObject : IViewObject;
r : TRect;
bitmap : TBitmap;
begin
if wb.Document <> nil then
begin
wb.Document.QueryInterface(IViewObject, viewObject) ;
if Assigned(viewObject) then
try
bitmap := TBitmap.Create;
try

r := Rect(0, 0, wb.Width, wb.Height) ;  //left, top, right, bottom
bitmap.Height := wb.Height;
bitmap.Width := wb.Width;

viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0) ;
with TJPEGImage.Create do
try
Assign(bitmap) ;
SaveToFile(fileName) ;
finally
Free;
end;
finally
bitmap.Free;
end;
finally
viewObject._Release;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowserScreenShot(web1,'D:\WebBrowserImage.jpg') ;
end;

[doktor255]

procedure WebBrowserScreenShot(const wb: TWebBrowser);
var
viewObject : IViewObject;
r : TRect;
bitmap : TBitmap;
begin
if wb.Document <> nil then
  begin
    wb.Document.QueryInterface(IViewObject, viewObject) ;
    if Assigned(viewObject) then
      bitmap := TBitmap.Create;
      r := Rect(0, 0, wb.Width, wb.Height) ;
      bitmap.Height := wb.Height;
      bitmap.Width := wb.Width;
      viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0) ;
      Form1.Image1.AutoSize := true;
      Form1.Image1.Picture.Assign(Bitmap);
      bitmap.Free;
      viewObject._Release;
end;
end;

P.S. Try внутри Try. Двойная контрацепция?

[beegl]

остановился на этом реализе:

основное окно:



окно отчета:



окно о программе:

[ZuBy]

Не самый лучший релиз, из кучи не нужных отвлекающих кнопок.

Intertelecom - это небольшая программка для проверки баланса

Ну как сказать, 2.7 Мб +огромное окно+WebBrowser+не отдерается от правого нижнего угла+нахера пароль вместе с программой отсылать?