frmbrowser.frm

vb编程+从基础到实践光盘代码

End If
End Sub

Private Sub brwWebBrowser_TitleChange(ByVal Text As String)
'当前浏览的网页的标题发生改变时，发生该事件
Me.Caption = Text
Dim tempDB As Database
Dim tempRec
Set tempDB = DBEngine.OpenDatabase(App.Path & "\" & "faveLocation.mdb")
Set tempRec = tempDB.OpenRecordset("history", dbOpenDynaset)
'将新网页加入记录着历史记录的数据库中
With tempRec
    .AddNew
    !hisSub = Me.Caption
    !hisLocation = brwWebBrowser.LocationURL
    .Update
End With
tempRec.Close
tempDB.Close
End Sub


Private Sub Form_Load()
On Error Resume Next
Me.Show
tbToolBar.Refresh
Form_Resize
cboAddress.Move 50, lblAddress.Top + lblAddress.Height + 15
Dim i As Integer
Dim strTemp As String
Dim strAdd As String
For i = 0 To 9
  strTemp = CStr(i)
  '从注册表中读取上一次浏览时的地址
  strAdd = GetSetting(App.Title, "address", "add" & strTemp, "no address")
  If strAdd <> "no address" And strAdd <> "" Then
    cboAddress.AddItem strAdd, 0
  End If
Next i
'将浏览器的起始地址设定为"http://166.111.167.44/index.html"
cboAddress.Text = "http://166.111.167.44/index.html"
If Len(StartingAddress) > 0 Then
    cboAddress.Text = StartingAddress
    cboAddress.AddItem cboAddress.Text
    '尝试定位到起始地址
    timTimer.Enabled = True
    brwWebBrowser.Navigate StartingAddress
End If
End Sub

Private Sub brwWebBrowser_DownloadComplete()
'网页下载完成后发生该事件
    On Error Resume Next
    staBar.Panels(1).Text = brwWebBrowser.LocationName
    proBar.Value = 0
End Sub

Private Sub brwWebBrowser_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'当浏览一个新的网页时发生该事件
On Error Resume Next
Dim i As Integer
Dim bFound As Boolean
'在状态栏中显示新网页的地址名
staBar.Panels(1).Text = brwWebBrowser.LocationName
For i = 0 To cboAddress.ListCount - 1
    If cboAddress.List(i) = brwWebBrowser.LocationURL Then
        bFound = True
        Exit For
    End If
Next i
mbDontNavigateNow = True
If bFound Then
    cboAddress.RemoveItem i
End If
cboAddress.AddItem brwWebBrowser.LocationURL, 0
cboAddress.ListIndex = 0
mbDontNavigateNow = False
End Sub

Private Sub cboAddress_Click()
'从地址栏选取地址
If mbDontNavigateNow Then Exit Sub
timTimer.Enabled = True
brwWebBrowser.Navigate cboAddress.Text
End Sub

Private Sub cboAddress_KeyPress(KeyAscii As Integer)
On Error Resume Next
tempstr = tempstr & Chr$(KeyAscii)
keyTime = Len(tempstr)
If KeyAscii = vbKeyReturn Then
    Dim tempflag As Integer
    tempflag = 1
    For i = 0 To cboAddress.ListCount - 1
        If cboAddress.Text = cboAddress.List(i) Then
            tempflag = -1
            Exit For
        End If
    Next i
    If tempflag = 1 Then
        cboAddress.AddItem cboAddress.Text, 0
    End If
    tempstr = ""
    cboAddress_Click
    keyTime = 0
End If
End Sub

Private Sub Form_Resize()
'当窗体大小发生改变时，调整窗体中相应控件的大小与位置
    On Error Resume Next
        If frmBrowser.Width < 6000 Then frmBrowser.Width = 6000
        brwWebBrowser.Left = 70
        brwWebBrowser.Top = 100 + picAddress.Top + picAddress.Height
        cboAddress.Width = Me.ScaleWidth - 100
        brwWebBrowser.Width = Me.ScaleWidth - 100
        brwWebBrowser.Height = Me.ScaleHeight - (picAddress.Top + picAddress.Height) - 100 - staBar.Height
        proBar.Top = staBar.Top + 75
        proBar.Left = frmBrowser.Width - 3750
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
Dim strTemp As String
'将地址栏的地址加入到注册表中，便于下次读取，以初始化地址栏
For i = 0 To 9
  strTemp = CStr(i)
  If i < cboAddress.ListCount Then
    SaveSetting App.Title, "address", "add" & strTemp, cboAddress.List(i)
  Else
    SaveSetting App.Title, "address", "add" & strTemp, "no address"
  End If
Next i
Dim tempDB As Database
Dim tempRec
Set tempDB = DBEngine.OpenDatabase(App.Path & "\" & "faveLocation.mdb")
Dim strSql As String
strSql = "select count(*) from history"
Set tempRec = tempDB.OpenRecordset(strSql, dbOpenSnapshot)
Dim delNum As Integer
'计算收藏历史记录的数据库的数量，如果超过设定的最大值，则将最旧的记录删除
delNum = tempRec!Expr1000 - Val(frmHistory.txtMaxNum.Text)
tempRec.Close
If delNum > 0 Then
    Set tempRec = tempDB.OpenRecordset("history", dbOpenDynaset)
    tempRec.MoveFirst
    For i = 0 To delNum - 1
        With tempRec
        .Delete
        .MoveNext
        End With
    Next i
    tempRec.Close
End If
tempDB.Close
For i = 0 To Forms.Count - 1
  Unload Forms(i)
Next i
End Sub

Private Sub mnuHistory_Click()
'显示收藏历史记录的对话框
frmHistory.Show vbModal
frmBrowser.brwWebBrowser.Navigate frmBrowser.cboAddress.Text
End Sub

Private Sub mnuMyfave_Click()
'取得当前浏览的网页的标题和地址，显示收藏夹的对话框
frmFave.txtAdd.Text = cboAddress.Text
frmFave.txtSubject.Text = Me.Caption
frmFave.Show vbModal
End Sub

Private Sub mnuNewBro_Click()
'新建浏览器的窗体
Shell App.Path & "/" & App.EXEName
End Sub

Private Sub mnuOffline_Click()
'设置脱及机浏览属性
mnuOffline.Checked = Not mnuOffline.Checked
frmBrowser.brwWebBrowser.Offline = mnuOffline.Checked
End Sub

Private Sub mnuOpen_Click()
'显示打开网址或文件的对话框
frmOpen.Show vbModal
End Sub

Private Sub mnuQuit_Click()
'退出程序
Unload Me
End Sub

Private Sub mnuStatus_Click()
'显示或隐藏状态栏
mnuStatus.Checked = Not mnuStatus.Checked
If mnuStatus.Checked = True Then
    staBar.Visible = True
    proBar.Visible = False
    brwWebBrowser.Height = brwWebBrowser.Height - staBar.Height
Else
    staBar.Visible = False
    proBar.Visible = True
    brwWebBrowser.Height = brwWebBrowser.Height + staBar.Height
End If
End Sub

Private Sub mnuToolbar_Click()
'显示或隐藏工具栏，并且调整窗体中各个控件的大小及位置
mnuToolbar.Checked = Not mnuToolbar.Checked
tbToolBar.Visible = Abs(mnuToolbar.Checked)
Call Form_Resize
End Sub

Private Sub timTimer_Timer()
'时钟控件事件监控浏览器下载的信息
    If brwWebBrowser.Busy = False Then
        timTimer.Enabled = False
        staBar.Panels(1).Text = brwWebBrowser.LocationName
    Else
        staBar.Panels(1).Text = "正在下载......"
    End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As Button)
    '处理工具栏上的按扭被点击的事件
    On Error Resume Next
    timTimer.Enabled = True
    Select Case Button.Key
        Case "Back"
        '浏览上一个网页
            brwWebBrowser.GoBack
        Case "Forward"
        '浏览前一个网页
            brwWebBrowser.GoForward
        Case "Refresh"
        '刷新当前网页
            brwWebBrowser.Refresh
        Case "Home"
        '回到起始网页
            brwWebBrowser.GoHome
        Case "Search"
        '搜索网页
            brwWebBrowser.GoSearch
        Case "Stop"
        '停止下载网页
            timTimer.Enabled = False
            brwWebBrowser.Stop
            staBar.Panels(1).Text = brwWebBrowser.LocationName
    End Select
End Sub