无法按下多个twebbrowser

时间:2014-01-07 05:08:30

标签: delphi twebbrowser

我现在已经在几个地方看到了下面的msghandler代码作为无法在twebbrowser中按 Enter 的解决方案。只要您只处理一个twebbrowser,此解决方案就可以正常工作。我在这里提供了一个完整的单元供讨论。如果您使用两个twebbrowser并将其中一个作为“活动”浏览器(请参阅代码)并将它们分别导航到某个站点,例如具有用户名,密码和按钮的站点,则可以在“活动”浏览器中输入数据并按< kbd>成功输入。如果您尝试使用非“活动”浏览器,您不仅可以按 Enter ,而且选项卡的使用也会失败。无论您首先按 Enter 哪个浏览器都会继续工作,因此它似乎与浏览器的创建顺序无关。

如何让我的其他浏览器运行?

unit Main_Form;

interface

uses
    Winapi.Windows, Winapi.Messages, Vcl.Controls, Vcl.Forms,
    ActiveX, Vcl.OleCtrls, SHDocVw, System.Classes, Vcl.StdCtrls;

type
    TForm1 = class(TForm)
        NavigateBrowsers: TButton;
        WebBrowser1: TWebBrowser;
        WebBrowser2: TWebBrowser;
        MakeBrowser1Active: TButton;
        MakeBrowser2Active: TButton;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure FormDeactivate(Sender: TObject);
        procedure NavigateBrowsersClick(Sender: TObject);
        procedure MakeBrowser1ActiveClick(Sender: TObject);
        procedure MakeBrowser2ActiveClick(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
         procedure MsgHandler(var Msg: TMsg; var Handled: Boolean);
      end;

var
  Form1: TForm1;
  ActiveBrowser: TWebBrowser;
  FOleInPlaceActiveObject: IOleInPlaceActiveObject;
  SaveMessageHandler: TMessageEvent;

implementation

{$R *.dfm}

procedure TForm1.MakeBrowser1ActiveClick(Sender: TObject);
begin
  ActiveBrowser := WebBrowser1;
end;

procedure TForm1.MakeBrowser2ActiveClick(Sender: TObject);
begin
  ActiveBrowser := WebBrowser2;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Application.OnMessage := SaveMessageHandler;
  FOleInPlaceActiveObject := nil;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Handle messages
  SaveMessageHandler := Application.OnMessage;
  Application.OnMessage := MsgHandler;
end;

procedure TForm1.FormDeactivate(Sender: TObject);
begin
  Application.OnMessage := SaveMessageHandler;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FOleInPlaceActiveObject := nil;
end;

procedure TForm1.NavigateBrowsersClick(Sender: TObject);
begin
  WebBrowser1.Navigate(''); //supply own
  WebBrowser2.Navigate(''); //supply own
end;

procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
const
  StdKeys = [VK_BACK, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT];
var
  IOIPAO: IOleInPlaceActiveObject;
  Dispatch: IDispatch;
begin
  //Exit if webbrowser object is nil
  if ActiveBrowser = nil then
    begin
      Handled := False;
      Exit;
    end;
  Handled:=(IsDialogMessage(ActiveBrowser.Handle, Msg) = True);
  if (Handled) and (not ActiveBrowser.Busy) then
    begin
      if FOleInPlaceActiveObject = nil then
        begin
          Dispatch := ActiveBrowser.Application;
          if Dispatch <>nil then
            begin
              Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
              if iOIPAO <>nil then
                FOleInPlaceActiveObject := iOIPAO;
            end;
        end;
        if FOleInPlaceActiveObject <>nil then
          if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
            (Msg.wParam in StdKeys) then
              //nothing - do not pass on StdKeys
          else
            FOleInPlaceActiveObject.TranslateAccelerator(Msg);
    end;
end;

initialization
OleInitialize(nil);

finalization
OleUninitialize;

end.

2 个答案:

答案 0 :(得分:1)

我遇到了和你一样的问题而且我使用了类似的消息处理程序,并不真正需要FOleInPlaceActiveObject

procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
const
  StdKeys = [VK_BACK, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT];
var
  IOIPAO: IOleInPlaceActiveObject;

begin
 try  
  if Assigned(ActiveBrowser) then
  begin
   Handled:=(IsDialogMessage(ActiveBrowser.Handle, Msg) = True);
   if Handled then
    begin
     if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and (Msg.wParam in StdKeys) then
      begin
       //nothing  -  do not pass on Backspace, Left, Right, Up, Down arrows
      end
     else
      begin
       IOIPAO := (ActiveBrowser.Application as IOleInPlaceActiveObject);
       if Assigned(IOIPAO)then
        IOIPAO.TranslateAccelerator(Msg)
      end;               
    end;
  end;
 except
  Handled := False;
 end;    
end;

答案 1 :(得分:0)

经过几天的搜索,看来我找到的东西在我发布问题的同一天起作用了。去搞清楚!为了每个人的利益,这是有效的。

当用户更改选项卡或创建新选项卡时,我所要做的就是将浏览器指定为活动控件。在pagecontrolchange过程中进行计数检查的原因是为了防止在启动时初始选项卡创建时使列表索引超出范围。我意识到我可能需要将我的ObjectLists更改为Generics,;)

procedure TForm1.PageControl1Change(Sender: TObject);
    begin
      if PageControl1.PageCount = MyBrowsersObjectList.Count then // Not adding a page
        begin
          ActiveBrowser := MyBrowsersObjectList[PageControl1.ActivePageIndex] as TWebBrowser;
          ActiveControl := ActiveBrowser;
        end;
    end;

procedure TForm1.CreateBrowserTab(APage: TAdvOfficePage; NavigateTo: String);
    begin
      APage.Caption := 'Loading...';
      ActiveBrowser := TWebBrowser.Create(nil);
      MyBrowsersObjectList.Add(ActiveBrowser);
      TControl(ActiveBrowser).Parent := APage;
      ActiveBrowser.Align := alClient;
      ActiveBrowser.RegisterAsBrowser := True;
      ActiveBrowser.Tag := BrowserTabs.ActivePageIndex;
      ActiveBrowser.Navigate(NavigateTo);
      ActiveControl := ActiveBrowser;
    end;