delphi中EmbeddedWB网页html相互调用

控制自带例子

EmbeddedWB Demos\15 - THTMLListener_Demo

关键方法：HtmlListener1HandlersOnClickHandle

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.