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

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как проверить активность команды Copy в TWebBrowser?

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

procedure TForm1.Button1Click(Sender: TObject);
begin
  if WebBrowser1.OleObject.Document.queryCommandEnabled('Copy') then
    ShowMessage('Команда `Copy` активна');
end;


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

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

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to WebBrowser1.OleObject.Document.Frames.Length-1 do
    if WebBrowser1.OleObject.Document.Frames.Item(i).Document.queryCommandEnabled('Copy') then
      ShowMessage('Команда `Copy` активна во фрейме №' + IntToStr(i));
end;


Как выполнить команды Copy, Cut, Paste, Delete в TWebBrowser?

uses
  ActiveX;

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

// Copy - копировать выделенное
procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER);
  except
  end;
end;

// Cut - вырезать выделенное
procedure TForm1.Button2Click(Sender: TObject);
begin
  try
    WebBrowser1.ExecWB(OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER);
  except
  end;
end;

// Paste - вставить на место выделенного
procedure TForm1.Button3Click(Sender: TObject);
begin
  try
    WebBrowser1.ExecWB(OLECMDID_PASTE, OLECMDEXECOPT_PROMPTUSER);
  except
  end;
end;

// Delete - удалить выделенное
procedure TForm1.Button4Click(Sender: TObject);
begin
  try
    WebBrowser1.ExecWB(OLECMDID_DELETE, OLECMDEXECOPT_PROMPTUSER);
  except
  end;
end;

initialization 
  OleInitialize(nil); 

finalization 
  OleUninitialize;


Как нажать кнопку в TWebBrowser?

// Нажимаем на первую кнопку в первой форме
procedure TForm1.Button1Click(Sender: TObject);
begin
  WebBrowser1.OleObject.Document.Forms.Item(0).Elements.Item(0).Click;
end;


Как нажать кнопку в TWebBrowser, когда в окне есть несколько кнопок?

// Нажимаем кнопку в первой форме
procedure TForm1.Button1Click(Sender: TObject);
var
  ovElements: OleVariant;
  i: Integer;
begin
  ovElements := WebBrowser1.OleObject.Document.Forms.Item(0).Elements;
  for i := 0 to ovElements.Length-1 do
    if (AnsiUpperCase(ovElements.Item(i).tagName) = 'INPUT') then
      if (AnsiUpperCase(ovElements.Item(i).type) = 'SUBMIT') or
         (AnsiUpperCase(ovElements.Item(i).type) = 'BUTTON') then
        if (ovElements.item(i).Value = 'Some text') then
          ovElements.Item(i).Click;
end;


Как выбрать RadioButton в TWebBrowser?

// Выбраем RadioButton в первой форме
procedure TForm1.Button1Click(Sender: TObject);
var
  ovElements: OleVariant;
  i: Integer;
begin
  ovElements := WebBrowser1.OleObject.Document.Forms.Item(0).Elements;
  for i := 0 to ovElements.Length-1 do
    if (AnsiUpperCase(ovElements.Item(i).tagName) = 'INPUT') then
      if (AnsiUpperCase(ovElements.Item(i).type) = 'RADIO') then
        if (ovElements.item(i).Value = 'Some text') then
          ovElements.Item(i).Click;
end;


Как включить/выключить CheckBox в TWebBrowser?

// Включаем/выключаем CheckBox в первой форме
procedure TForm1.Button1Click(Sender: TObject);
var
  ovElements: OleVariant;
  i: Integer;
begin
  ovElements := WebBrowser1.OleObject.Document.Forms.Item(0).Elements;
  for i := 0 to ovElements.Length-1 do
    if (AnsiUpperCase(ovElements.Item(i).tagName) = 'INPUT') then
      if (AnsiUpperCase(ovElements.Item(i).type) = 'CHECKBOX') then
        if (ovElements.item(i).Value = 'Some text') then
          ovElements.Item(i).Click;
end;


Как распечатать страницу из TWebBrowser?

// Способ первый
procedure WB_ShowPrintDialog(WB: TWebbrowser; ShowPrintDialog: Boolean = True);
var
  A, B: OleVariant;
  UserAction: Cardinal;
begin
  if ShowPrintDialog then
    UserAction := OLECMDEXECOPT_PROMPTUSER
  else
    UserAction := OLECMDEXECOPT_DONTPROMPTUSER;

  try
    WB.ExecWB(OLECMDID_PRINT, UserAction, A, B);
  except
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_ShowPrintDialog(WebBrowser1);
  // WB_ShowPrintDialog(WebBrowser1, False);
end;

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

procedure WB_ShowPrintDialogEx(WB: TWebBrowser; ShowPrintDialog: Boolean = True);
var
  OleCommandTarget: IOleCommandTarget;
  Command: TOleCmd;
  Success: HResult;
begin
  WB.Document.QueryInterface(IOleCommandTarget, OleCommandTarget);
  Command.cmdID := OLECMDID_PRINT;

  if OleCommandTarget.QueryStatus(nil, 1, @Command, nil) <> S_OK then
  begin
    ShowMessage('Nothing to print');
    Exit;
  end;

  if (Command.cmdf and OLECMDF_ENABLED) <> 0 then
  begin
    if ShowPrintDialog then
      Success := OleCommandTarget.Exec(nil, OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, EmptyParam, EmptyParam)
    else
      Success := OleCommandTarget.Exec(nil, OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, EmptyParam, EmptyParam);

    case Success of
      S_OK: ;
      OLECMDERR_E_CANCELED: ShowMessage('Canceled by User');
    else
      ShowMessage( 'Error While Printing' );
    end;
  end
  else
    ShowMessage('Printing not possible');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WB_ShowPrintDialogEx(WebBrowser1);
  // WB_ShowPrintDialogEx(WebBrowser1, False);
end;


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

uses
  MSHTML;

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
  case WB_DocumentLoaded(WebBrowser1) of
    True: ShowMessage('Документ загружен');
    False: ShowMessage('Документ не загружен');
  end;
end;


Как перевести TWebBrowser (и IE) в режим автономной работы или обратно?

uses
  WinInet;

procedure SetGlobalOffline(Value: Boolean);
const
  INTERNET_STATE_DISCONNECTED_BY_USER = $10;
  ISO_FORCE_DISCONNECTED = $1;
  INTERNET_STATE_CONNECTED = $1;
var
  ci: TInternetConnectedInfo;
  dwSize: DWORD;
begin
  dwSize := SizeOf(ci);
  if Value then
  begin
    ci.dwConnectedState := INTERNET_STATE_DISCONNECTED_BY_USER;
    ci.dwFlags := ISO_FORCE_DISCONNECTED;
  end
  else
  begin
    ci.dwFlags := 0;
    ci.dwConnectedState := INTERNET_STATE_CONNECTED;
  end;
  InternetSetOption(nil, INTERNET_OPTION_CONNECTED_STATE, @ci, dwSize);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetGlobalOffline(True); // Включить автономный режим
  // SetGlobalOffline(False); // Отключить автономный режим
end;

// Подобного результата можно добиться отредактировав реестр по адресу
// HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\GlobalUserOffline

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