public
    procedure WebBrowserScreenShot(const wb: TsWebBrowser; const fileName: TFileName);
    procedure Bro_comp(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);{OnDocumentComplete}
    procedure Bro_nav(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);{OnNavigateComplete2}
    { Public declarations }
  end;

var
  Form3: TForm3;
  BroWser: TsWebBrowser;
  CurDispatch: IDispatch; { save the interface globally }

implementation

{$R *.dfm}

procedure TForm3.Bro_comp(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);{OnDocumentComplete}
begin
  if (pDisp = CurDispatch) then
  begin
    WebBrowserScreenShot(BroWser, ExtractFilePath(ParamStr(0)) + 'screen.jpg');
    sImage1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'screen.jpg');
     BroWser.Free; { ПОСЛЕ СОХРАНЕНИЯ СКРИНШОТА, И ЗАГРУЗКИ ЕГО В IMAGE1 
                           ПЫТАЮСЬ ФРИШНУТЬ БРАУЗЕР, И ТУТ ПРОГРАММА ЗАКРЫВАЕТСЯ }
    CurDispatch := nil; { clear the global variable }
  end;
end;

procedure TForm3.Bro_nav(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);{OnNavigateComplete2}
begin
  if CurDispatch = nil then
    CurDispatch := pDisp; { save for comparison }
end;

procedure TForm3.sSpeedButton1Click(Sender: TObject);
var
  URL: OleVariant;
begin
  { создаю браузер }
  URL := 'www.google.ru';
  BroWser := TsWebBrowser.Create(nil);
  TWinControl(BroWser).Parent := Form3;
  BroWser.Silent := True;
  BroWser.Left := 0;
  BroWser.Top := 0;
  BroWser.Width := 500;
  BroWser.Height := 350;
  BroWser.OnDocumentComplete := Bro_comp;
  BroWser.OnNavigateComplete2 := Bro_nav;
  BroWser.Navigate(URL);
  { ===================================== }
end;

procedure TForm3.WebBrowserScreenShot(const wb: TsWebBrowser; 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);
          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;