Detect when the active element in a TWebBrowser document changes

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;

Recommended topics

Hot tags