(該代碼來自國外網站, 給 "神奇的科比" 參考)

---

代碼:

---

unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;typeTObjectProcedure = procedure of object;TEventObject = class(TInterfacedObject, IDispatch)privateFOnEvent: TObjectProcedure;protectedfunction 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;publicconstructor Create(const OnEvent: TObjectProcedure);property OnEvent: TObjectProcedure read FOnEvent write FOnEvent;end;TForm1 = class(TForm)WebBrowser1: TWebBrowser;Memo1: TMemo;procedure WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;var Cancel: WordBool);procedure WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch;var URL: OleVariant);procedure FormCreate(Sender: TObject);privateprocedure Document_OnMouseOver;public{ Public declarations }end;varForm1: TForm1;htmlDoc: IHTMLDocument2;implementation{$R *.dfm}procedure TForm1.Document_OnMouseOver;varelement: IHTMLElement;beginif htmlDoc = nil thenExit;element := htmlDoc.parentWindow.event.srcElement;Memo1.Clear;if LowerCase(element.tagName) = 'a' thenbeginMemo1.Lines.Add('LINK info...');Memo1.Lines.Add(Format('HREF : %s', [element.getAttribute('href', 0)]));endelse if LowerCase(element.tagName) = 'img' thenbeginMemo1.Lines.Add('IMAGE info...');Memo1.Lines.Add(Format('SRC : %s', [element.getAttribute('src', 0)]));endelsebeginMemo1.Lines.Add(Format('TAG : %s', [element.tagName]));end;end; (* Document_OnMouseOver *)procedure TForm1.FormCreate(Sender: TObject);beginWebBrowser1.Navigate('http://del.cnblogs.com');Memo1.Clear;Memo1.Lines.Add('Move your mouse over the document...');end; (* FormCreate *)procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);beginhtmlDoc := nil;end; (* WebBrowser1BeforeNavigate2 *)procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch;var URL: OleVariant);beginif Assigned(WebBrowser1.Document) thenbeginhtmlDoc := WebBrowser1.Document as IHTMLDocument2;htmlDoc.onmouseover := (TEventObject.Create(Document_OnMouseOver) as IDispatch);end;end; (* WebBrowser1DocumentComplete *){ TEventObject }constructor TEventObject.Create(const OnEvent: TObjectProcedure);begininherited Create;FOnEvent := OnEvent;end;function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;beginResult := E_NOTIMPL;end;function TEventObject.GetTypeInfo(index, LocaleID: Integer; out TypeInfo): HResult;beginResult := E_NOTIMPL;end;function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;beginResult := E_NOTIMPL;end;function TEventObject.Invoke(dispid: Integer; const IID: TGUID; LocaleID: Integer;Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;beginif (dispid = DISPID_VALUE) thenbeginif Assigned(FOnEvent) thenFOnEvent;Result := S_OK;endelseResult := E_NOTIMPL;end;end.
窗體:

---

object Form1: TForm1Left = 0Top = 0Caption = 'Form1'ClientHeight = 375ClientWidth = 643Color = clBtnFaceFont.Charset = DEFAULT_CHARSETFont.Color = clWindowTextFont.Height = -11Font.Name = 'Tahoma'Font.Style = []OldCreateOrder = FalseOnCreate = FormCreatePixelsPerInch = 96TextHeight = 13object WebBrowser1: TWebBrowserLeft = 0Top = 73Width = 643Height = 302Align = alClientTabOrder = 0OnBeforeNavigate2 = WebBrowser1BeforeNavigate2OnDocumentComplete = WebBrowser1DocumentCompleteExplicitLeft = 264ExplicitTop = 200ExplicitWidth = 300ExplicitHeight = 150ControlData = {4C00000075420000361F00000000000000000000000000000000000000000000000000004C000000000000000000000001000000E0D057007335CF11AE6908002B2E126208000000000000004C0000000114020000000000C000000000000046800000000000000000000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000}endobject Memo1: TMemoLeft = 0Top = 0Width = 643Height = 73Align = alTopLines.Strings = ('Memo1')TabOrder = 1end end
給 "神奇的科比" 改的識別第一個框架的代碼:

---

unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;typeTObjectProcedure = procedure of object;TEventObject = class(TInterfacedObject, IDispatch)privateFOnEvent: TObjectProcedure;protectedfunction 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;publicconstructor Create(const OnEvent: TObjectProcedure);property OnEvent: TObjectProcedure read FOnEvent write FOnEvent;end;TForm1 = class(TForm)WebBrowser1: TWebBrowser;Memo1: TMemo;procedure WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;var Cancel: WordBool);procedure WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch;var URL: OleVariant);procedure FormCreate(Sender: TObject);privateprocedure Document_OnMouseOver;public{ Public declarations }end;varForm1: TForm1;htmlDoc: IHTMLDocument2;implementation{$R *.dfm}procedure TForm1.Document_OnMouseOver;varelement: IHTMLElement;beginif htmlDoc = nil thenExit;element := htmlDoc.parentWindow.event.srcElement;Memo1.Clear;if LowerCase(element.tagName) = 'a' thenbeginMemo1.Lines.Add('LINK info...');Memo1.Lines.Add(Format('HREF : %s', [element.getAttribute('href', 0)]));endelse if LowerCase(element.tagName) = 'img' thenbeginMemo1.Lines.Add('IMAGE info...');Memo1.Lines.Add(Format('SRC : %s', [element.getAttribute('src', 0)]));endelsebeginMemo1.Lines.Add(Format('TAG : %s', [element.tagName]));end;end; (* Document_OnMouseOver *)procedure TForm1.FormCreate(Sender: TObject);beginWebBrowser1.Navigate('http://passport.csdn.net/UserLogin.aspx');Memo1.Clear;Memo1.Lines.Add('Move your mouse over the document...');end; (* FormCreate *)procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch;var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool);beginhtmlDoc := nil;end; (* WebBrowser1BeforeNavigate2 *)procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch;var URL: OleVariant);beginif Assigned(WebBrowser1.Document) thenbeginhtmlDoc := WebBrowser1.Document as IHTMLDocument2;if htmlDoc.frames.length > 0 thenbeginhtmlDoc := (IDispatch(htmlDoc.frames.item(0)) as IHTMLWindow2).Document;end;htmlDoc.onmouseover := (TEventObject.Create(Document_OnMouseOver) as IDispatch);end;end; (* WebBrowser1DocumentComplete *){ TEventObject }constructor TEventObject.Create(const OnEvent: TObjectProcedure);begininherited Create;FOnEvent := OnEvent;end;function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer;NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;beginResult := E_NOTIMPL;end;function TEventObject.GetTypeInfo(index, LocaleID: Integer; out TypeInfo): HResult;beginResult := E_NOTIMPL;end;function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;beginResult := E_NOTIMPL;end;function TEventObject.Invoke(dispid: Integer; const IID: TGUID; LocaleID: Integer;Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;beginif (dispid = DISPID_VALUE) thenbeginif Assigned(FOnEvent) thenFOnEvent;Result := S_OK;endelseResult := E_NOTIMPL;end;end.

轉載于:https://www.cnblogs.com/del/archive/2010/03/04/1678550.html

總結

以上是生活随笔為你收集整理的给 TWebBrowser.Document 定义事件的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。