VB WebBrowser高亮显示及取消高亮显示关键字

前面提到过在WebBrowser中实现查找关键字及高亮显示关键字的功能,不晓得大家有没有发现那个高亮显示关键字的函数,高亮显示它是实现了,但是确没法把已经高亮显示的关键字的背景颜色取消掉,这个问题困惑我好长一段时间,在网上寻找答案也无语,只能自己去想办法了,于是我就在想,在找到关键字时先取得关键字的背景颜色,然后再替换选择的关键字背景。我找到了WebBrowser的一个属性BackColor设置或返回选择区域的背景色,我就想用它来返回背景色,但是就是无法返回背景色,但是让我发现了用它来设置指定区的背景色,当我不设置任何背景色时得到得是原本没用改变过的颜色,这不正好是我想要的结果嘛!!!!不敢独享,拿出来与大家共同分享。转载请保留作者信息。谢谢!!!!

Public Enum FBackColor
   红色 = 1
   绿色 = 2
   蓝色 = 3
   黄色 = 4
   紫色 = 5
   灰色 = 6
   棕色 = 7
   取消 = 8

   自定义=9
End Enum

'*************************************************************************
'**函 数 名:FindBright
'**输    入:Text(String) 要查找的关键字             -
'**        :FindBackColor(FBackColor)要实现的背景色,可以是标准的颜色索引 -
'**        :Web(WebBrowser)浏览器控件           -
'**输    出:(Boolean '高亮或取消高亮显示关键字                                                                                                                                                               '**功能描述:
'**全局变量:
'**调用模块:
'**作    者:陈 峰
'**日    期:2009-04-06 09:27:15
'**版    本:V1.0.0
'*************************************************************************
Public Function FindBright(Text As String, FindBackColor As FBackColor, Optional UserBackColor As Long) As Boolean '高亮或取消高亮显示关键字
    On Error Resume Next
    Dim texbody As HTMLBody
    Dim Rng As MSHTML.IHTMLTxtRange
    Dim BACKColos As String
    If FindBackColor = 红色 Then
        BACKColos = "Red"
    ElseIf FindBackColor = 黄色 Then
        BACKColos = "Yellow"
    ElseIf FindBackColor = 蓝色 Then
        BACKColos = "Blue"
    ElseIf FindBackColor = 绿色 Then
        BACKColos = "Green"
    ElseIf FindBackColor = 紫色 Then
        BACKColos = "Purple"
    ElseIf FindBackColor = 灰色 Then
        BACKColos = "Gray"
    ElseIf FindBackColor = 棕色 Then
        BACKColos = "Brown"
    ElseIf FindBackColor = 自定义 Then
        BACKColos = UserBackColor
    Else
        BACKColos = Null
    End If
    Set webdoc = WB(intFocus).document
    Set texbody = webdoc.body
    Set Rng = texbody.createTextRange()
    If Rng.findText(Text) = False Then FindBright = False: Exit Function
    Do While Rng.findText(Text) <> False
        Rng.findText Text
        'Rng.Select       '防止选择是页面滚动,将选择关键字取消掉
        'Rng.pasteHTML "<span style='background:" & BACKColos & "'>" + Text + "</span>"
        Rng.execCommand "BackColor", True, BACKColos     '高亮关键字
        Rng.collapse False
    Loop
    If BACKColos <> "" Then KeyWord(intFocus) = True Else KeyWord(intFocus) = False
    Rng.execCommand "Unselect", True, Null     '取消选中状态
    Rng.collapse True
    FindBright = True
End Function

'--------------高亮显示关键字------------------
Private Sub Command1_Click()
FindBright Text1.text, 黄色, WebBrowser1
End Sub
'--------------取消高亮显示关键字------------------
Private Sub Command2_Click()
FindBright Text1.text, 取消, WebBrowser1
End Sub

Private Sub Form_Load()
WebBrowser1.Navigate2 "www.baidu.com"
End Sub

  • 1
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值