給自己的程式增加網頁瀏覽功能（續） (轉)[@more@]

給自己的增加網頁瀏覽功能（續）

Private Sub mnuFileSaveAs_Click()

brwBrowser.SetFocus

On Error Resume Next

brwWebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT

‘另存為

‘以下是用原始的方式另存為

' Dim ile As String

'

' With dlgCommonDialog

' .DialogTitle = "另存為..."

' .CancelError = False

' '.FileName = Me.brwWebBrowser.LocationName

' 'ToDo: 設定 common dialog 的標誌和屬性

' "|圖形檔案(*.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

:namespace prefix = o ns = "urn:schemas--com::office" />

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 , 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

用了開啟INTE選項的控制皮膚，也可以用SHDOCVW.DLL提供的開啟。

Private Sub mnuToolOption_Click()

Dim lReturn As Double

dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLLcpl.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 As SHDocVw.InternetExplorer

'

' Set ie = CreateObject("InternetExplorer.Application") ‘建立一個例項

'' ie.Navigate2 "C:"

' ie.FullScreen = False ‘是否全屏

' ie.Visible = True

' ie.ToolBar = True ‘是否顯示工具條

' ie.MenuBar = True ‘是否顯示選單

' ie.Statar = True ‘是否顯示狀態條

' ie.Resizable = False ‘是否可變視窗大小。

'在中，增加了個人欄，加上搜尋欄、收藏夾和歷史共有四個瀏覽條。以下是控制顯示以下四個瀏覽條的程式碼。

'' 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

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)

' De.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控制元件中查詢；改變網頁文字的大小，和編碼等等。大家如果有什麼新的發現，記得告訴我(to:mousebox@21cn.com">mousebox@21cn.com)。

給自己的程式增加網頁瀏覽功能（續） (轉)

相關文章