做能在同一窗体打开多个网页的浏览器遇到的问题(30分)

我想做个象腾讯那样的浏览器，能在同一窗体里打开多个网页
在上次提出这个问题的时候有人建议我用PAGECONTROL加WEBBROWSER
并且工藤新一为了写了一段源程序，但问题并没有就些解决，这样我做出来的东西只能
显示第一个页面，后面的页面则不能显示，请大家帮忙看一下
现源程序如下：
procedure TForm1.Button1Click(Sender: TObject);
begin
// webbrowser.Navigate('d:/mypost.htm');
webbrowser.Navigate('http://www.163.com');
end;


procedure TForm1.formresize(Sender: TObject);
begin
with form1 do
pagecontrol1.Width :=width -10;
pagecontrol1.Height :=height -80;
webbrowser.Width :=pagecontrol1.Width ;
webbrowser.Height :=pagecontrol1.Height-20 ;
end;


//以下是工藤新一为我写的代码
procedure TForm1.wbnewwindow(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
var
newbrowser:twebbrowser;
newtabsheet:TTabSheet;
begin
newtabsheet:=TTabSheet.Create(nil);
newtabsheet.PageControl:=pagecontrol1;
newbrowser:=twebbrowser.Create(nil);
newtabsheet.InsertControl(newbrowser);
newbrowser.align:=alclient;
pagecontrol1.ActivePage:=newtabsheet;
ppdisp:=newbrowser.Application;
end;

没人回吗？？UP

我试试看，明天给你答复可以吗？

载动态生成newbrowser时给他命名
{
procedure TForm1.Button1Click(Sender: TObject);
begin
// webbrowser.Navigate('d:/mypost.htm');
webbrowser.Navigate('http://www.163.com');
end;}
只能调用第一个webbrowser

将你的浏览语句放在newwindow过程中就可以了。
我的程序是在用户输入Url后回车执行以下过程，测试通过。
TS := TTabSheet.Create(self);
TS.PageControl := PageControl;

WB := TWebBrowser.Create(self);
TS.InsertControl(WB);
WB.Align := alClient;
PageControl.ActivePage := TS;
WB.Navigate(ComboAddr.Text);

>>along1976

你用的是地址栏里输入的地址，但如果是你在浏览网页时自动打开的新窗口怎么办？

通用性不强啊！（其实是我有点笨，不知道新窗口的地址应该怎么获取）

gz

是新页面自己打开的，还是你点击某个链接打开的？
可以将你的程序注册成为默认的网页浏览器。我也帮你试试。

可以设置WebBrowser的NewWindow2事件,
为新建的WB的NewWindow2事件赋值为WebBrowser.NewWindow2就可以了.
不知道这个效果是不是很满意，有问题再提出来大家一起学习。
{ TODO : 在浏览过程中打开新页面时，创建新的TabSheet&WebBrowser.
这是WebBrowser的NewWindow2事件过程}
procedure TBrowserFrm.WebBrowserNewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
{========多页面部分=======}
TS := TTabSheet.Create(self);
TS.PageControl := PageControl;

WB := TWebBrowser.Create(self);
WB.Align := alClient;
TS.InsertControl(WB);

Ts.Caption := WB.GetNamePath;
PageControl.ActivePage := TS;

ppDisp := WB.Application;
end;

{ TODO : 在ComboAddr中输入url后按回车进行浏览 }
procedure TBrowserFrm.ComboAddrKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
aText: string;
begin
if key = VK_RETURN then //判断用户是否按下了回车键
begin
{========多页面部分=======}
TS := TTabSheet.Create(self);
TS.PageControl := PageControl;

WB := TWebBrowser.Create(self);
TS.InsertControl(WB);
WB.Align := alClient;
PageControl.ActivePage := TS;

aText := trim(ComboAddr.Text);
if ComboAddr.Items.IndexOf(aText) < 0 then //判断历史地址中有没有该项
HistoryAddItem(aText); //没有则将当前地址加入历史列表中

WB.Navigate(ComboAddr.Text);

WB.OnNewWindow2 := WebBrowser.OnNewWindow2;
end;
end;

通过上面的程序你就能浏览多个网页了吗？？
我试了怎么不可以啊？？？
其实这可能是个很简单的问题，可能是因为我的问法不当，以致于你们也没能理解

我的意思是我们在pagecontrol上建立了多个sheet，每个sheet对应一个webbrowser，
我们在点击sheet的时候如何找到它相对应的webbrowser？？？

我想应该用Onchange事件，应该用 pagecontrol1.ActivePageIndex ，而怎么得到该
页所对应的webbrowser是我们要做的事情。

想问你的另一个问题，我们浏览的网页的名字是怎么得到的，如网易？！
我用的是Ontitlechange事件，如下，但还有更好的办法吗？
procedure TForm1.wbtitlechange(Sender: TObject; const Text: WideString);
begin
pagecontrol1.ActivePage.Caption :=text;
end;

还有一点，我这两个正好用到webbrowser，我想全面的了解一下该控件，有关于
它的网页吗？介绍一下，最好是中文的，我的E文太烂！！

1.由于有了TS.InsertControl(WB);所以，不必担心wb与ts的对应问题；
2.网页的标题，即html中的title属性，
用 Title := WebBrowser.LocationName;得到标题，用 Url := WebBrowser.LocationURL;
得到url，这是我从别处找的，可我用了不管用。我现在用 TS.Caption := IHtmlDocument2(WB.Document).title;

我现在用的这个多页面没有问题，而且还增加了在TabSheet上点右键菜单的一些功能。
WebBrowser比较简单，好象没有专门的文章。
如果觉得它不太好用，就用Http类的控件吧。

能把你的源程序传给我看看吗？？
以便更好的向你学习学习！

但如果涉及商业密秘等相关事情的话就算了！！

没整理，将就看吧！！

unit web;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, ImgList, ActnList, StdCtrls, OleCtrls,MsHtml,
SHDocVw, ExtCtrls, Registry, ActiveX, Menus, ComObj,Types, jpeg, strUtils;



type
TBrowserFrm = class(TForm)
MainMenu1: TMainMenu;
ActionList1: TActionList;
ImageList1: TImageList;
IlHot: TImageList;
IlUnFocus: TImageList;
OpenDialog1: TOpenDialog;
ActOpen: TAction;
ActClose: TAction;
ActCopy: TAction;
ActGoto: TAction;
ActRefresh: TAction;
ActStop: TAction;
ActFont: TAction;
ActAddTo: TAction;
ActLintToNetEase: TAction;
ActLintToSina: TAction;
ActLintToSohu: TAction;
ActLinkHust: TAction;
ActFoward: TAction;
ActBackward: TAction;
ActFavoritClk: TAction;
ActManageFavorit: TAction;
ActSelAll: TAction;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
ActFont1: TMenuItem;
Largest: TMenuItem;
Larger: TMenuItem;
Middle: TMenuItem;
Small: TMenuItem;
Smallest: TMenuItem;
MenuFavorit: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
CoolBar1: TCoolBar;
TbMenu: TToolBar;
TbButton: TToolBar;
ToolButton2: TToolButton;
ToolButton1: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
TbLink: TToolBar;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ComboAddr: TComboBoxEx;
TbGoto: TToolBar;
ToolButton10: TToolButton;
PageControl: TPageControl;
TabSheet1: TTabSheet;
WebBrowser: TWebBrowser;
actNewWin: TAction;
PopupMenu: TPopupMenu;
N12: TMenuItem;
N19: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ActFavoritClkExecute(Sender: TObject);
procedure ComboAddrKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ComboAddrSelect(Sender: TObject);
procedure ActOpenExecute(Sender: TObject);
procedure ActBackwardExecute(Sender: TObject);
procedure ActFowardExecute(Sender: TObject);
procedure ActRefreshExecute(Sender: TObject);
procedure ActStopExecute(Sender: TObject);
procedure ActGotoExecute(Sender: TObject);
procedure ActLintToNetEaseExecute(Sender: TObject);
procedure ActLintToSinaExecute(Sender: TObject);
procedure ActAddToExecute(Sender: TObject);
procedure ActManageFavoritExecute(Sender: TObject);
procedure ActCloseExecute(Sender: TObject);
procedure WebBrowserNewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
procedure WebBrowserDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure N12Click(Sender: TObject);
procedure PageControlChange(Sender: TObject);
// procedure procedure NewWin;
private
FavoritFolder: string; //用来记录用户收藏夹的路径
FolderCount: Integer; //用来记录收藏夹的文件夹个数，对其分类添加
UrlList: TStringList; //记录收藏夹中各项的Url地址
{======= 生成多页面 =======}
TS: TTabSheet;
WB: TWebBrowser;
WBDocumentComplete: TWebBrowserDocumentComplete; //为生成页面标题的过程
WBNewWindow2 : TWebBrowserNewWindow2;
{ Private declarations }
public
procedure ReadFavorit(ARootItem: TMenuItem; aPath: string);//从系统文件夹中读入收藏夹内容，并动态生成菜单
procedure ReadTypedUrl; //从注册表中读入历史地址
procedure HistoryAddItem(aUrl: string); //将历史地址添加到ComboAddr中
{ Public declarations }
end;

const
CLSId_ShellUiHelper: TGuId = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';
//将在添加及管理收藏夹时用到
var
BrowserFrm: TBrowserFrm;

implementation

{$R *.dfm}


procedure TBrowserFrm.FormCreate(Sender: TObject);
var
MyReg: TRegistry; //封装了注册表操作的类
Url: OleVariant;
begin
inherited; //调用基类中的OnCreate事件响应过程
MyReg := TRegistry.Create;
try
MyReg.RootKey := HKey_Current_User; //设置myreg的根键
if MyReg.OpenKey('Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders', false) then
//打开子键
begin
FavoritFolder := MyReg.ReadString('Favorites'); //读入收藏夹的目录路径
MyReg.CloseKey;
end;
finally
MyReg.Free;
ReadTypedUrl; //调用过程，读入历史页面地址
FolderCount := 3; //设置初始值为3，使得动态菜单从第3项开始添加
UrlList := TStringList.Create;
ReadFavorit(MenuFavorit, FavoritFolder); //读入收藏夹的内容，生成菜单
Url := 'about:blank';
ComboAddr.Text := 'about:blank';
WebBrowser.Navigate2(Url); //初始化WebBrowser为打开空白页面
end;
{===========为完成多页浏览的初始化=========}
WBDocumentComplete := WebBrowser.OnDocumentComplete;
WBNewWindow2 := WebBrowser.OnNewWindow2;
end;

{ TODO : 在form.destroy中注销在Creat中创建的对象 }
procedure TBrowserFrm.FormDestroy(Sender: TObject);
begin
UrlList.Free;
end;

{ TODO : 从注册表和本地文件系统中读入历史Url和收藏夹内容 }
procedure TBrowserFrm.ReadTypedUrl;
var
MyReg: TRegistry;
Val: TStringList;
I: Integer;
begin
MyReg := TRegistry.Create;
Val := TStringList.Create;
try
MyReg.RootKey := HKey_Current_User;
if MyReg.OpenKey('/Software/Microsoft/InternetExplorer/TypedUrls', false) then
begin
MyReg.GetValueNames(Val); //得到所有子键的枚举名字
ComboAddr.ItemsEx.Clear;
for I := 0 to Val.Count - 1 do
HistoryAddItem(MyReg.ReadString(Val.Strings)); //添加历史地址到ComboAddr
MyReg.CloseKey;
end;
finally
MyReg.Free;
Val.Free;
end;
end;

{ TODO : 将Url地址加进ComboAddr中根据不同的协议设置图标。 }
procedure TBrowserFrm.HistoryAddItem(aUrl: string);
var
Item: TComboExItem;
begin
Item := ComboAddr.ItemsEx.Add;
Item.Caption := aUrl;
if pos('http:', aUrl) > 0 then //HTTP协议的Url
Item.ImageIndex := 1
else if (pos('ftp:', aUrl) > 0) or (pos('ftp.', aUrl) > 0) then //ftp协议的Url
Item.ImageIndex := 0
else
Item.ImageIndex := 1; //其他
end;

{ TODO : Internet快捷方式 的文件格式：[InternetShortcut]<br>Url=。与INI相同，故用WindowsAPI函数
GetProvateProfileString来读取.Url文件的内容}
procedure TBrowserFrm.ReadFavorit(aRootItem: TMenuItem; aPath: string);
var
NewItem: TMenuItem;
sr: TSearchRec;
FileAttrs: Integer;
aUrl: string;
Buffer: array[0..2047] of char;
begin
// FileAttrs := faArchive + faDirectory; //查找目录下的所有文件和目录
FileAttrs := 32 + 16;
if FindFirst(aPath + '/*', FileAttrs, sr) = 0 then //API函数FindFirst用于查找文件，结果在SR中
begin
repeat
//动态生成收藏夹部分菜单，FindFirst函数将父目录'..'当前目录'.'也返回，需去掉，对于目录则递归调用该方法
if ((sr.Attr and faDirectory) = sr.Attr) and (sr.Name <> '.') and (sr.Name <> '..') then
begin
NewItem := TMenuItem.Create(nil);
NewItem.Caption := sr.Name;
NewItem.Visible := true;
NewItem.ImageIndex := 2;
//用Insert方法而不是Add，可以将所有目录排列在一起
aRootItem.Insert(FolderCount, NewItem);
FolderCount := FolderCount + 1;
ReadFavorit(NewItem, aPath + '/' +sr.Name); //递归调用
end
else if (sr.Attr and 32) = sr.Attr then //处理快捷方式
begin
NewItem := TMenuItem.Create(nil);
//用API函数GetPrivateProfileString读取ini文件格式的内容
GetPrivateProfileString('InternetSortcut', Pchar('URL'),nil, Buffer, sizeOf(Buffer), Pchar(apath + '/' +sr.Name));
aUrl := String(Buffer);
Delete(sr.Name, pos('.url',sr.Name), 4); //删除文件后缀
NewItem.ImageIndex := 1;
NewItem.Visible := true;
NewItem.Tag :=UrlList.Count; //用tag属性记下在列表中的索引
UrlList.Add(aUrl); //将Url地址存入UrlList列表
NewItem.Hint := aUrl;
NewItem.OnClick := actFavoritClkExecute; //设置该菜单的响应过程
NewItem.Caption := sr.Name;
aRootItem.Add(NewItem);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;



{ TODO : 在ComboAddr中输入url后按回车进行浏览 }
procedure TBrowserFrm.ComboAddrKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
aText: string;
begin
if key = VK_RETURN then //判断用户是否按下了回车键
begin
//将'空白'的TabSheet去掉
if Assigned(TabSheet1) then
TabSheet1.Destroy;

{========多页面部分=======}
TS := TTabSheet.Create(self);
TS.PageControl := PageControl;

WB := TWebBrowser.Create(self);
TS.InsertControl(WB);
WB.Align := alClient;
PageControl.ActivePage := TS;

aText := trim(ComboAddr.Text);
if ComboAddr.Items.IndexOf(aText) < 0 then //判断历史地址中有没有该项
HistoryAddItem(aText); //没有则将当前地址加入历史列表中

WB.Navigate(ComboAddr.Text);
WB.OnDocumentComplete := WBDocumentComplete; //得到下载文档完成后的执行过程
WB.OnNewWindow2 := WBNewWindow2;
{=========================}
end;
end;

{ TODO : 方便用户，在用户选择地址列表中的内容时，也应打开相应的url }
procedure TBrowserFrm.ComboAddrSelect(Sender: TObject);
begin
WebBrowser.Navigate(ComboAddr.Text);
end;

{================================================================}
//以下将集中处理action中的事件
{================================================================}

{ TODO : 允许用户打开本地html文件 }
procedure TBrowserFrm.ActOpenExecute(Sender: TObject);
begin
OpenDialog1.Filter := 'Html 文件|*.html;*.htm|所有文件|*.*';
if OpenDialog1.Execute then
begin
ComboAddr.Text := OpenDialog1.FileName;
WebBrowser.Navigate(ComboAddr.Text);
end;
end;

{ TODO : 以下代码实现了浏览器的前进，后退功能 }
procedure TBrowserFrm.ActBackwardExecute(Sender: TObject);
begin
try
WB.GoBack; //返回到上一页
finally
end;
end;
procedure TBrowserFrm.ActFowardExecute(Sender: TObject);
begin
try
WB.GoForward; //前进到下一页
finally
end;
end;
{ TODO : 刷新功能 }
procedure TBrowserFrm.ActRefreshExecute(Sender: TObject);
begin
try
WebBrowser.Refresh2;
finally
end;
end;
{ TODO : 停止功能 }
procedure TBrowserFrm.ActStopExecute(Sender: TObject);
begin
try
WebBrowser.Stop;
finally
end;
end;
{ TODO : 转到功能 }
procedure TBrowserFrm.ActGotoExecute(Sender: TObject);
var
aText: string;
begin
aText := trim(ComboAddr.Text);
if ComboAddr.Items.IndexOf(aText) < 0 then
HistoryAddItem(aText);
WebBrowser.Navigate(aText);
end;

{ TODO : 增加快捷网站按钮 }
procedure TBrowserFrm.ActLintToNetEaseExecute(Sender: TObject);
begin
//连到网易
ComboAddr.Text := 'http://www.163.com';
WebBrowser.Navigate('http://www.163.com');
end;
procedure TBrowserFrm.ActLintToSinaExecute(Sender: TObject);
begin
//新浪
ComboAddr.Text := 'http://www.sina.com.cn';
WebBrowser.Navigate('http://www.sina.com.cn');
end;

{ TODO : 允许用户新喜欢的网站添加到收藏夹中
该过程的实现用到了IShellUIHelper接口}
procedure TBrowserFrm.ActAddToExecute(Sender: TObject);
var
ShellUIHelper: IShellUIHelper;
Url, Title: OleVariant;
begin
{====== 多页面 =======}
Title := WB.LocationName;
Url := WB.LocationURL;
{ Title := WebBrowser.LocationName;
Url := WebBrowser.LocationURL;
}
if Url <> '' then
begin
ShellUIHelper := CreateComObject(CLSId_ShellUIHelper) as IShellUIHelper;
ShellUIHelper.AddFavorite(Url, Title);
end;
end;
{ TODO : 调用shdocvw.dll中的doOrganizeFavDlg过程，直接弹出系统的'管理收藏夹'对话框。 }
procedure TBrowserFrm.ActManageFavoritExecute(Sender: TObject);
var
proc: procedure(Handle:THandle; Path: Pchar); stdcall; //定义过程变量
WHwnd: HWnd; //定义窗口句柄变量
begin
//装载动态链接库
WHwnd := LoadLibrary(pchar('shdocvw.dll'));
if Whwnd <> 0 then
begin
//得到DoOrganazeFavDlg过程的执行地址
proc := GetProcAddress(WHwnd, Pchar('DoOrganizeFavDlg'));
if Assigned(proc) then
proc(Application.Handle, Pchar(FavoritFolder)); //执行过程
end;
FreeLibrary(WHwnd); //卸载动态链接库
end;
{ TODO : 单击收藏夹中的项目进行浏览 }
procedure TBrowserFrm.ActFavoritClkExecute(Sender: TObject);
begin
ComboAddr.Text := UrlList.Strings[TMenuItem(sender).tag];
WebBrowser.Navigate(ComboAddr.Text);
end;

{ TODO : 退出应用程序 }
procedure TBrowserFrm.ActCloseExecute(Sender: TObject);
begin
Self.Close;
end;

{==============处理WebBrowser的过程，并赋给WB以实现功能=======================}

{ TODO : 在浏览过程中打开新页面时，创建新的TabSheet&WebBrowser. }
procedure TBrowserFrm.WebBrowserNewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
{========多页面部分=======}
TS := TTabSheet.Create(self);
TS.PageControl := PageControl;

WB := TWebBrowser.Create(self);
WB.Align := alClient;
TS.InsertControl(WB);

Ts.Caption := WB.GetNamePath;
PageControl.ActivePage := TS;

ppDisp := WB.Application;
end;
{ TODO : 在浏览页面下载完成后显示标题 }
procedure TBrowserFrm.WebBrowserDocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Assigned(WB) and assigned(WB.Document) then
begin
TS.Caption := IHtmlDocument2(WB.Document).title;
TS.ShowHint := true;
TS.Hint := IHtmlDocument2(WB.Document).url;
if TS.Caption = '' then
begin
TS.Caption := '空白页面';
TS.Hint := 'About: Black';
end;
end;
end;

{ TODO : TabSheet 右键菜单的执行 }
//关闭当前浏览页面
procedure TBrowserFrm.N12Click(Sender: TObject);
begin
if PageControl.PageCount > 1 then
PageControl.ActivePage.Destroy;
end;

procedure TBrowserFrm.PageControlChange(Sender: TObject);
begin
ComboAddr.Text := PageControl.ActivePage.Hint;
end;

initialization
{ TODO : 引进了TRegistry类，WebBrowser是OLE对象，需要对它初始化 }
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
end.

Thanks!

This is my need!

Thanks again.

>>>along1976
经过这两天的试验，我现在才发现我问的问题不对，实际上的确是每个SHEET对应着一个
WEBBROWSER，最主要的问题是我在读取第一个网页的时候，第一个webbrowser会永远
停在最上面，把后面的网页给盖住了！

不知我这样说你能不能明白，这个问题该如何解决？？？

我的这个没有这样的问题。
1.检查你的WB和TS的设置是不是有问题；
2.注意TS.insertcontrol和pagecontrol.activepage；
3.再不成就用bringtofront...强制其到下一层或上一层；

我建议你再建一个工程试一次，也许是你把某些属性调了而没有注意。

把你的Email给我，我给你发一份样稿，你帮我看看，OK？

junhai@sina.com

问题已解决，待会给你一份答案！