利用VB制作一个IE浏览器,希望添加这样的一项
发布网友
发布时间：2022-07-19 09:31
共2个回答
热心网友
时间：2023-10-15 12:58
1、首先打开VB，生成一个新的“标准EXE”程序。然后添加“Microsoft Internet Controls
”和“Microsoft Windows Common Controls 6.0”两个控件。
2、在Form窗体上添加以下控件：ComboBox（用于填入URL）、WebBrowser（用于显示网页内容）、
ToolBar（显示工具栏）、StatusBar（在浏览器下方显示状态）、ProgressBar（显示网页下载
速度）、ImageList（设置工具栏上的图标）。
3、首先创建工具栏。右击Imagelist控件选中“属性”。在弹出的对话框中点击“图像”标签，
插入图标。我创建了几个，如果你有更好的你就插入你的图标。
4、右击ToolBar1控件选中“属性”。在弹出的对话框“通用”标签中下拉“图像列表”选中
“ImageList1”。然后点击“按钮”重复6次点击“插入按钮”，在“关键字”中分别输入“Back、
Forward、Stop、Refresh、Home、Search”，注意大小写，否则后面的代码要出错了。在“文本提
示”中输入“后退”、“前进”、“停止”、“刷新”、“主页”、“搜索”，并修改每个按钮的
“图像”为相应的编号。别弄错了。
5、下面输入代码。我打包。上面有注释。慢慢的斟酌。呵呵~~~
6、生成工程。
以下是代码
Private Sub Combo1_Click()
WebBrowser1.Navigate Combo1.Text
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim I As Long
Dim existed As Boolean
If KeyCode = 13 Then
If Left(Combo1.Text, 7) <> "http://" Then
Combo1.Text = "http://" + Combo1.Text
End If
WebBrowser1.Navigate Combo1.Text '打开Combo1中的网址
For I = 0 To Combo1.ListCount - 1
If Combo1.List(I) = Combo1.Text Then
existed = True
Exit For
Else
existed = False
End If
Next
If Not existed Then
Combo1.AddItem (Combo1.Text)
End If
End If
End Sub
Private Sub Form_Load() '窗体加载
Combo1.Text = ""
Combo1.Top = Toolbar1.Height
Combo1.Left = 0
WebBrowser1.Top = Combo1.Top + Combo1.Height
WebBrowser1.Left = 0
Form_Resize
StatusBar1.Style = sbrSimple
ProgressBar1.ZOrder
End Sub
Private Sub Form_Resize() '当窗体大小发生改变时，如最大化时
Combo1.Width = Form1.Width - 100
WebBrowser1.Width = Combo1.Width
WebBrowser1.Height = Form1.Height - Combo1.Height - 1000
ProgressBar1.Top = Me.Height - StatusBar1.Height - 330
ProgressBar1.Left = 0.25 * StatusBar1.Width
ProgressBar1.Width = 0.25 * Me.Width - 250
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) '双击工具栏后输入的代码
On Error Resume Next '基本按钮的功能设置
Select Case Button.Key
Case "Back" '后退按钮
WebBrowser1.GoBack
Case "Forward" '前进按钮
WebBrowser1.GoForward
Case "Refresh" '刷新按钮
WebBrowser1.Refresh
Case "Home" '主页按钮
WebBrowser1.GoHome
Case "Search" '搜索按钮
WebBrowser1.GoSearch
Case "Stop" '停止按钮
WebBrowser1.Stop
Me.Caption = WebBrowser1.LocationName
End Select
End Sub
Private Sub WebBrowser1_DownloadBegin()
StatusBar1.SimpleText = "Now Linking……" '下载开始时显示"Now Linking……
End Sub
Private Sub WebBrowser1_DownloadComplete()
StatusBar1.SimpleText = "Link Finished" '下载结束时显示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的设置
ProgressBar1.Max = ProgressMax
If Progress <> -1 And Progress <= ProgressMax Then
ProgressBar1.Value = Progress
End If
End Sub
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
Combo1.Text = WebBrowser1.LocationURL
End Sub
热心网友
时间：2023-10-15 12:59
转换UrlEncode函数编码后的字符串为原字符串。
Public Function UniCodeToGb(ByVal ToDoString As String) As String
On Error Resume Next
Dim Dig As Integer: Dim GBStr As String
For Dig = 1 To Len(ToDoString)
If Mid(ToDoString, Dig, 1) = "%" Then
If Len(ToDoString) >= Dig + 8 Then
GBStr = GBStr & ConvChinese(Mid(ToDoString, Dig, 9))
Dig = Dig + 8
Else
GBStr = GBStr & Mid(ToDoString, Dig, 1)
End If
Else
GBStr = GBStr & Mid(ToDoString, Dig, 1)
End If
Next
UniCodeToGb = GBStr
End Function
'*******************************************************************
'Gb2312转为UTF-8的函数。
Public Function Ascii(ByVal ToDoString)
On Error Resume Next
If LCase(ChineseType) = "complex" Then ToDoString = JToF(ToDoString)
If LCase(ChineseType) = "simple" Then ToDoString = FToJ(ToDoString)
Dim strOutBuf
Dim p1, p2, p3
Dim t1, t2
p1 = 1
p2 = InStr(p1, ToDoString, "&")
While p2 > 0
p3 = InStr(p2, ToDoString, ";")
If p3 > 0 Then
t1 = Mid(ToDoString, p2, p3 - p2)
If LCase(Left(t1, 3)) = "&#x" And IsNumeric("&H" + Mid(t1, 4)) Then
ElseIf Left(t1, 2) = "&#" And IsNumeric(Mid(t1, 3)) Then
ElseIf t1 <> "<" And t1 <> ">" And t1 <> "&apos" And t1 <> """ And t1 <> "&" And t1 <> " " Then
ToDoString = Left(ToDoString, p2 - 1) + Replace(ToDoString, "&", "&", p2, 1)
End If
Else
ToDoString = Left(ToDoString, p2 - 1) + Replace(ToDoString, "&", "&", p2, 1)
End If
p2 = InStr(p2 + 1, ToDoString, "&")
Wend
For t1 = 1 To Len(ToDoString)
If AscW(Mid(ToDoString, t1, 1)) > 255 Or AscW(Mid(ToDoString, t1, 1)) < 32 Then
If AscW(Mid(ToDoString, t1, 1)) <> 0 Then strOutBuf = strOutBuf + "&#x" + Hex(AscW(Mid(ToDoString, t1, 1))) + ";"
Else
strOutBuf = strOutBuf + Mid(ToDoString, t1, 1)
End If
Next
Ascii = strOutBuf
End Function
