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

最新推荐文章于 2021-06-07 13:22:54 发布

chentang1007

最新推荐文章于 2021-06-07 13:22:54 发布

阅读量326

点赞数

原文链接：https://my.oschina.net/yichenbaby/blog/786210

版权

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw,UnitDHtmlEvent,mshtml;

type
TForm1 = 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);
private
procedure DemoEventSink(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
EventSink: TDHTMLEvent;
implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
EventSink.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
EventSink:= TDHTMLEvent.Create;
wb1.Navigate('about:<head><title>标题</title><body><input name="B3" type="submit" value="提交" /> </body>');
end;

procedure TForm1.wb1DocumentComplete(ASender: TObject; const pDisp: IDispatch;
const URL: OleVariant);
var
Doc : IHTMLDocument2;
Element : IHTMLElement;
begin
Doc := IHTMLDocument2(wb1.Document);
if nil <> Doc then
begin
//找到HTML元件
Element := Doc.all.item('B3', 0) as IHTMLElement;
//使HTML元件的click事件和DemoEventSink过程关连
Element.onclick := EventSink.HookEventHandler(DemoEventSink);
end;
end;

procedure TForm1.DemoEventSink(Sender: TObject);
begin
ShowMessage('成功从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.

转载于:https://my.oschina.net/yichenbaby/blog/786210