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

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

:: Меню ::

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

:: FAQ ::

:: Заметки ::

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

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

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

:: MVP ::

:: RSS ::

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


// Способ первый
uses 
  ActiveX, MSHTML;

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, MSHTML;

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, MSHTML;

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;

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