VB代码(网页)?
Private Sub Form_Load()Dim nURL As String
WebBrowser1.Silent = True '禁止显示网页脚本对话框:脚本发生错误等
Label1.UseMnemonic = False: Combo1.Text = ""
moPage = moPage + 1 '记忆打开的窗口总个数,moPage 是模块变量
If moPage = 1 Then '是第一个网页,不是弹出的网页:检查首页设置
nURL = Trim(Command)
If nURL = "" Then nURL = GetSetting(App.Title, "Opt", "Page1", " http://www.zhaoxi.net/")
If nURL <> "" And Trim(nURL) = "" Then nURL = "about:blank"
If nURL = " " Then nURL = "about:blank"
End If
Me.Tag = "Page" & moPage
If nURL = "" Then nURL = "about:blank"
Combo1.AddItem " http://www.zhaoxi.net/"
WebBrowser1.Navigate nURL
'装载数组控件
DoEvents
KjAdd Command1, "前", "to_Last", "向前:上一网页"
KjAdd Command1, "后", "to_Next", "向后:下一网页"
KjAdd Command1, "-", "bar"
KjAdd Command1, "源", "Source", "查看源文件"
KjAdd Command1, "属", "NetOpt", "Internet 属性"
KjAdd Command1, "主", "Page1", "更改主页"
KjAdd Command1, "-", "bar"
KjAdd Command1, "刷", "Refresh", "刷新"
KjAdd Command1, "转到(&G)", "GoURL", "转到指定网页"
'窗口为屏幕的 4/5 大小,并居中
On Error Resume Next
Me.Move Screen.Width * 0.1, Screen.Height * 0.1, Screen.Width * 0.8, Screen.Height * 0.8
End Sub
Private Sub NetOpt()
On Error Resume Next
Shell "Control.exe Inetcpl.cpl", 1 '打开:Internet 属性
End Sub
Private Sub Form_Resize()
'自动设置控件位置和大小
Dim I As Long, L As Single, T As Single, H As Single, H1 As Single, W As Single
H1 = Combo1.Height * 1.2: L = H1 * 0.3: T = L
L = H1 * 0.2
For I = 0 To Command1.Count - 1
If Command1(I).Caption = "-" Then '按钮分组
W = H1 * 0.5: Command1(I).Visible = False
Else
W = Me.TextWidth(Command1(I).Caption & "ab")
Command1(I).Move L, T, W, H1: Command1(I).Visible = True
End If
L = L + W + 3
Next
T = T + H1 * 0.1 + Command1(0).Height
I = Command1.Count - 1
Command1(I).Move 0, T
L = Command1(I).Left + Command1(I).Width
W = Me.ScaleWidth - L
If W > 0 Then Combo1.Move L, T + H1 * 0.1, W
T = T + Combo1.Height * 1.2: H = Me.ScaleHeight - T - Combo1.Height
If H > 0 Then WebBrowser1.Move 0, T, Me.ScaleWidth, H
T = T + WebBrowser1.Height + H1 * 0.1
Label1.Move H1 * 0.1, T, Screen.Width, Combo1.Height
End Sub
Private Function KjAdd(Kj, nCap As String, Optional nTag As String, Optional nNote As String) As Long
'为数组控件添加一个成员,返回新添加的成员序号
Dim I As Long
I = Kj.Count - 1
If Kj(I).Tag <> "" Then I = I + 1: Load Kj(I)
On Error Resume Next
Kj(I).Checked = False
Kj(I).Caption = nCap
Kj(I).Tag = nTag
Kj(I).ToolTipText = nNote
Kj(I).Visible = True
KjAdd = I
End Function
Private Sub Command1_Click(Index As Integer)
'工具栏按钮命令
nStr = LCase(Command1(Index).Tag)
Select Case nStr
Case LCase("to_Last"): On Error Resume Next: WebBrowser1.GoBack '向前
Case LCase("to_Next"): On Error Resume Next: WebBrowser1.GoForward '向后
Case LCase("Source"): Call ViewSource '查看源文件
Case LCase("GoURL"): Call Combo1_Click '转到指定网页
Case LCase("Refresh"): WebBrowser1.Refresh '刷新
Case LCase("NetOpt"): Call NetOpt 'Internet 属性
Case LCase("Page1"): Call Page1 '更改主页
End Select
End Sub
Private Sub Page1()
'更改主页
Dim nStr As String
nStr = "当前主页是:" & vbCrLf & GetSetting(App.Title, "Opt", "Page1", "about:blank")
nStr = nStr & vbCrLf & vbCrLf & "输入空格表示使用空白页。请输入新的主页:"
nStr = InputBox(nStr, "更改主页", Me.WebBrowser1.LocationURL)
If nStr <> "" Then SaveSetting App.Title, "Opt", "Page1", nStr
End Sub
Private Sub ViewSource()
'用 Form2 查看源文件
Dim NewForm As New Form2, nTag As String, nStr As String, Obj1
NewForm.Caption = "查看源文件 - " & WebBrowser1.LocationURL
NewForm.Show
On Error Resume Next
For I = 0 To WebBrowser1.Document.All.length - 1
Set Obj1 = WebBrowser1.Document.All(I)
nTag = ""
nTag = Obj1.tagName
If LCase(nTag) = "html" Then
NewForm.Text1.Text = nStr & Obj1.outerHTML
Exit Sub
Else
nStr = nStr & Obj1.outerHTML & vbCrLf
End If
Next
End Sub
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'将浏览网页的地址添加到 Combo1
Dim nStr As String
nStr = WebBrowser1.LocationURL
Combo1.Text = nStr
If Combo1.ListCount > 0 Then
If LCase(nStr) = LCase(Combo1.List(0)) Then Exit Sub
If LCase(nStr) = LCase(Combo1.List(0)) & "/" Then Exit Sub
End If
If LCase(nStr) = "about:blank" Or nStr = "" Then Exit Sub
Combo1.AddItem nStr, 0
End Sub
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
'不用 IE 而用自己的程序弹出新窗口
Dim NewForm As New Form1
Set ppDisp = NewForm.WebBrowser1.object
NewForm.Show
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
'用户在下拉列表框输入网址后,按回车转到指定网页
If KeyCode = 13 Then Call Combo1_Click
End Sub
追问:Private Sub Combo1_Click()'用户单击下拉列表框选择网址后,转到指定网页
Dim nStr As String
nStr = Trim(Combo1.Text)
If nStr <> "" Then WebBrowser1.Navigate nStr
End Sub
Private Sub WebBrowser1_StatusTextChange(ByVal Text As String)
'在窗口下面显示网页状态
If Text = "" Then Label1.Caption = "就绪" Else Label1.Caption = Text
End Sub
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
'在标题栏显示网页标题
Me.Caption = "我的浏览器 - " & Text
End Sub
' '===============以下是窗体 Form2 代码,此窗体用于查看网页源文件
'需在窗体放置一个控件:Text1,并将属性 MultiLine 设置为 True,ScrollBars 设置为 2
Private Sub Form_Load()
'窗口为屏幕的 3/5 大小,并居中
On Error Resume Next
Move Screen.Width * 0.2, Screen.Height * 0.2, Screen.Width * 0.6, Screen.Height * 0.6
End Sub
Private Sub Form_Resize()
On Error Resume Next
Text1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub