打印本文 打印本文 关闭窗口 关闭窗口
给自己的程序增加网页浏览功能(续)
作者:武汉SEO闵涛  文章来源:敏韬网  点击数1684  更新时间:2009/4/23 16:39:44  文章录入:mintao  责任编辑:mintao

 给自己的程序增加网页浏览功能(续)

 

Private Sub mnuFileSaveAs_Click()

   

brwWebBrowser.SetFocus

On Error Resume Next

brwWebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT

‘另存为   

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

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

[1] [2]  下一页

打印本文 打印本文 关闭窗口 关闭窗口