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

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

:: Меню ::

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

:: FAQ ::

:: Заметки ::

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

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

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

:: MVP ::

:: RSS ::

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


uses
  MSHTML;

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
      Listbox1.Items.Add(Webbrowser1.OleObject.Document.Frames.item(i).Document.URL);
  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, MSHTML;

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
    for j := 0 to ovTable.Rows.Item(i).Cells.Length-1 do
      Memo1.Lines.Add(ovTable.Rows.Item(i).Cells.Item(j).InnerText);
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;

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