data17.dat

学习VB的经典资料 vb一点通 看后很快就会了 初学者的帮手

制作自己的浏览器

本例介绍如何使用VB来编写一个自己的浏览器。

'初始化
Private Sub Form_Load()
    ComSite.AddItem "清华大学"
    ComSite.AddItem "首都在线"
    ComSite.AddItem "中央电视台"
    ComSite.AddItem "网易"
    ComSite.AddItem "搜狐"
    ComSite.Text = "清华大学"
    '链接到主页
    WebBrowser1.GoHome
End Sub

'设置各控件的位置
Private Sub Form_Resize()
    If Form1.WindowState = 1 Then
        Exit Sub
    End If
    WebBrowser1.Left = 200
    WebBrowser1.Top = 900
    WebBrowser1.Width = Form1.ScaleWidth - 400
    WebBrowser1.Height = Form1.ScaleHeight - 1500
    ProgressBar1.Top = Form1.ScaleHeight - 300
    ProgressBar1.Left = Form1.ScaleWidth - 2200
End Sub

'链接到主页
Private Sub Comhome_Click()
    WebBrowser1.GoHome
End Sub

'后退
Private Sub Comback_Click()
    On Error GoTo ww
    WebBrowser1.GoBack
    Exit Sub
ww:
    MsgBox "没有历史记录", 64, "提示"
End Sub

'前进
Private Sub ComForward_Click()
    On Error GoTo ww
    WebBrowser1.GoForward
    Exit Sub
ww:
    MsgBox "没有历史记录", 64, "提示"
End Sub

'选择网址
Private Sub ComSite_Click()
    Select Case ComSite.Text
        Case "清华大学"
            WebBrowser1.Navigate "http://www.tsinghua.edu.cn"  '链接到清华大学主页
        Case "首都在线"
            WebBrowser1.Navigate "http://www.263.net"  '链接到清华大学主页
        Case "中央电视台"
            WebBrowser1.Navigate "http://www.cctv.com"  '链接到清华大学主页
        Case "网易"
            WebBrowser1.Navigate "http://www.163.com"  '链接到清华大学主页
        Case "搜狐"
            WebBrowser1.Navigate "http://www.sohu.com"  '链接到清华大学主页
        Case Else
            '链接到其他
            WebBrowser1.Navigate ComSite.Text
    End Select
End Sub

'在地址栏输入地址
Private Sub ComSite_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Long
    Dim existed As Boolean
    '当按下回车键
    If KeyCode = 13 Then
        If Left(ComSite.Text, 7) <> "http://" Then
            ComSite.Text = "http://" + ComSite.Text
        End If
        WebBrowser1.Navigate ComSite.Text
        For i = 0 To ComSite.ListCount - 1
            If ComSite.List(i) = ComSite.Text Then
                existed = True
                Exit For
            Else
                existed = False
            End If
        Next
        If Not existed Then
            ComSite.AddItem (ComSite.Text)
        End If
    End If
    End Sub

'web页的标题变化
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
    '在窗体标题栏上显示web页的标题
    Form1.Caption = WebBrowser1.LocationURL
    '在地址栏中显示web页的标题
    ComSite.Text = WebBrowser1.LocationURL
End Sub

'开始下载
Private Sub WebBrowser1_DownloadBegin()
    '状态栏显示“Now Linking...”
    StatusBar1.SimpleText = "Now Linking..."
End Sub

'下载完成
Private Sub WebBrowser1_DownloadComplete()
    '状态栏显示Link Finished
    StatusBar1.SimpleText = "Link Finished"
    '清除进度条
    ProgressBar1.Value = 0
End Sub
   
'下载过程
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
    '下载进行时进度条变化
    If ProgressMax = 0 Then Exit Sub
    ProgressBar1.Max = ProgressMax
    If Progress <> -1 And Progress <= ProgressMax Then
        ProgressBar1.Value = Progress
    End If
End Sub