Hossis
چهارشنبه 08 بهمن 1393, 16:21 عصر
با سلام
بالاخره تونستم با کمک عبارت با قاعده (REGEX) جستجوی در متن اعراب دار رو انجام بدم
با این کد می تونید کلماتی رو که اعراب داره، پیدا کنید و در وب بروزر یا هر جای دیگه نشون بدید
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim _Txt As String = txt
Dim erab As String = "[ًٌٍَُِّْ]*"
Dim tx() As Char = Far2Ar(TextBox1.Text)
Dim xt(tx.Length - 1) As String
For h As Integer = 0 To tx.Length - 1
xt(h) = tx(h)
Next
Dim rg As String = Join(xt, erab) & erab & "?\W"
rg = rg.Replace("ک", "[كک]").Replace("ي", "[یىي]").Replace("ا", "[آاإأ]")
'Clear Prevous Highlighting
Dim matchs As MatchCollection = Regex.Matches(_Txt, rg)
For m As Integer = matchs.Count - 1 To 0 Step -1
Dim s As Integer = matchs(m).Index
Dim bozrg As Integer = _Txt.IndexOf(">", s) - s
Dim kooch As Integer = _Txt.IndexOf("<", s) - s
If bozrg > kooch Then
End If
Dim l As Integer = matchs(m).Length
' MsgBox(matchs.Item(0).Value)
_Txt = _Txt.Insert(l + s, "</span>")
_Txt = _Txt.Insert(s, "<span style='background-color:#33FF66;'>")
Next
' txt = Regex.Replace(txt, rg, "" & re & "</span>")
WebBrowser1.DocumentText = _Txt
End Sub
بالاخره تونستم با کمک عبارت با قاعده (REGEX) جستجوی در متن اعراب دار رو انجام بدم
با این کد می تونید کلماتی رو که اعراب داره، پیدا کنید و در وب بروزر یا هر جای دیگه نشون بدید
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim _Txt As String = txt
Dim erab As String = "[ًٌٍَُِّْ]*"
Dim tx() As Char = Far2Ar(TextBox1.Text)
Dim xt(tx.Length - 1) As String
For h As Integer = 0 To tx.Length - 1
xt(h) = tx(h)
Next
Dim rg As String = Join(xt, erab) & erab & "?\W"
rg = rg.Replace("ک", "[كک]").Replace("ي", "[یىي]").Replace("ا", "[آاإأ]")
'Clear Prevous Highlighting
Dim matchs As MatchCollection = Regex.Matches(_Txt, rg)
For m As Integer = matchs.Count - 1 To 0 Step -1
Dim s As Integer = matchs(m).Index
Dim bozrg As Integer = _Txt.IndexOf(">", s) - s
Dim kooch As Integer = _Txt.IndexOf("<", s) - s
If bozrg > kooch Then
End If
Dim l As Integer = matchs(m).Length
' MsgBox(matchs.Item(0).Value)
_Txt = _Txt.Insert(l + s, "</span>")
_Txt = _Txt.Insert(s, "<span style='background-color:#33FF66;'>")
Next
' txt = Regex.Replace(txt, rg, "" & re & "</span>")
WebBrowser1.DocumentText = _Txt
End Sub