Программирование на Delphi

FAQ VCL
Компоненты\WebBrowser

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Как загрузить строковые данные в WebBrowser не прибегая к открытию файла?


// Способ первый
uses 
  {...,} ActiveX;

procedure WB_LoadHTML( WebBrowser: TWebBrowser; HTMLCode: string );
var
  sl: TStringList;
  ms: TMemoryStream;  
begin  
   WebBrowser.Navigate( 'about:blank' );
   while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
      Application.ProcessMessages;

   if Assigned( WebBrowser.Document ) then
   begin
      sl := TStringList.Create;
      try
         ms := TMemoryStream.Create;
         try
            sl.Text := HTMLCode;
            sl.SaveToStream( ms );
            ms.Seek( 0, 0 );
            ( WebBrowser.Document as IPersistStreamInit ).Load( TStreamAdapter.Create( ms ) );
         finally
            ms.Free;
         end;
      finally
         sl.Free;
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   WB_LoadHTML( WebBrowser1, 'Ваша строка' );
end;

// Способ второй
uses 
  {...,} MSHTML, ActiveX;

procedure TextToWebBrowser( WB: TWebBrowser; Text: string );
var
  Document: IHTMLDocument2;
  V: OleVariant;
begin
   if WB.Document = nil then
      WB.Navigate( 'about:blank' );
   while WB.Document = nil do
      Application.ProcessMessages;
   Document := WB.Document as IHtmlDocument2;
   V := VarArrayCreate( [0, 0], varVariant );
   V[0] := Text;
   Document.Write( PSafeArray( TVarData( v ).VArray ) );
   Document.Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   TextToWebBrowser( WebBrowser1, 'Ваша строка' );
end;

Как сохранить веб страничку в BitMap?


uses 
  {...,} ActiveX;

procedure TForm1.FormCreate(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
end;

procedure WebBrowserPrintScreen( Browser: TWebBrowser; Path: string );
var
  bm: TBitmap;
  ViewObject: IViewObject;
  SRect: TRect;
begin
   if Browser.Document <> nil then
   try
      Browser.Document.QueryInterface( IViewObject, ViewObject );
      if ViewObject <> nil then
      try
         bm := TBitmap.Create;
         bm.Width := Browser.Width;
         bm.Height := Browser.Height;
         SRect := Rect( 0, 0, bm.Width, bm.Height );
         ViewObject.Draw( DVASPECT_CONTENT, 1, nil, nil, Browser.Handle,
                          bm.Canvas.Handle, @SRect, nil, nil, 0 );
         bm.SaveToFile( Path );
      finally
         bm.Free;
         ViewObject._Release;
      end;
   except
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   WebBrowserPrintScreen( WebBrowser1, 'c:\Screen.bmp' );
end;

Как получить все линки в TWebBrowser?


procedure TForm1.FormCreate(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
   for i := 0 to Webbrowser1.OleObject.Document.links.Length-1 do
      Memo1.Lines.Add( WebBrowser1.OleObject.Document.Links.Item( i ) );
end;

Как при открытии ссылки не открывать новое окно, а остаться в старом?


procedure TForm1.WebBrowser1NewWindow3(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool; dwFlags: Cardinal; const bstrUrlContext,
  bstrUrl: WideString);
begin
   Cancel := True;
   WebBrowser1.Navigate(bstrUrl);
end;

Как скрыть/показать скроллбары в TWebBrowser?


procedure TForm1.FormCreate(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
end;

// Скрыть скроллбары
procedure TForm1.Button1Click(Sender: TObject);
begin
   WebBrowser1.OleObject.Document.Body.Style.OverflowX := 'hidden';
   WebBrowser1.OleObject.Document.Body.Style.OverflowY := 'hidden';
end;

// Показать скроллбары
procedure TForm1.Button2Click(Sender: TObject);
begin
   WebBrowser1.OleObject.Document.Body.Style.OverflowX := '';
   WebBrowser1.OleObject.Document.Body.Style.OverflowY := '';
end;

Как заменить все рисунки в TWebBrowser?


procedure TForm1.FormCreate(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Word;
begin
   for i := 0 to WebBrowser1.OleObject.Document.Images.Length-1 do
      WebBrowser1.OleObject.Document.Images.Item( i ).Src := 'C:\MyImage.gif';
end;

Как использовать протокол about: в TWebBrowser?


// Протокол "about:" позволяет загружать в браузер HTML строку.

procedure LoadHTMLString( WebBrowser: TWebBrowser; sHTML: string );
var
  Flags, TargetFrameName, PostData, Headers: OleVariant;
begin
   WebBrowser.Navigate( 'about:' + sHTML, Flags, TargetFrameName, PostData, Headers );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   LoadHTMLString( WebBrowser1, '<HTML><BODY><CENTER><H2>DeCoding</H2></CENTER></BODY></HTML>' );
end;

Как получить текст HTML документа из TWebBrowser?


// Способ первый
uses
  {...,} MSHTML;

procedure TForm1.FormCreate(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Document: IHTMLDocument2;
begin
   Document := WebBrowser1.Document as IHtmlDocument2;
   if Document <>  nil then
      Memo1.Text := ( Document.all.Item( NULL, 0 ) as IHTMLElement ).OuterHTML;
end;

// Способ второй
uses
  {...,} ActiveX;

procedure TForm1.FormCreate(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
end;

function WB_GetHTMLCode( WebBrowser: TWebBrowser; ACode: TStrings ): Boolean;
var
  ps: IPersistStreamInit;
  ss: TStringStream;
  sa: IStream;
  s: string;
begin
   ps := WebBrowser.Document as IPersistStreamInit;
   s := '';
   ss := TStringStream.Create( s );
   try
      sa := TStreamAdapter.Create( ss, soReference ) as IStream;
      Result := Succeeded( ps.Save( sa, true ) );
      if Result then ACode.Add( ss.Datastring );
   finally
      ss.Free;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   WB_GetHTMLCode( WebBrowser1, Memo1.Lines );
end;

// Способ третий
uses
  {...,} MSHTML;

procedure TForm1.Button1Click(Sender: TObject);
var
  Doc: IHTMLDocument2;
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
   while WebBrowser1.ReadyState < READYSTATE_COMPLETE do
      Application.ProcessMessages;
   Doc := WebBrowser1.Document as IHTMLDocument2;
   Memo1.Text := Doc.body.innerHTML;
end;

Как получить текст HTML документа из TWebBrowser без тегов?


uses
  {...,} MSHTML, ActiveX;

procedure TForm1.FormCreate(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
end;

procedure GetHtmlCode( WebBrowser: TWebBrowser; FileName: string );
var
  htmlDoc: IHtmlDocument2;
  PersistFile: IPersistFile;
begin
   htmlDoc := WebBrowser.document as IHtmlDocument2;
   PersistFile := HTMLDoc as IPersistFile;
   PersistFile.Save( StringToOleStr( FileName ), true );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   GetHtmlCode( WebBrowser1, 'C:\HTMLDoc.txt' );
end;

Как поменять цвет скроллбаров в TWebBrowser?


procedure TForm1.Button1Click(Sender: TObject);
begin
   with WebBrowser1 do
   begin
      OleObject.document.body.Style.scrollbarArrowColor := '#0099FF';
      OleObject.document.body.Style.scrollbar3DLIGHTCOLOR := '#FFFFFF';
      OleObject.document.body.Style.scrollbarDarkShadowColor := '#0099FF';
      OleObject.document.body.Style.scrollbarFaceColor := '#99CCFF';
      OleObject.document.body.Style.scrollbarHighlightColor := '#0099FF';
      OleObject.Document.body.Style.scrollbarShadowColor := '#0099FF';
      OleObject.Document.body.Style.scrollbarTrackColor := '#FFFFFF';
      OleObject.Document.body.Style.scrollbarBaseColor := '#FFFFFF';
   end;
end;

При использовании материала - ссылка на сайт обязательна