K210.ORG

 

uses

  MSHTML;

type

  THTMLEventNotifyEvent =

    procedure(EventObject: IHTMLEventObj; EventType: string) of object;

 

  THTMLEvent = class(TInterfacedObject, IDispatch)

  private

    FDocument: IHTMLDocument2;

    FOnEvent: THTMLEventNotifyEvent;

    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;

    procedure DoEvent;

  public

    constructor Create(Document: IHTMLDocument2);

    property OnEvent: THTMLEventNotifyEvent

      read FOnEvent

      write FOnEvent;

  end;

 

function THTMLEvent.GetTypeInfoCount(out Count: Integer): HResult;

begin

  Result := E_NOTIMPL

end;

 

function THTMLEvent.GetTypeInfo(Index, LocaleID: Integer;

  out TypeInfo): HResult;

begin

  Result := E_NOTIMPL

end;

 

function THTMLEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer;

  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;

begin

  Result := E_NOTIMPL

end;

 

function THTMLEvent.Invoke(DispID: Integer; const IID: TGUID;

  LocaleID: Integer; Flags: Word; var Params; VarResult,

  ExcepInfo, ArgErr: Pointer): HResult;

begin

  DoEvent;

  Result := S_OK;

end;

 

constructor THTMLEvent.Create(Document: IHTMLDocument2);

begin

  inherited Create;

  FDocument := Document;

  FOnEvent := nil;

end;

 

procedure THTMLEvent.DoEvent;

var

  EventObj: IHTMLEventObj;

  EventType: string;

begin

  if Assigned(FOnEvent) then

  begin

    EventObj := nil;

    EventType := '';

    if Assigned(FDocument) and Assigned(FDocument.parentWindow) then

    begin

      EventObj := FDocument.parentWindow.event;

      if Assigned(EventObj) then

        EventType := EventObj.type_;

    end;

 

    FOnEvent(EventObj, EventType);

  end;

end;

 

//The following code demonstrates how to use the class:

 

procedure TForm1.Button1Click(Sender: TObject);

var

  Doc: IHTMLDocument2;

  EventHandler: THTMLEvent;

begin

// Load Document in Browser

  WebBrowser1.Navigate('http://www.nineberry.de');

  repeat

    application.ProcessMessages;

  until WebBrowser1.ReadyState >= READYSTATE_COMPLETE;

 

// Create our Object, that will handle events

  Doc := WebBrowser1.Document as IHTMLDocument2;

  EventHandler := THTMLEvent.Create(Doc);

  EventHandler.OnEvent := KeyEvent;

 

// Assign Events

  Doc.onkeydown := EventHandler as IDispatch;

  Doc.onkeypress := EventHandler as IDispatch;

  Doc.onkeyup := EventHandler as IDispatch;

end;

 

procedure TForm1.KeyEvent(EventObject: IHTMLEventObj;

  EventType: string);

begin

// Handle Event, show type of event and keycode

  Memo1.Lines.Add('Type of Event: ' + EventType);

  Memo1.Lines.Add('Keycode of Key: ' +

    IntToStr(EventObject.keyCode));

  Memo1.Lines.Add('Char: ' + WideChar(EventObject.keyCode));

end;