路過的同學多多指教 -------------------------------------------------------------- a.html [html] view plaincopy <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head> <meta http-equiv="Content-Type" content="text/html; charset=gb2312" /> <title>無標題文檔</title> </head> <body> <label>btn <input id="aa" type="button" onclick="location='http://www.google.com'" name="Submit" value="提交" /> </label> <a id="bb" href="http://www.baidu.com">ahref</a> <br /> <label>btn <input id="aa" type="button" onclick="" name="Submit" value="提交" /> </label> <a href="http://so.com" target="_blank">so</a> </body> </html> 單元文件 [delphi] unit Unit11; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw, StdCtrls, ComCtrls, ExtCtrls; type TForm11 = class(TForm) pgc1: TPageControl; procedure FormCreate(Sender: TObject); private function NewWindow(const URL : string = '') : TWebBrowser; procedure MyBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); procedure MyNewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); { Private declarations } public { Public declarations } end; var Form11: TForm11; implementation {$R *.dfm} function TForm11.NewWindow(const URL : string = '') : TWebBrowser; var aTab : TTabSheet; begin aTab := TTabSheet.Create(pgc1); aTab.PageControl := pgc1; aTab.Caption := 'tab' + IntToStr(pgc1.PageCount); pgc1.ActivePage := aTab; aTab.Align := alClient; result := TWebBrowser.Create(self); aTab.InsertControl(result); result.Align := alClient; result.OnBeforeNavigate2 := MyBeforeNavigate2; result.OnNewWindow2 := MyNewWindow2; if URL <> '' then result.Navigate(url); end; procedure TForm11.FormCreate(Sender: TObject); begin NewWindow(ExtractFilePath(Application.ExeName)+'a.html'); end; procedure TForm11.MyNewWindow2(ASender: TObject; var ppDisp: IDispatch; var Cancel: WordBool); begin //新鏈接事件處理 ppDisp := NewWindow().DefaultInterface; end; procedure TForm11.MyBeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; var Cancel: WordBool); begin //Todo 事務處理 end; end. 界面文件 [delphi] object Form11: TForm11 Left = 0 Top = 0 Caption = 'Form11' ClientHeight = 461 ClientWidth = 769 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object pgc1: TPageControl Left = 0 Top = 0 Width = 769 Height = 461 Align = alClient TabOrder = 0 ExplicitTop = 56 ExplicitHeight = 405 end end
