用WebBrowser实现HTML界面的应用和交互

2016-11-12 11:12:04来源:oschina作者:依宸老爹人点击

unit Unit1; interface usesWinapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw,UnitDHtmlEvent,mshtml; typeTForm1 = class(TForm) wb1: TWebBrowser; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure wb1DocumentComplete(ASender: TObject; const pDisp: IDispatch;const URL: OleVariant);privateprocedure DemoEventSink(Sender: TObject); { Private declarations }public { Public declarations }end; varForm1: TForm1;EventSink: TDHTMLEvent; implementation {$R *.dfm} procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); beginEventSink.Free; end; procedure TForm1.FormCreate(Sender: TObject); beginEventSink:= TDHTMLEvent.Create;wb1.Navigate('about:标题 '); end; procedure TForm1.wb1DocumentComplete(ASender: TObject; const pDisp: IDispatch;const URL: OleVariant); varDoc : IHTMLDocument2;Element : IHTMLElement; beginDoc := IHTMLDocument2(wb1.Document);if nil <> Doc thenbegin //找到HTML元件 Element := Doc.all.item('B3', 0) as IHTMLElement; //使HTML元件的click事件和DemoEventSink过程关连 Element.onclick := EventSink.HookEventHandler(DemoEventSink);end; end; procedure TForm1.DemoEventSink(Sender: TObject); beginShowMessage('成功从HTML中调用Delphi的过程。'); end; end.


//引用的类pas文件


unit UnitDHtmlEvent;

interface
uses Windows, Classes;
type
TDHTMLEvent = class (TObject, IUnknown, IDispatch)
private
FRefCount: Integer;
FOldEvent: IDispatch;
FElementEvent: TNotifyEvent;
// 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 }
function HookEventHandler(CallerHandler: TNotifyEvent): IDispatch;
property ElementEvent: TNotifyEvent read FElementEvent write FElementEvent;
end;
implementation
{ TDHTMLEvent }
function TDHTMLEvent._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;
function TDHTMLEvent._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;
function TDHTMLEvent.GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
if FOldEvent <> nil then
Result := FOldEvent.GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs)
else
Result := E_NOTIMPL;
end;
function TDHTMLEvent.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
if FOldEvent <> nil then
Result := FOldEvent.GetTypeInfo(Index, LocaleID, TypeInfo)
else
begin
Pointer(TypeInfo) := nil;
Result := E_NOTIMPL;
end
end;
function TDHTMLEvent.GetTypeInfoCount(out Count: Integer): HResult;
begin
if FOldEvent <> nil then
Result := FOldEvent.GetTypeInfoCount(Count)
else
begin
Count := 0;
Result := S_OK;
end;
end;
function TDHTMLEvent.QueryInterface(const IID: TGUID; out Obj): Integer;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TDHTMLEvent.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
begin
try
if Assigned(FElementEvent) then FElementEvent(Self);
finally
if FOldEvent <> nil then
Result := FOldEvent.Invoke(DispID, IID, LocaleID, Flags, Params,
VarResult, ExcepInfo, ArgErr)
else
Result := E_NOTIMPL;
end;
end;
function TDHTMLEvent.HookEventHandler(CallerHandler: TNotifyEvent): IDispatch;
begin
FOldEvent:=nil;
ElementEvent:=CallerHandler;
Result:=Self;
end;
end.

最新文章

123

最新摄影

微信扫一扫

第七城市微信公众平台