frmbrowser.frm

vb实用编程150例(光盘) 是我从网上下载的

Private Sub cmdHome_Click()
    WebBrowser1.Navigate ("ram.ourfamily.com")
    sitelist.text = WebBrowser1.LocationURL
End Sub
Private Sub Maximizeimage_Click()
    frmBrowser.WindowState = 0
End Sub
Private Sub cmdhome_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdhome.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub cmdhome_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdhome.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdhome_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdhome.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub Minimizeimage_Click()
    Me.WindowState = 1
End Sub
Private Sub minimizeimage_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
    minimizeimage.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub minimizeimage_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    'minimizeimage.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub minimizeimage_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
    minimizeimage.SpecialEffect = fmSpecialEffectFlat
End Sub
Private Sub cmdprint_Click()
'    Dim eQuery As OLECMDF       'return value type for QueryStatusWB
'
'    On Error Resume Next
'    eQuery = WebBrowser1.QueryStatusWB(OLECMDID_PRINT)  'get print command status
'    If Err.Number = 0 Then
'        If eQuery And OLECMDF_ENABLED Then
'                WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, "", ""    'Ok to Print?
'          Else
'                MsgBox "The Print command is currently disabled."
'        End If
'    End If
'    If Err.Number <> 0 Then MsgBox "Print command Error: " & Err.Description
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub cmdprint_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdprint.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub cmdprint_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdprint.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdprint_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdprint.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdReload_Click()
    WebBrowser1.Refresh
End Sub
Private Sub cmdreload_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdreload.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub cmdreload_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdreload.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdreload_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdreload.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdSearch_Click()
    WebBrowser1.GoSearch
End Sub
Private Sub cmdsearch_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdsearch.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub cmdsearch_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdsearch.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdsearch_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdsearch.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdStop_Click()
    WebBrowser1.Stop
End Sub
Private Sub cmdstop_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdstop.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub cmdstop_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdstop.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub cmdstop_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
    cmdstop.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub EditImage_Click()
    EditImage.SpecialEffect = fmSpecialEffectSunken
    fileimage.SpecialEffect = fmSpecialEffectFlat
    GoImage.SpecialEffect = fmSpecialEffectFlat
    ViewImage.SpecialEffect = fmSpecialEffectFlat
    PopupMenu mnuEditMain, , 1300, 320
End Sub
Private Sub EditImage_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    EditImage.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub fileimage_Click()
    fileimage.SpecialEffect = fmSpecialEffectSunken
    EditImage.SpecialEffect = fmSpecialEffectFlat
    GoImage.SpecialEffect = fmSpecialEffectFlat
    ViewImage.SpecialEffect = fmSpecialEffectFlat
    PopupMenu mnuFileMain, , 660, 320
End Sub
Private Sub fileimage_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    fileimage.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub Form_Click()
    fileimage.SpecialEffect = fmSpecialEffectFlat
End Sub
Private Sub Form_Load()
  
     WebBrowser1.StatusBar = True
    KeyPreview = True
    WebBrowser1.Navigate ("ram.ourfamily.com")
    'frmWebBrowser.webbrowser1.Navigate "asterix.wmi.co.in/mail/mmstdo.cgi"
    siteno = 0
    Site = "Nothing"
    While siteno <> 11 And Site <> ""
        Site = GetSetting("ezconnect", "sitelist", "site" & siteno)
        If Site <> "" Then
            siteno = siteno + 1
            sitelist.AddItem Site
        End If
    Wend
End Sub
Private Sub Form_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    fileimage.SpecialEffect = fmSpecialEffectFlat
    EditImage.SpecialEffect = fmSpecialEffectFlat
    GoImage.SpecialEffect = fmSpecialEffectFlat
    ViewImage.SpecialEffect = fmSpecialEffectFlat
    cmdback.SpecialEffect = fmSpecialEffectFlat
    cmdforward.SpecialEffect = fmSpecialEffectFlat
    cmdreload.SpecialEffect = fmSpecialEffectFlat
    cmdhome.SpecialEffect = fmSpecialEffectFlat
    cmdstop.SpecialEffect = fmSpecialEffectFlat
    cmdprint.SpecialEffect = fmSpecialEffectFlat
    cmdsearch.SpecialEffect = fmSpecialEffectFlat
    cmdbookmark.SpecialEffect = fmSpecialEffectFlat
End Sub
Private Sub Form_Unload(Cancel As Integer)
    siteno = 0
End Sub
Private Sub GoImage_Click()
    GoImage.SpecialEffect = fmSpecialEffectSunken
    EditImage.SpecialEffect = fmSpecialEffectFlat
    fileimage.SpecialEffect = fmSpecialEffectFlat
    ViewImage.SpecialEffect = fmSpecialEffectFlat
    PopupMenu mnuGoMain, , 2685, 320
End Sub
Private Sub GoImage_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    GoImage.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub Image1_Click()
    If imgclik = "" Then
        sitelist.DropDown
        imgclik = "yes"
    Else
        imglik = ""
    End If
End Sub
Private Sub Image1_MouseDown(button As Integer, Shift As Integer, X As Single, Y As Single)
    Image1.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub Image1_MouseUp(button As Integer, Shift As Integer, X As Single, Y As Single)
    Image1.SpecialEffect = fmSpecialEffectFlat
End Sub
Private Sub m_oWbSink_StatusTextChange(ByVal text As String)
    StatusBar1.Panels(1).text = text
End Sub
Private Sub mnuBookmarkAdd_Click()
    'mnuBookmarkMain
End Sub
Private Sub mnuEditCopy_Click()
    WebBrowser1.SetFocus
    WebBrowser1.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuEditFind_Click()
    WebBrowser1.SetFocus
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_FIND, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuEditPaste_Click()
    WebBrowser1.SetFocus
    WebBrowser1.ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuEditSelectAll_Click()
    WebBrowser1.SetFocus
    WebBrowser1.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
Private Sub mnuFileHomePage_Click()
    cmdHome_Click
End Sub
Private Sub mnuFileNewWindow_Click()
    Set F = New frmBrowser
    F.Show
End Sub
Private Sub mnuFileOpenPage_Click()
    frmopen.Show
End Sub
Private Sub mnuFilePageSetup_Click()
    WebBrowser1.SetFocus
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuFilePrint_Click()
    WebBrowser1.SetFocus
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuFilePrintPreview_Click()
    WebBrowser1.SetFocus
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuFileProperties_Click()
    WebBrowser1.SetFocus
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuFileSavePage_Click()
    WebBrowser1.SetFocus
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_SAVE, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuGoBack_Click()
    On Error Resume Next
    WebBrowser1.GoBack
End Sub
Private Sub mnuGoForward_Click()
    On Error Resume Next
    WebBrowser1.GoForward
End Sub
Private Sub mnuGoHome_Click()
    WebBrowser1.GoHome
End Sub
Private Sub mnuGoSearch_Click()
    WebBrowser1.GoSearch
End Sub
Private Sub mnuSavePageAs_Click()
    WebBrowser1.SetFocus
    On Error Resume Next
    WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub mnuViewRefresh_Click()
    WebBrowser1.Refresh
End Sub
Private Sub mnuViewStatusbar_Click()
    mnuViewStatusbar.Checked = Not mnuViewStatusbar.Checked = True
    ProgressBar1.Visible = Not ProgressBar1.Visible = True
    StatusBar1.Visible = Not StatusBar1.Visible = True
    If StatusBar1.Visible = False Then
        WebBrowser1.Height = WebBrowser1.Height + 255
    Else
        WebBrowser1.Height = WebBrowser1.Height - 255
    End If
End Sub
Private Sub mnuViewStop_Click()
    WebBrowser1.Stop
End Sub
Private Sub sitelist_Click()
    If mykeypressed <> "yes" Then
        WebBrowser1.Navigate sitelist.text
    End If
End Sub
Private Sub sitelist_KeyDown(KeyCode As MSForms.ReturnInteger, Shift As Integer)
    If KeyCode = 13 Then
        If sitelist.MatchFound = False Then
            'cmdStop.SetFocus
            If Not sitelist.ListCount > 10 Then
                SaveSetting "ezconnect", "sitelist", "site" & sitelist.ListCount, sitelist.text
            Else
                SaveSetting "ezconnect", "sitelist", "site" & sitelist.ListCount + 1 - 10, sitelist.text
            End If
        
            sitelist.AddItem sitelist.text
        End If
        WebBrowser1.Navigate sitelist.text
        mykeypressed = ""
    End If
End Sub
Private Sub sitelist_KeyPress(KeyAscii As MSForms.ReturnInteger)
    mykeypressed = "yes"
End Sub
Private Sub Timer1_Timer()
    If download = "Yes" Then
'        Static lCount As Long
'
'        lCount = lCount + 5
'
'        If lCount > 100 Then
'            Timer1.Enabled = False
'            ShowProgressInStatusBar False
'            lCount = 0
'        End If
'
'        ProgressBar1.Value = lCount
        
        
        
        Dim Counter As Integer
        Dim Workarea(250) As String

        ProgressBar1.Min = LBound(Workarea)
        ProgressBar1.Max = UBound(Workarea)
        ProgressBar1.Visible = True
        'Set the Progress's Value to Min.
        ProgressBar1.Value = ProgressBar1.Min
        'Loop through the array.

        For Counter = LBound(Workarea) To UBound(Workarea)
            'Set initial values for each item in the array.
            Workarea(Counter) = "Initial value" & Counter
            'ShowProgressInStatusBar False
            ProgressBar1.Value = Counter
        Next Counter
        For Counter = UBound(Workarea) To LBound(Workarea) Step -1
            'Set initial values for each item in the array.
            Workarea(Counter) = "Initial value" & Counter
            'ShowProgressInStatusBar False
            ProgressBar1.Value = Counter
        Next Counter
'       ProgressBar1.Visible = False
        'ShowProgressInStatusBar False
        ProgressBar1.Value = ProgressBar1.Min
'        If Shape1.FillColor = RGB(0, 255, 0) Then
'            Shape1.FillColor = RGB(0, 0, 255)
'        Else
'            Shape1.FillColor = RGB(0, 255, 0)
'
'        End If
    Else
        If WebBrowser1.Busy = False And flag1 = "" Then
            StatusBar1.Panels(1).text = "Document done"
        End If
    End If
End Sub
Private Sub ViewImage_Click()
    ViewImage.SpecialEffect = fmSpecialEffectSunken
    GoImage.SpecialEffect = fmSpecialEffectFlat
    EditImage.SpecialEffect = fmSpecialEffectFlat
    fileimage.SpecialEffect = fmSpecialEffectFlat
    PopupMenu mnuViewMain, , 1985, 320
End Sub
Private Sub ViewImage_MouseMove(button As Integer, Shift As Integer, X As Single, Y As Single)
    ViewImage.SpecialEffect = fmSpecialEffectRaised
End Sub
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    myurl = URL
    sitelist.text = URL
    StatusBar1.Panels(1).text = "Connecting to host " & URL
    On Error Resume Next
    
    'StatusBar1.Panels(1).Text = WebBrowser1.StatusText
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    StatusBar1.Panels(1).text = "Document done"
End Sub
Private Sub webbrowser1_DownloadBegin()
    'StatusBar1.Panels(1).Text = "Connecting to host"
    download = "Yes"
    On Error Resume Next
    sitelist.text = myurl
    ShowProgressInStatusBar True
End Sub
Private Sub WebBrowser1_DownloadComplete()
    StatusBar1.Panels(1).text = "Document done"
    download = "No"
End Sub
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
    StatusBar1.Panels(1).text = "Document done"
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
    On Error Resume Next
    'WebBrowser1.ClientToWindow
    Cancel = False
    'WebBrowser1.ExecWB OLECMDID_NEW, OLECMDEXECOPT_DODEFAULT
    'mnuFileNewWindow_Click
    'WebBrowser1.Navigate Mid(StatusBar1.Panels(1).text, 13)
End Sub
Private Sub WebBrowser1_StatusTextChange(ByVal text As String)
    flag1 = "Yes"
    On Error Resume Next
    StatusBar1.Panels(1).text = text
End Sub
Private Sub ShowProgressInStatusBar(ByVal bShowProgressBar As Boolean)

    Dim tRC As RECT

    If bShowProgressBar Then
'
' Get the size of the Panel (2) Rectangle from the status bar
' remember that Indexes in the API are always 0 based (well,
' nearly always) - therefore Panel(2) = Panel(1) to the api
'
'
        SendMessageAny StatusBar1.hwnd, SB_GETRECT, 1, tRC
'
' and convert it to twips....
'
        With tRC
            .Top = (.Top * Screen.TwipsPerPixelY)
            .Left = (.Left * Screen.TwipsPerPixelX)
            .Bottom = (.Bottom * Screen.TwipsPerPixelY) - .Top
            .Right = (.Right * Screen.TwipsPerPixelX) - .Left
        End With
'
' Now Reparent the ProgressBar to the statusbar
'
        With ProgressBar1
            SetParent .hwnd, StatusBar1.hwnd
            .Move tRC.Left, tRC.Top, tRC.Right, tRC.Bottom
            .Visible = True
            .Value = 0
        End With

    Else
'
' Reparent the progress bar back to the form and hide it
'
        SetParent ProgressBar1.hwnd, Me.hwnd
        ProgressBar1.Visible = False
    End If

End Sub