模板
教程
环境
性能
功能
管理
给自己的程序增加网页浏览功能（续）
给自己的程序增加网页浏览功能（续）
Private Sub mnuFileSaveAs_Click()
brwWebBrowser.SetFocus
On Error Resume Next
brwWebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
‘MILY: 宋体; mso-ascii-font-family: 'Times New Roman'; mso-hansi-font-family: 'Times New Roman'">另存为
‘以下是用原始的方式另存为
' Dim sFile As String
'
'
' With dlgCommonDialog
' .DialogTitle = "另存为..."
' .CancelError = False
' '.FileName = Me.brwWebBrowser.LocationName
' 'ToDo: 设置 common dialog 控件的标志和属性
' .Filter = "HTML文件(*.html,*.htm)|*.html;*htm|文本文件(*.txt)|*.txt|Asp文件(*.asp)|*.asp" & _
' "|图形文件(*.bmp;*.jpg;*.jpeg;*.gif)|*.bmp;*.jpg;*.jpeg;*.gif|所有文件(*.*)|*.*"
' .ShowSave
' If Len(.FileName) = 0 Then
' Exit Sub
' End If
' sFile = .FileName
' End With
' 'ToDo: 添加处理打开的文件的代码
' brwWebBrowser.Navigate sFile
'
' 'To Do Save As ...
End Sub
Private Sub mnuFileSetPage_Click()
brwWebBrowser.SetFocus
On Error Resume Next
brwWebBrowser.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT
‘页面设置
End Sub
Private Sub mnuFileView_Click()
brwWebBrowser.SetFocus
On Error Resume Next
brwWebBrowser.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
‘打印预览
End Sub
Private Sub mnuFileWork_Click()
Me.mnuFileWork.Checked = Not Me.mnuFileWork.Checked
Me.brwWebBrowser.Offline = Me.mnuFileWork.Checked
‘脱机
End Sub
一、 WEBBROWSER控件
WEBBROWSER控件不但可以打开网页，还可以打开很多其他格式的文件和浏览硬盘上的文件。这得益于MS的OLE政策。
当浏览一个网页时，右键菜单中的在新窗口打开时，缺省是用IE打开，下面代码是控制用个人的浏览器打开。
Private Sub brwWebBrowser_NewWindow2(ppDisp As Object, Cancel As Boolean)
Dim frmWB As frmMainExploer
Set frmWB = New frmMainExploer
frmWB.brwWebBrowser.RegisterAsBrowser = True
Set ppDisp = frmWB.brwWebBrowser.Object
frmWB.Visible = True
End Sub
更新窗口标题
Private Sub brwWebBrowser_TitleChange(ByVal Text As String)
Me.Caption = Text
End Sub
在网页中可能会有关闭窗口的按扭，点击它会关闭我们的WEBBROWSER控件的实例，以下代码就是避免情况的发生。
Private Sub brwWebBrowser_WindowClosing(ByVal IsChildWindow As Boolean, Cancel As Boolean)
If IsChildWindow = False Then
Cancel = True
Else
Cancel = False
End If
End Sub
无用代码
Private Sub mnuHelpTest_Click()
brwWebBrowser.SetFocus
On Error Resume Next
brwWebBrowser.ExecWB OLECMDID_NEW, OLECMDEXECOPT_DODEFAULT
End Sub
用了SHELL打开INTERNET选项的控制面板，也可以用SHDOCVW.DLL提供的API打开。
Private Sub mnuToolOption_Click()
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", 5)
End Sub
全屏显示，对于WEBBROWSER控件无效。
Private Sub mnuViewFullScreen_Click()
Me.brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT
End Sub
二、 INTERNET EXPLORER AUTOMATION
下面代码显示怎样控制一个INTERNET EXPLORER AUTOMATION的实例。
Dim ie As SHDocVw.InternetExplorer
'
' Set ie = CreateObject("InternetExplorer.Application") ‘创建一个实例
' ie.Navigate2 "C:\"
' ie.FullScreen = False ‘是否全屏
' ie.Visible = True
' ie.ToolBar = True ‘是否显示工具条
' ie.MenuBar = True ‘是否显示菜单
' ie.StatusBar = True ‘是否显示状态条
' ie.Resizable = False ‘是否可变窗口大小。
'在IE6中，增加了个人栏，加上搜索栏、收藏夹和历史共有四个浏览条。以下是控制显示以下四个浏览条的代码。
' IE.ShowBrowserBar "{30D02401-6A81-11D0-8274-00C04FD5AE38}", True
'
' IE.ShowBrowserBar "{EFA24E61-B078-11D0-89E4-00C04FC9E26E}", True
'
' ie.ShowBrowserBar "{EFA24E62-B078-11D0-89E4-00C04FC9E26E}", True
'
' ie.ShowBrowserBar "{EFA24E63-B078-11D0-89E4-00C04FC9E26E}", True
三、 MSHTML中的语法解释
以下是利用了MSHTML.DLL的语法分析功能， 模仿《程序员大本营2001》中的BORLAND专刊中的查找所有链结的代码。
Dim strFilePath As String
Dim WithEvents MyIE As SHDocVw.InternetExplorer
Private Sub Command1_Click()
On Error Resume Next
Me.dlgOpen.ShowOpen
strFilePath = dlgOpen.FileName
Me.brwIE.Navigate2 strFilePath
End Sub
Private Sub Command2_Click()
'On Error Resume Next
Dim doc As IHTMLDocument2 ‘IHTML文档
Set doc = Me.brwIE.Document
Dim eles As IHTMLElementCollection ‘IHTML元素集合
Dim ele As IHTMLElement
Dim strLink As String
Dim ancho As IHTMLAnchorElement ‘矛点元素
Dim img As IHTMLImgElement
Dim i As Integer
i = 0
List1.Clear
If doc Is Nothing Then
' MsgBox "Document is nothing!"
Else
Set eles = doc.All
For Each ele In eles
If ele.tagName = "A" Then
strLink = ele.innerText
If strLink = "" Then
strLink = "Empty!"
End If
Set ancho = ele
strLink = strLink & " -- " & ancho.href
List1.AddItem strLink
End If
Next
Text1 = doc.mimeType
End If
End Sub
Private Sub Form_Load()
Set MyIE = CreateObject("InternetExplorer.Application")
MyIE.Visible = True
End Sub
四、SHDOCVW.DLL和INETCPL中的API
Public Const MAX_PATH = 260
Public Const CSIDL_FAVORITES = &H6
Public Declare Function LaunchInternetControlPanel Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long
Public Declare Function LaunchConnectionDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long
Public Declare Function LaunchSecurityDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long
Public Declare Function LaunchSiteCertDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long
Public Declare Function OpenFontsDialog Lib "inetcpl.cpl" (ByVal hwndParent As Long) As Long
Public Declare Function DoOrganizeFavDlg Lib "shdocvw.dll" (ByVal hwndParent As Long, ByVal lpszPath As String) As Long
Public Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (ByVal hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal fCreate As Long) As Long
Public Declare Function DoAddToFavDlg Lib "shdocvw.dll" (ByVal hwndParent As Long, ByVal lpszPath As String) As Long
Public Declare Function AddUrlToFavorites Lib "shdocvw.dll" (ByVal hwndParent As Long, ByVal lpszPath As String) As Long ‘这个函数的参数定义有问题。
'
'Private Sub Command1_Click()
' Dim rc As Long
'’显示INTERNET选项的控制面板
' rc = LaunchInternetControlPanel(Me.hWnd)
' Debug.Print GetLastError
' If rc = 0 Then
' MsgBox "LaunchInternetControlPanel failed!", vbExclamation
' End If
'End Sub
'
'Private Sub Command2_Click()
' Dim rc As Long
'’IE控制面板中的连接面板
' rc = LaunchConnectionDialog(Me.hWnd)
' Debug.Print GetLastError
' If rc = 0 Then
' MsgBox "LaunchConnectionDialog failed!", vbExclamation
' End If
'End Sub
'
'Private Sub Command3_Click()
' Dim rc As Long
' Dim strFavPath As String * MAX_PATH
'’收藏夹所在的目录
' SHGetSpecialFolderPath Me.hWnd, strFavPath, CSIDL_FAVORITES, False
整理收藏夹
' rc = DoOrganizeFavDlg(Me.hWnd, strFavPath)
' Debug.Print GetLastError
' If rc = 0 Then
' MsgBox "DoOrganizeFavDlg failed!", vbExclamation
' End If
'End Sub
'
'Private Sub Command4_Click()
' Dim rc As Long
'
' rc = LaunchSiteCertDialog(Me.hWnd)
' Debug.Print GetLastError
' If rc = 0 Then
' MsgBox "LaunchSiteCertDialog failed!", vbExclamation
' End If
'End Sub
'
'
'
'Private Sub Command6_Click()
' Dim rc As Long
' Dim strFavPath As String * MAX_PATH
'
' SHGetSpecialFolderPath Me.hWnd, strFavPath, CSIDL_FAVORITES, False
‘添加到收藏夹，但这个函数的参数我没有实验处理，会出错。
' rc = AddUrlToFavorites(Me.hWnd, Trim(strFavPath))
' Debug.Print GetLastError
' If rc = 0 Then
' MsgBox "DoOrganizeFavDlg failed!", vbExclamation
' End If
'
'End Sub
总结
其实已经有很多文章写了这方面的内容了，我还是把这些心得写出来给大家分享。是因为想整理出一个比较全的东西来给大家参考。其实还有很多功能我还无法实现，例如，如何在WEBBROWSERCONTROL中屏蔽或改掉右键菜单，因为，WEBBROWSER CONTROL没有提供HWND给我们用；还不知道怎样取得WEBBROWSER控件中的网页代码，和实现全屏；在WEBBROWSER控件中查找；改变网页文字的大小，和编码等等。大家如果有什么新的发现，记得告诉我(mousebox@21cn.com)。
