delphi仿IE浏览器标签页效果演示
路过的同学多多指教--------------------------------------------------------------
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
补充：软件开发 , Delphi ,
