公布一些关于 Webbrwser 的个人经验，请勿回复

很多做自己的浏览器首先想解决的就是不弹出 IE新窗口。

添加一个Webbrowser把Index改为0。

再编写Webbrowser的NewWindow2事件

这代码是云霞散人提供的。在这里首先谢谢他。

Dim I As Long 

Private Sub Form_Load() 
WebBrowser1(I).Navigate "www.hao123.com" 
End Sub 

Private Sub WebBrowser1_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean) 
I = I + 1 
Load WebBrowser1(I) 
Set ppDisp = WebBrowser1(I).Application 
WebBrowser1(I).Visible = True 
WebBrowser1(I).ZOrder 
End Sub

还有就是让浏览器中的控件编程XP风格。当然如果你的系统是98就不必了。

Private m_hMod As Long
 Private m_hMod2 As Long
 Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
 Private Type tagInitCommonControlsEx
 lngSize As Long
 lngICC As Long
 End Type
 Private Const ICC_USEREX_CLASSES = &H200
 
 Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
 Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
 
 
Private Sub Command1_Click()
WebBrowser1.Navigate "www.baidu.com"
End Sub

 Private Sub Form_Initialize()
 On Error Resume Next
 
 Dim iccex As tagInitCommonControlsEx
 iccex.lngSize = LenB(iccex)
 iccex.lngICC = ICC_USEREX_CLASSES
 InitCommonControlsEx iccex
 
 m_hMod = LoadLibrary("shell32.dll")
 m_hMod2 = LoadLibrary("explorer.exe")
 End Sub
 
 
 Private Sub Form_Terminate()
 On Error Resume Next
 
 If m_hMod Then FreeLibrary m_hMod
 If m_hMod2 Then FreeLibrary m_hMod2
 End Sub

还有如果是弹出窗口，用一楼的方法用自己的程序打开的话，往往容易出脚本错误提示。弹出一个警告框，影响了操作。

只要把Webbrowser的Silent属性改成True就行了�

如果你的Webbroswer是随窗口改变大小的。
而有些网页是限制窗口大小的。
下面这个网站就有一个弹出窗口是限制大小的。
http://www.miibeian.gov.cn/
是给我朋友测试的时候 才发现问题的。

 如果限制了大小，而你的Webbrowser又是随窗口而改变大小，这种窗口往往会挤成一团。

下面这个方法可以解决这个问题，而且窗口会随Webrowser改变大小，而不是在自己所限制的大小中，内容也没出现错误。

Private Sub WB_DownloadComplete(Index As Integer)
If WB(IndexBusy = False Then
Dim a As Object
Set a = WB(Index).Document
'可见宽度= a.body.clientWidth
End If
End Sub

本来我上面是测试得到可见宽度的。谁知道我也没获取也没设置，
只是写上这么几句，问题就解决了。

这段代码可以判断Webbrowser是否可以前进和后退：
 
Private Sub Command1_Click() '前进按钮
WebBrowser1.GoForward 
End Sub 

Private Sub Command2_Click() '后退按钮
WebBrowser1.GoBack 
End Sub 

Private Sub Form_Load() 
WebBrowser1.Navigate "http://www.applevb.com" 
End Sub 

Private Sub WebBrowser1_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean) 
If (Command = CSC_NAVIGATEBACK) Then 
Command2.Enabled = Enable 
End If 
If (Command = CSC_NAVIGATEFORWARD) Then 
Command1.Enabled = Enable 
End If 
End Sub

'
'去掉Webbrowser上的滚动条


Private Sub mnuScroll1_Click() 
'注意：必须在网页完全显示之后才可以运行 
if WebBrowser1.Busy=False Then
WebBrowser1.Document.body.Scroll = "no" '不显示滚动条
ENd If
End Sub 
Private Sub mnuScroll2_Click() 
if WebBrowser1.Busy=False Then
'注意：必须在网页完全显示之后才可以运行 
WebBrowser1.Document.body.Scroll = "Auto" '显示滚动条
ENd If
End Sub

获得Webbrowser中被选中的内容:


Private Sub Command1_Click() 
Dim objSelection 
Dim objTxtRange 

Set objSelection = WebBrowser1.Document.selection 
If Not (objSelection Is Nothing) Then 
Set objTxtRange = objSelection.createRange 
If Not (objTxtRange Is Nothing) Then 
Debug.Print objTxtRange.htmlText 

Set objTxtRange = Nothing 
End If 
Set objSelection = Nothing 
End If 
End Sub 

Private Sub Form_Load() 
WebBrowser1.Navigate "http://www.baidu.com" 
End Sub

'一些常用的功能

保存webbrowser中的HTML内容 
Dim oPF As IPersistFile 
Set oPF = WebBrowser1.Document 
oPF.Save "TheFileNameHere.htm", False

WebBrowser1.ExecWB用处
参数 
WB.ExecWB(4,1) 

4,1 保存网页 
4,2 保存网页(可以重新命名) 
6,1 直接打印 
6,2 直接打印 
7,1 打印预览 
7,2 打印预览 
8,1 选择参数 
8,2 选择参数 
10,1 查看页面属性 
10,2 查看页面属性 
17,1 全选 
17,2 全选 
22,1 重新载入当前页 
22,2 重新载入当前页

//各种尺寸 

s += "\r\n网页可见区域宽："+ document.body.clientWidth; 
s += "\r\n网页可见区域高："+ document.body.clientHeight; 
s += "\r\n网页可见区域高："+ document.body.offsetWeight +" (包括边线的宽)"; 
s += "\r\n网页可见区域高："+ document.body.offsetHeight +" (包括边线的宽)"; 
s += "\r\n网页正文全文宽："+ document.body.scrollWidth; 
s += "\r\n网页正文全文高："+ document.body.scrollHeight; 
s += "\r\n网页被卷去的高："+ document.body.scrollTop; 
s += "\r\n网页被卷去的左："+ document.body.scrollLeft; 
s += "\r\n网页正文部分上："+ window.screenTop; 
s += "\r\n网页正文部分左："+ window.screenLeft; 
s += "\r\n屏幕分辨率的高："+ window.screen.height; 
s += "\r\n屏幕分辨率的宽："+ window.screen.width; 
s += "\r\n屏幕可用工作区高度："+ window.screen.availHeight; 
s += "\r\n屏幕可用工作区宽度："+ window.screen.availWidth; 



使用方法:

在DownloadComplate以后
先判断Webbrowser.Busy是否为False然后
Dim m as Object
set m=WebBrowser1.Document

'例如使用上面的那行s += "\r\n网页可见区域宽："+ document.body.clientWidth; 

则是这样使用
Msgbox a.Body.clientWidth; 

End If

Dim I As Long 

Private Sub Form_Load() 
WebBrowser1(I).Navigate "www.hao123.com" 
End Sub 

Private Sub WebBrowser1_NewWindow2(index As Integer, ppDisp As Object, Cancel As Boolean) 
I = I + 1 
Load WebBrowser1(I) 
Set ppDisp = WebBrowser1(I).Application 
WebBrowser1(I).Visible = True 
WebBrowser1(I).ZOrder 
End Sub 

这是一个数组，当弹出新窗口时，Load一个Webbrowser来打开。
当然，你也可以创建一个子窗口，新窗口时用子窗口打开。

获取源文件:
Dim doc, objhtml As Object
Dim i As Integer
Dim strhtml As String
Dim nHwnd, eHwnd As Long
If WB(OldIdx).Busy = False Then

 Set doc = WB(OldIdx).Document
 i = 0
 Set objhtml = doc.body.createtextrange()
 If Not IsNull(objhtml) Then
 strhtml = objhtml.htmltext
 
 Shell "Notepad.exe", vbNormalFocus
 nHwnd = FindWindow("Notepad", "无标题 - 记事本")
 eHwnd = FindWindowEx(nHwnd, 0&, "Edit", "")
 SendMessage eHwnd, WM_SETTEXT, 0, ByVal strhtml
 
 End If
End If

上面的:
strhtml = objhtml.htmltext 
你可以把下面的Sendmessage去掉。把strhtml改成要在里面显示的控件，
例如Text1.Text=objhtml.htmltext 
就能在自己的控件中显示。
注意一定要WB下载完毕，就是Busy=False才行。
Set doc = WB(OldIdx).Document 
我上面的WB(OldIdx)是一个数组，请自己改。

WB.ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT '剪切

WB.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT '复制

WB(OldIdx).ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT '粘贴

'Sorry,因为是时不时帖一点，所以有点凌乱，请自己整理。我都是做到哪，就说到哪。