Detect when the active element in a TWebBrowser document changes

前端 未结 1 1975
一生所求
一生所求 2020-12-01 15:00

Is there any event I can hook into to detect when the active element on a web page changes? For example, when a the user focuses an edit box.

I know I could check th

相关标签:
1条回答
  • 2020-12-01 16:05

    This isn't - quite - a complete answer to your q, but hopefully will get you most of the way there.

    (For future readers who arrive here via a similar q:

    • Suppose you have an type library import unit for an automation/Com server like SHDocVw, MSHTML or the one for MS Word. Sometimes, Delphi's type library importer adds event support to the Delphi TObject-descendant wrapper it generates, like the events for TWebBrowser, OnNavigateComplete, etc. Other times it can't or won't generate a Delphi wrapper class, but you can still attach to the server objects events by one of a number of methods, such as by creating an EventObject like the one below, which connects between a server object's events and an event-handler in your Delphi code.

    • Handling interface events basically involves defining a Delphi class which implements an IDispatch interface and then connecting that interface to the Ole or COM object whose event(s) you want to be notified about. Then, when events occur in the Ole/COM "behind" the interface it calls your IDispatch the same way you call its one. What you do with the event notifications is entirely up to you; the code below passes them on to a method of TForm1. )

    The EventObject below is closely based on a one posted in the Borland NGs in November 2003 by Deborah Pate of TeamB (she has a really good section on her website about automation using Delphi - http://www.djpate.freeserve.co.uk/Automation.htm). The object is quite generic, in that it's not limited to handling the events of any particular Ole/COM object.

    //  The following code is intended to illustrate methods of detecting that the
    //  active element in an Html page has changed.  See the comments in the AnEvent
    //  procedure about how exactly to detect such a change.
    //
    //  The code also illustrates how to handle a single event, e.g. onbeforeeditfocus
    //  of an Events objects such as HtmlDocumentEvents or HtmlDocumentEvents2 (see MSHTML.Pas)
    //  or all the events the events interface contains.
    
    
    type
    
      TInvokeEvent = procedure(Sender : TObject; DispIP : Integer) of Object;
    
      TEventObject = class(TInterfacedObject, IDispatch)
      private
        FOnEvent: TInvokeEvent;
        FSinkAllEvents : Boolean;
      protected
        function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
        function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
        function GetIDsOfNames(const IID: TGUID; Names: Pointer;
          NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
        function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
          Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
      public
        constructor Create(const AnEvent : TInvokeEvent; SinkAll : Boolean);
        property OnEvent: TInvokeEvent read FOnEvent write FOnEvent;
        property SinkAllEvents: Boolean read FSinkAllEvents;
      end;
    
    type
      TForm1 = class(TForm)
      [ ... ]
      private
        { Private declarations }
        procedure AnEvent(Sender : TObject; DispID : Integer);
        procedure AnotherEvent(Sender : TObject; DispID : Integer);
      public
        { Public declarations }
        Doc : IHtmlDocument3;
        DocEvent,
        DocEvent2: OleVariant;
        Cookie : Longint;
        CPC : IConnectionPointContainer;
        Sink : IConnectionPoint;
        PrvActiveElement : IHTMLElement;
        Events : Integer;
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    constructor TEventObject.Create(const AnEvent: TInvokeEvent; SinkAll : Boolean);
    begin
      inherited Create;
      FOnEvent := AnEvent;
      FSinkAllEvents := SinkAll;
    end;
    
    function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
    begin
      Result := E_NOTIMPL;
    end;
    
    function TEventObject.GetTypeInfo(Index, LocaleID: Integer;
      out TypeInfo): HResult;
    begin
      Result := E_NOTIMPL;
    end;
    
    function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
    begin
      Result := E_NOTIMPL;
    end;
    
    function TEventObject.Invoke(DispID: Integer; const IID: TGUID;
      LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
      ArgErr: Pointer): HResult;
    begin
      if SinkAllEvents then begin
        if Assigned(FOnEvent) then
          FOnEvent(Self, DispID);
        Result := S_OK;
      end
      else begin
        if (Dispid = DISPID_VALUE) then begin
          if Assigned(FOnEvent) then
            FOnEvent(Self, DispID);
          Result := S_OK;
        end
        else Result := E_NOTIMPL;
      end;
    end;
    
    procedure TForm1.AnEvent(Sender : TObject; DispID : Integer);
    var
      Doc2 : IHTMLDocument2;
      E : IHTMLElement;
    begin
      Inc(Events);
      Doc.QueryInterface(IHTMLDocument2, Doc2);
      E := Doc2.activeElement;
    
      //  NB: When an <INPUT> text edit is receiving focus, the following code is triggered twice
      //  or more with different values of Pointer(Doc2.activeElement).  So, "(E <> PrvActiveElement)"
      //  doesn't seem a very effective test that the active element has changed.  However,
      //  testing E's Name, ID, etc should provide a useful test.
    
      if (E <> Nil) and (E <> PrvActiveElement) and E.isTextEdit then begin
        if PrvActiveElement <> Nil then
          PrvActiveElement := E;
          Caption := Format('Something happened: Element Tagname: %s, Name: %s, %d, %d, %p',
            [E.TagName, E.GetAttribute('Name', 0), DispID, Events, Pointer(Doc2.activeElement)]);
      end;
    end;
    
    procedure TForm1.AnotherEvent(Sender : TObject; DispID : Integer);
    begin
      Caption := Format('Something else happened: %d', [DispID]);
    end;
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      Memo1.Lines.LoadFromFile('D:\aaad7\html\postdata.htm');
    end;
    
    procedure TForm1.btnLoadClick(Sender: TObject);
    var
      V : OleVariant;
      Doc2 : IHtmlDocument2;
    begin
      WebBrowser1.Navigate('about:blank');
      Doc := WebBrowser1.Document as IHTMLDocument3;
      Doc.QueryInterface(IHTMLDocument2, Doc2);
      V := VarArrayCreate([0, 0], varVariant);
      V[0] := Memo1.Lines.Text;
      try
        Doc2.Write(PSafeArray(TVarData(v).VArray));
      finally
        Doc2.Close;
      end;
    
      DocEvent := TEventObject.Create(Self.AnEvent, cbSinkAll.Checked) as IDispatch;
    
      if cbsinkAll.Checked then begin
        CPC := Doc2 as IConnectionPointContainer;
        Assert(CPC <> Nil);
        OleCheck(CPC.FindConnectionPoint(HTMLDocumentEvents, Sink));
        OleCheck((Sink as IConnectionPoint).Advise(DocEvent, Cookie));
      end
      else
        Doc.onbeforeeditfocus := DocEvent;
    end;
    

    Note the comments in TForm1.AnEvent. If you check the cbSinkAll checkbox and run the code on a page with a number of INPUT boxes, you'll notice that AnEvent fires several times on entry to the same INPUT box, with a different value of Doc2.ActiveElement each time. I'm not sure why that is,but it does mean that comparing the current value of the Doc2.ActiveElement property with a previous value isn't effective to detect a change in focus on the Html page. However, comparing an attribute of the element, e.g. its Name or ID, does seem to provide a reliable check.

    Two caveats:

    • In Deborah Pate's original code, she saves the previous event handler (if any) to an OleVariant so that it could be reinstated later.
    • If you want to connect to the events of several Html pages in succession, you should free the EventObject in between.

    [Extract from MSHTML.Pas]

      HTMLDocumentEvents = dispinterface
        ['{3050F260-98B5-11CF-BB82-00AA00BDCE0B}']
        function  onhelp: WordBool; dispid -2147418102;
        [...]
        procedure onbeforeeditfocus; dispid 1027;
      end;
    
    0 讨论(0)
提交回复
热议问题