看到有同学提问, 自己试炼了一把, 只为实现标签页效果, 未作细化和完善工作.
路过的同学多多指教
--------------------------------------------------------------
a.html
<!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" οnclick="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" οnclick="" name="Submit" value="提交" />
</label>
<a href="http://so.com" target="_blank">so</a>
</body>
</html>
单元文件
unit Unit11;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, ComCtrls;
type
TForm11 = class(TForm)
pgc1: TPageControl;
procedure FormCreate(Sender: TObject);
procedure pgc1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
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);
procedure closePage(aTab: TTabSheet);
{ 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.closePage(aTab : TTabSheet);
var
i : integer;
begin
if aTab = nil then Exit;
for I := aTab.ComponentCount - 1 downto 0 do
begin
if aTab.Components[i] is TWebBrowser then
TWebBrowser(aTab.Components[i]).Stop;
aTab.Components[i].Free;
end;
aTab.Free;
end;
procedure TForm11.pgc1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Index: Integer;
begin
//左键点击并且双击
if (Button = mbLeft) and (ssDouble in Shift) then
begin
Index := pgc1.IndexOfTabAt(X, Y);
if Index >= 0 then
closePage(pgc1.Pages[Index]);
end;
end;
procedure TForm11.MyNewWindow2(ASender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
begin
//新链接事件处理
ppDisp := NewWindow().DefaultInterface;
end;
procedure TForm11.FormCreate(Sender: TObject);
begin
// NewWindow('http://news.baidu.com');
NewWindow(ExtractFilePath(Application.ExeName)+'a.html');
end;
procedure TForm11.MyBeforeNavigate2(ASender: TObject; const pDisp: IDispatch;
var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
var Cancel: WordBool);
begin
//Todo 事务处理
end;
end.
界面文件
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