Cynna封装的TDHTMLEvent类（TWebBrowser常用）

// ************* TDHTMLEvent class is placed in this separate unit ******************
// 1. File -> New -> Unit
// 2. Copy/Paste this code:

unit Unit2;

interface

uses Windows, Classes;

type
  TDHTMLEvent = class (TObject, IUnknown, IDispatch)
  private
      FRefCount: Integer;
      FOldEvent: IDispatch;
      FElementEvent: TNotifyEvent;
      // IUnknown
      function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
      function _AddRef: Integer; stdcall;
      function _Release: Integer; stdcall;
      // IDispatch
      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
    { Public declarations }
      function HookEventHandler(CallerHandler: TNotifyEvent): IDispatch;
      property ElementEvent: TNotifyEvent read FElementEvent write FElementEvent;
  end;

implementation

{ TDHTMLEvent }


function TDHTMLEvent._AddRef: Integer;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function TDHTMLEvent._Release: Integer;
begin
  Dec(FRefCount);
  Result := FRefCount;
end;

function TDHTMLEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
  if FOldEvent <> nil then
    Result := FOldEvent.GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs)
  else
    Result := E_NOTIMPL;
end;

function TDHTMLEvent.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  if FOldEvent <> nil then
    Result := FOldEvent.GetTypeInfo(Index, LocaleID, TypeInfo)
  else begin
    Pointer(TypeInfo) := nil;
    Result := E_NOTIMPL;
  end
end;

function TDHTMLEvent.GetTypeInfoCount(out Count: Integer): HResult;
begin
  if FOldEvent <> nil then
    Result := FOldEvent.GetTypeInfoCount(Count)
  else begin
    Count := 0;
    Result := S_OK;
  end;
end;

function TDHTMLEvent.QueryInterface(const IID: TGUID; out Obj): Integer;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

function TDHTMLEvent.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
  try
     if Assigned(FElementEvent) then FElementEvent(Self);
  finally
    if FOldEvent <> nil then
       Result := FOldEvent.Invoke(DispID, IID, LocaleID, Flags, Params,
                                  VarResult, ExcepInfo, ArgErr)
    else
       Result := E_NOTIMPL;
  end;
end;

function TDHTMLEvent.HookEventHandler(CallerHandler: TNotifyEvent): IDispatch;
begin
  FOldEvent:=nil;
  ElementEvent:=CallerHandler;
  Result:=Self;
end;


end.




//*********************    DEMO      *************************
// Principles from your last question are kept. This code is variation
// of existing code, modified to accomodate use of events.

uses Unit2; // Contains TDHTMLEvent

// ....

var
  Form1: TForm1;
  InputKeyPress: TDHTMLEvent;

// ....

procedure TForm1.FormCreate(Sender: TObject);
begin
  InputKeyPress:=TDHTMLEvent.Create;
end;

procedure SetOnChangeInputElement(Browser:TWebBrowser; ElementName: String;
                                  EventObject: TDHTMLEvent; EventHandler:TNotifyEvent);
var   WebDoc : IHTMLDocument2;
   pDispatch : IDISPATCH;
    elements : IHTMLElementCollection;
       Input : IHTMLInputElement;
begin
    OleCheck(Browser.Document.QueryInterface(IID_IHTMLDocument2, WebDoc));
    // grab all elements:
    elements := WebDoc.Get_all;
    // find first with the name ElementName:
    pDispatch := elements.item(ElementName, 0);
    // get it:
    OleCheck(pDispatch.QueryInterface(IID_IHTMLInputElement, Input));
    // now you can hook event handler to our object:
    OleVariant(Input).OnKeyDown:=EventObject.HookEventHandler(EventHandler);
end;

procedure TForm1.DHTMLElementEvent(Sender: TObject);
begin // This is triggered with each KeyDown event
  Panel1.Color:=RGB(Random(254), Random(254), Random(254));
end;

// DEMO:
// --------

procedure TForm1.Button1Click(Sender: TObject);
var site: String;
begin
  // Surf to EE:
  site:='http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20339253.html';
  WebBrowser1.Navigate(site);
  // Wait for page to fully load:
  while WebBrowser1.ReadyState<>READYSTATE_COMPLETE do begin
        Sleep(1);
        Application.ProcessMessages;
  end;
  // Hook it:
  SetOnChangeInputElement (WebBrowser1,
                           'keyWord',        // We are hooking event in INPUT field named "keyWord"
                           InputKeyPress,    // TDHTMLEvent object dedicated to this event
                           DHTMLElementEvent // Our own event handler that will get hooked by InputKeyPress
                          );
end;



Run it, and then type something in Search box. Panel1 will change color with each key press.