page.htm
| Код |
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html>
<head>
<title>Page</title>
</head>
<body>
<table id="mytable" border="1" style="background-color: Silver">
<tr>
<td>11111</td>
</tr>
</table>
<br>
<div id="mydiv" style="background-color: Green">
<a href="#">a1</a><br>
<a href="#">a2</a><br>
<a href="#">a3</a><br>
<a href="#">a4</a><br>
</div>
</body>
</html>
|
Примерчик
| Код |
unit UMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls, OleCtrls, SHDocVw, ActiveX, Mshtml;
type
IMyEventSink = interface(IDispatch)
procedure SetSource(Value: OleVariant);
property Source: OleVariant write SetSource;
end;
{ onclick Handler }
TEventSink = class(TInterfacedObject, IMyEventSink)
private
FSource: OleVariant;
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 SetSource(Value: OleVariant);
end;
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FDivSink, FTableSink: IMyEventSink;
end;
const
{ id }
MyDiv = 'mydiv';
MyTable = 'mytable';
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Divs, Tables: IHTMLElementCollection;
DivEl, TableEl: IHTMLElement2;
begin
with WebBrowser1 do
begin
Navigate('file://' + ExtractFilePath(ParamStr(0)) + 'page.htm');
while ReadyState < READYSTATE_INTERACTIVE do
Forms.Application.ProcessMessages;
{ <div> }
Divs := ((Document as IHTMLDocument2).body as
IHTMLElement2).getElementsByTagName('DIV');
if Assigned(Divs) then
try
DivEl := Divs.item(Unassigned, 0) as IHTMLElement2;
if Assigned(DivEl) then
try
if OleVariant(DivEl).id = MyDiv then
begin
{ Назначение onclick для <div> }
FDivSink.Source := DivEl;
(DivEl as IHTMLElement).onclick := FDivSink;
end;
finally
DivEl := nil;
end;
finally
Divs := nil;
end;
{ <table> }
Tables := ((Document as IHTMLDocument2).body as
IHTMLElement2).getElementsByTagName('TABLE');
if Assigned(Tables) then
try
TableEl := Tables.item(Unassigned, 0) as IHTMLElement2;
if Assigned(TableEl) then
try
if OleVariant(TableEl).id = MyTable then
begin
{ Назначение onclick для <table> }
FTableSink.Source := TableEl;
(TableEl as IHTMLElement).onclick := FTableSink;
end;
finally
TableEl := nil;
end;
finally
Tables := nil;
end;
end;
end;
{ TEventSink }
function TEventSink.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
LocaleID: Integer; DispIDs: Pointer): HResult;
begin
Result := E_NOTIMPL;
end;
function TEventSink.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := E_NOTIMPL;
Pointer(TypeInfo) := nil;
end;
function TEventSink.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := E_NOTIMPL;
Count := 0;
end;
function TEventSink.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
const
FmtStr = 'Щелчок по элементу %s ; X: %d, Y: %d' + sLineBreak + '%s';
var
CPos: TPoint;
CName: String;
begin
Result := S_OK;
with Form1.WebBrowser1 do
begin
CPos.X := OleVariant(Document).parentWindow.event.X;
CPos.Y := OleVariant(Document).parentWindow.event.Y;
CName := 'Непосредственный элемент: <' +
OleVariant(Document).parentWindow.event.srcElement.tagName + '>';
end;
if FSource.id = MyTable then
ShowMessage(Format(FmtStr, ['<table>', CPos.X, CPos.Y, CName]))
else
if FSource.id = MyDiv then
ShowMessage(Format(FmtStr, ['<div>', CPos.X, CPos.Y, CName]));
end;
procedure TEventSink.SetSource(Value: OleVariant);
begin
FSource := Value;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FTableSink := TEventSink.Create;
FDivSink := TEventSink.Create;
end;
end.
|
|