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;

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

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