當TWebBrowser文檔中的活動元素髮生變化時檢測到

Question

是否有任何事件可以檢測到網頁上活動元素的更改時間？例如，當用戶聚焦編輯框時。

我知道我可以檢查計時器中的活動元素，但如果可能的話，我寧願避免這種情況。

Answer 1

這不是 - 完全 - 你的問題的完整答案，但希望能爲你帶來最大的方式。

（對於誰通過一個類似的q來到這裏未來的讀者：

• 假設你有一個類型庫進口單位像SHDOCVW，MSHTML自動化/ COM服務器或一個MS Word的有時， Delphi的類型庫導入器將事件支持添加到它生成的Delphi TObject後代包裝中，例如TWebBrowser，OnNavigateComplete等事件。其他時候，它不能或不會生成Delphi包裝類，但仍可以附加到服務器通過多種方法之一對事件進行處理，比如通過創建一個如下所示的事件對象，它在Delphi代碼中連接服務器對象的事件和事件處理程序。

• 處理接口事件基本上涉及到定義一個Delphi類，它實現了一個IDispatch接口，然後將該接口連接到您希望通知其事件的Ole或COM對象。然後，當Ole/COM中的事件發生在接口「後面」時，它會像調用它的方式一樣調用您的IDispatch。你如何處理事件通知完全取決於你;下面的代碼將它們傳遞給TForm1的一個方法。 ）

下的EventObject緊密基於一個由TeamB的德博拉·佩特（她有她的關於自動化網站使用Delphi的一個很好的部分在Borland NGS發表在2003年11月 - http://www.djpate.freeserve.co.uk/Automation.htm）。該對象非常通用，因爲它不限於處理任何特定Ole/COM對象的事件。

// 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; 

請注意TForm1.AnEvent中的註釋。如果您檢查cbSinkAll複選框 並在包含多個INPUT框的頁面上運行代碼，您會注意到AnEvent在輸入相同的 INPUT框時觸發了幾次，每次都有不同的Doc2.ActiveElement值。我不確定這是爲什麼，但這確實意味着比較Doc2.ActiveElement屬性的當前值 與以前的值無法有效檢測到重點在Html頁面上的更改 。然而，比較元素的屬性，例如它的名字或ID似乎提供了可靠的檢查。

兩個注意事項：

• 在黛博拉·佩特的原代碼，她節省了以前的事件處理程序（如果有的話）的OleVariant，以便它可以在以後恢復。
• 如果要連續連接幾個Html頁面的事件，則應該釋放兩者之間的EventObject。

[從MSHTML.Pas摘錄]

HTMLDocumentEvents = dispinterface 
    ['{3050F260-98B5-11CF-BB82-00AA00BDCE0B}'] 
    function onhelp: WordBool; dispid -2147418102; 
    [...] 
    procedure onbeforeeditfocus; dispid 1027; 
    end;