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

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

:: Меню ::

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

:: FAQ ::

:: Заметки ::

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

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

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

:: MVP ::

:: RSS ::

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


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

function GetBrowserSelection( WB: TWebBrowser ): string;
var
  Doc: Variant;
begin
   if WB.Document <> nil then
   begin
      Doc := WB.Document;
      try
         Result := Doc.Selection.createRange.Text
      finally
         Doc := Unassigned;
      end;
   end
   else
      Result := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( GetBrowserSelection( WebBrowser1 ) );
end;

Как получить все URLs фреймов в TWebBrowser?


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

procedure TForm1.Button1Click(Sender: TObject);
var 
  i: integer;
begin 
   Listbox1.Clear;
   if Webbrowser1.OleObject.Document.Frames.Length <> 0 then
   begin
      for i := 0 to Webbrowser1.OleObject.Document.Frames.Length-1 do
      begin
         Listbox1.Items.Add( Webbrowser1.OleObject.Document.Frames.item( i ).Document.URL );
      end;
   end;
end;

Как узнать цвет фона страницы, загруженной в TWebBrowser?


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

procedure TForm1.Button1Click(Sender: TObject);
begin 
   ShowMessage( WebBrowser1.OleObject.Document.bgColor );
end;

Как изменить цвет фона страницы, загруженной в TWebBrowser?


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

procedure TForm1.Button1Click(Sender: TObject);
begin 
   WebBrowser1.OleObject.Document.bgColor := '#FFFF00';
end;

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


uses
  {...,} MSHTML;

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

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Word;
  ImageWidth, ImageHeight: integer;
  ImageHref, ImageFileSize, ImageTextAlternative: string;
  Document: IHtmlDocument2;
begin
   for i := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
   begin
      Document := WebBrowser1.Document as IHtmlDocument2;
      ImageWidth := WebBrowser1.OleObject.Document.Images.Item( i ).Width;
      ImageHeight := WebBrowser1.OleObject.Document.Images.Item( i ).Height;
      ImageFileSize := ( Document.Images.Item( i, 0 ) as IHTMLImgElement ).FileSize;
      ImageHref := ( Document.Images.Item( i, 0 ) as IHTMLImgElement ).Href;
      ImageTextAlternative := ( Document.Images.Item( i, 0 ) as IHTMLImgElement ).alt;
      ListBox1.Items.Add( Format( '%s : %d x %d Pixels; %s Bytes; %s',
         [ImageHref, ImageWidth, ImageHeight, ImageFileSize, ImageTextAlternative] ) );
   end;
end;

Как прокручивать TWebBrowser своими кнопками?


// Прокрутка вверх
procedure TForm1.Button1Click(Sender: TObject);
begin
   WebBrowser1.OleObject.Document.ParentWindow.ScrollBy( 0, -100 );
end;

// Прокрутка вниз
procedure TForm1.Button2Click(Sender: TObject);
begin
   WebBrowser1.OleObject.Document.ParentWindow.ScrollBy( 0, +100 );
end;

// Прокрутка влево
procedure TForm1.Button3Click(Sender: TObject);
begin
   WebBrowser1.OleObject.Document.ParentWindow.ScrollBy( -100, 0 );
end;

// Прокрутка вправо
procedure TForm1.Button4Click(Sender: TObject);
begin
   WebBrowser1.OleObject.Document.ParentWindow.ScrollBy( +100, 0 );
end;

Как сохранить исходный код всех фреймов в TWebBrowser?


uses
  {...,} ActiveX;

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

function GetFrame( WB:TWebBrowser; FrameNo: Integer): IWebbrowser2;
var
  OleContainer: IOleContainer;
  enum: IEnumUnknown;
  unk: IUnknown;
  Fetched: PLongint;
begin
   while WB.ReadyState <> READYSTATE_COMPLETE do
      Application.ProcessMessages;
   if Assigned( WB.Document ) then
   begin
      Fetched := nil;
      OleContainer := WB.Document as IOleContainer;
      OleContainer.EnumObjects( OLECONTF_EMBEDDINGS, Enum );
      Enum.Skip( FrameNo );
      Enum.Next( 1, Unk, Fetched );
      Result := Unk as IWebbrowser2;
   end
   else
      Result := nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IpStream: IPersistStreamInit;
  AStream: TMemoryStream;
  iw: IWebbrowser2;
  i: integer;
  sl: TStringList;
begin
   for i := 0 to Webbrowser1.OleObject.Document.Frames.Length-1 do
   begin
      iw := GetFrame( WebBrowser1, i );
      AStream := TMemoryStream.Create;
      try
         IpStream := iw.document as IPersistStreamInit;
         if Succeeded( IpStream.Save( TStreamadapter.Create( AStream ), true ) ) then
         begin
            AStream.Seek( 0, 0 );
            sl := TStringList.Create;
            sl.LoadFromStream( AStream );
            sl.SaveToFile( 'C:\frame' + IntToStr( i ) + '.txt' );
            sl.Free;
         end;
      except
      end;
      AStream.Free;
   end;
end;

Как можно использовать событие OnDocumentComplete у TWebBrowser при наличии фреймов?


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

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
var
  CurWebrowser: IWebBrowser;
  TopWebBrowser: IWebBrowser;
  Document: OleVariant;
  WindowName: string;
begin
   CurWebrowser := pDisp as IWebBrowser;
   TopWebBrowser := ( Sender as TWebBrowser ).DefaultInterface;
   if CurWebrowser = TopWebBrowser then
      ShowMessage( 'Загрузка страницы закончена' )
   else
   begin
      Document := CurWebrowser.Document;
      WindowName := Document.ParentWindow.Name;
      ShowMessage( Format( 'Фрейм "%s" загружен', [WindowName] ) );
   end;
end;

Как работать со всеми ячейками таблицы на странице, загруженной в TWebBrowser?


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

procedure TForm1.Button1Click(Sender: TObject);
var
  i, j: integer;
  ovTable: OleVariant;
begin
   // Работаем с первой таблицей на странице
   ovTable := WebBrowser1.OleObject.Document.all.tags( 'TABLE' ).item( 0 );

   for i := 0 to ovTable.Rows.Length-1 do
   begin
      for j := 0 to ovTable.Rows.Item( i ).Cells.Length-1 do
      begin
         Memo1.Lines.Add( ovTable.Rows.Item( i ).Cells.Item( j ).InnerText );
      end;
   end;
end;

Как передать фокус TWebBrowser?


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

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

procedure TForm1.Button1Click(Sender: TObject);
begin
   with WebBrowser1 do
      if Document <> nil then
         with Application as IOleobject do
            DoVerb( OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect );
end;

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

procedure TForm1.Button1Click(Sender: TObject);
begin
   WebBrowser1.Navigate( 'http://decoding.dax.ru' );
   repeat
      Application.ProcessMessages;
   until WebBrowser1.ReadyState >= READYSTATE_COMPLETE;
   if WebBrowser1.Document <> nil then
      ( Webbrowser1.Document as IHTMLDocument2 ).ParentWindow.Focus;
end;

// Или немного иначе
procedure WB_SetFocus( WB: TWebbrowser );
begin
   ( WB.Document as IHTMLDocument2 ).ParentWindow.Focus;
end;

function WB_DocumentLoaded( WB: TWebbrowser ): boolean;
var
  iDoc: IHtmlDocument2;
begin
   Result := false;
   if Assigned( WB ) then
   begin
      if WB.Document <> nil then
      begin
         WB.ControlInterface.Document.QueryInterface( IHtmlDocument2, iDoc );
         Result := Assigned( iDoc );
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if WB_DocumentLoaded( WebBrowser1 ) then
      WB_SetFocus( WebBrowser1 );
end;

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