源代码文件
unit events_;
interface
{ Subject: Handling DHTML events in your app
Author: Alexei Reatov
Home: http://www.betterbrowser.com/components
Date: 03 Mar 1999
Description:
This example demonstrates how to intercept a specific event of a specific
DHTML element, hosted in a WebBrowser control, using a simple IDispatch
imitating that of a JavaScript function.
DISCLAIMER: THE CODE IS PROVIDED AS IS, WITHOUT ANY WARRANTIES OR
PROMISES OF TECHNICAL SUPPORT FROM THE AUTHOR. USE IT ON YOUR OWN RISK
AND DON'T BLAME ME IF IT DOES NOT WORK AS AVERTIZED. YOU HAVE THIS SOURCE
AND YOU HAVE MICROSOFT DOCUMENTATION, SO IF YOU CAN'T MAKE SENSE OF IT OR
CAN'T FIX A BUG WHEN YOU RUN INTO IT, IT'S YOUR OWN FAULT!
}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
SHDocVw_TLB, StdCtrls, ActiveX, ComObj, OleCtrls, ExtCtrls, SHDocVw;
type
// In this example, only one event is going to be hooked, therefore only
// one IDispatch object will be needed and I'm sticking the interfac to
// the main form. In a more thorough implementation, there would be multiple
// dynamically allocated IDispatches (e.g. created on demand by an invisible
// component providing the Delphi-level event handlers).
TForm1 = class(TForm, IUnknown, IDispatch)
IE: TWebBrowser;
Panel1: TPanel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure IEDocumentComplete(Sender: TObject; pDisp: IDispatch;
var URL: OleVariant);
private
{ Private declarations }
FRefCount: Integer;
{ Points to the old event handler (e.g. JavaScript function) }
FEventDisp: IDispatch;
{ 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 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
ws: WideString;
v1, v2, v3, v4: OleVariant;
begin
ws := ChangeFileExt(Application.ExeName, '.htm');
IE.Navigate(ws, v1, v2, v3, v4);
end;
function TForm1.QueryInterface(const IID: TGUID; out Obj): HResult;
var
s: string;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TForm1._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;
function TForm1._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;
{ TForm1.IDispatch }
function TForm1.GetTypeInfoCount(out Count: Integer): HResult;
begin
if FEventDisp <> nil then
Result := FEventDisp.GetTypeInfoCount(Count)
else begin
Count := 0;
Result := S_OK;
end;
end;
function TForm1.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
if FEventDisp <> nil then
Result := FEventDisp.GetTypeInfo(Index, LocaleID, TypeInfo)
else begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end
end;
function TForm1.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
if FEventDisp <> nil then
Result := FEventDisp.GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs)
else
Result := E_NOTIMPL;
end;
var
// These are for debugging only!
cA, cNA: Integer;
function TForm1.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params;
VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
try
MessageDlg('The event has fired!', mtinformation, [mbok], 0);
except
end;
if FEventDisp <> nil then begin
with TDispParams(Params) do begin
// never used in the code, I just used the lines below in the debugger to
// make sure no args are passed in!
cA := cArgs;
cNA := cNamedArgs;
end;
Result := FEventDisp.Invoke(DispID, IID, LocaleID, Flags, Params,
VarResult, ExcepInfo, ArgErr)
end else
Result := E_NOTIMPL;
end;
// Once the document is loaded, set up the event handler. Note that the
// code below expects to find a certain <A> element named "theLink" in the
// HTML file. In a more generic case, you'd have to scan the DHTML elements
// to find those you want to hook into.
procedure TForm1.IEDocumentComplete(Sender: TObject; pDisp: IDispatch;
var URL: OleVariant);
var
vDoc, vA: OleVariant;
begin
vDoc := IE.Document;
vA := vDoc.All.theLink;
FEventDisp := IDispatch(vA.onclick);
vA.onclick := OleVariant(Self as IDispatch);
end;
end.
