我们可以通过控件 EmbeddedWB_D5-D2010_Version_14.69.1 来响应html事件,还可以自定义html响应哪些html元素。
控件下载 点击下载
里面有demos文件夹大家可以看看delphi代码实例。
EmbeddedWB_D5-D2010_Version_14.69.1\Demos\EmbeddedWB Demos\15 - THTMLListener_Demo
关键方法:HtmlListener1HandlersOnClickHandle
这里贴出这个demo的代码
unit uMain; interface uses Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, EwbBehaviorsComp, EwbEventsComp, EwbEvents, OleCtrls, SHDocVw_EWB, MSHTML_EWB, EwbCore, EmbeddedWB, StdCtrls, ComObj, ActiveX, ExtCtrls; type TForm1 = class(TForm) EmbeddedWB1: TEmbeddedWB; Panel1: TPanel; btnEnableDisable: TButton; lblClickedOnElement: TLabel; lblElementUndertheMouse: TLabel; HtmlListener1: THtmlListener; procedure HtmlListener1HandlersOnClickHandle(Sender: TObject; Event: IHTMLEventObj); procedure FormCreate(Sender: TObject); procedure HtmlListener1HandlersOnMouseMoveHandle(Sender: TObject; Event: IHTMLEventObj); procedure EmbeddedWB1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); procedure btnEnableDisableClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure EmbeddedWB1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); private { Private declarations } HubLinksList: TInterfaceList; FEventsEnabled: Boolean; HubLink: IHubLink; procedure DisconnectHtmlListeners; procedure ConnectHtmlListeners; procedure ConnectHtmlListener(ASender: TObject; Doc: IHTMLDocument2); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin FEventsEnabled := True; HubLinksList := TInterfaceList.Create; EmbeddedWB1.Navigate(‘www.google.com‘); end; procedure TForm1.HtmlListener1HandlersOnClickHandle(Sender: TObject; Event: IHTMLEventObj); begin lblClickedOnElement.Caption := Format(‘Clicked on Element with Tag: [%s]‘, [Event.srcElement.tagName]) end; procedure TForm1.HtmlListener1HandlersOnMouseMoveHandle(Sender: TObject; Event: IHTMLEventObj); begin lblElementUndertheMouse.Caption := Format(‘Element under the Mouse [%s]‘, [Event.srcElement.tagName]) end; procedure TForm1.DisconnectHtmlListeners; var i: Integer; begin for i := HubLinksList.Count - 1 downto 0 do begin (HubLinksList[i] as IHubLink).Disconnect; HubLinksList.Remove(HubLinksList[i]); end; end; procedure TForm1.ConnectHtmlListener(ASender: TObject; Doc: IHTMLDocument2); var CPC: IConnectionPointContainer; begin if Assigned(Doc) then begin Doc.QueryInterface(IConnectionPointContainer, CPC); if Assigned(CPC) then begin HubLink := HtmlListener1.Connect2(CPC); HubLinksList.Add(HubLink); end; end; end; procedure TForm1.ConnectHtmlListeners; var i: Integer; WB: IWebbrowser2; HTMLDoc: IHTMLDocument2; begin for i := 0 to EmbeddedWB1.FrameCount - 1 do begin WB := EmbeddedWB1.GetFrame(i); if Assigned(WB) then begin if Succeeded(WB.Document.QueryInterface(IHTMLDocument2, HTMLDoc)) then ConnectHtmlListener(nil, HTMLDoc); end; end; end; procedure TForm1.EmbeddedWB1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); begin with ASender as TEmbeddedWB do if pDisp = DefaultInterface then begin DisconnectHtmlListeners; end; end; procedure TForm1.EmbeddedWB1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); var WB: IWebbrowser; HTMLDoc: IHTMLDocument2; begin if FEventsEnabled then begin WB := (pDisp as IWebBrowser); if Assigned(WB) then if Succeeded(WB.Document.QueryInterface(IHTMLDocument2, HTMLDoc)) then ConnectHtmlListener(ASender, HTMLDoc); end; end; procedure TForm1.btnEnableDisableClick(Sender: TObject); begin if FEventsEnabled then begin DisconnectHtmlListeners; btnEnableDisable.Caption := ‘Enable Events‘; FEventsEnabled := False; end else begin ConnectHtmlListeners; btnEnableDisable.Caption := ‘Disable Events‘; FEventsEnabled := True; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin DisconnectHtmlListeners; HubLinksList.Free; end; end.
完整代码下载:点击下载