Question

我在用阿拉伯语写的文本中没有RichBox工具，这是一个变音符号，当你搜索阿拉伯语单词时，变音符号不能正确地对你的单词进行着色：

但是如果你搜索没有变音标记的单词，那么正如你所看到的那样，地板着色是正确的：

此搜索代码我正在使用，我认为问题就是这样，所以我希望你修改它给我：

        Dim NumSearch As Integer
        NumSearch = 0
        Dim keyword As String = ReplaceString(TxtSearch.Text.Trim)

        Dim text As New TextRange(RichTxtPost.Document.ContentStart, RichTxtPost.Document.ContentEnd)
        Dim current As TextPointer = text.Start.GetInsertionPosition(LogicalDirection.Forward)


        While current IsNot Nothing
            Dim textInRun As String = ReplaceString(current.GetTextInRun(LogicalDirection.Forward))
            'If Not String.IsNullOrWhiteSpace(textInRun) Then
            If Not String.IsNullOrEmpty(textInRun) Then
                Dim index As Integer = textInRun.IndexOf(keyword)
                If index <> -1 Then
                    Dim selectionStart As TextPointer = current.GetPositionAtOffset(index, LogicalDirection.Forward)
                    Dim selectionEnd As TextPointer = selectionStart.GetPositionAtOffset(keyword.Length, LogicalDirection.Forward)
                    Dim selection As New TextRange(selectionStart, selectionEnd)
                    NumSearch = Val(NumSearch) + 1

                    'selection.ApplyPropertyValue(TextElement.FontWeightProperty, FontWeights.Bold)
                    selection.ApplyPropertyValue(TextElement.ForegroundProperty, New SolidColorBrush(Colors.Red))

                    RichTxtPost.Selection.[Select](selection.Start, selection.[End])
                    RichTxtPost.Focus()

                End If
            End If
            current = current.GetNextContextPosition(LogicalDirection.Forward)
        End While

替换配置文件的替换功能：

Public Function ReplaceString(In_Text As String) As String
        'خاص بالبحث مع تجاهل التشكيل
        Dim X As Long
        Dim strChar As String
        Dim strReturn As String
        strReturn = ""

        For X = 1 To Len(In_Text)
            strChar = Mid(In_Text, X, 1)
            Select Case strChar
                Case "أ", "إ", "آ"
                    strChar = "ا"
                Case "ه"
                    strChar = "ة"
                Case Chr(243), Chr(240), Chr(245), Chr(246), Chr(242), Chr(241), Chr(248), Chr(250)
                    ''حذف علامات التشكيلية إذا وجد، وهي
                    '
                    '' َ  ً  ُ  ِ  ٍ.
                    'strChar = ""

                    ' يجب اضافة حرف وهمي غير مستخدم في النص الاساسي بدلا من كل حرف مطلوب تجاهله سواء همزة او شكله
                    strChar = ""
            End Select
            strReturn = strReturn & strChar
        Next
        ReplaceString = strReturn
    End Function

Answer 1

这是解决方案：

        Dim range As New TextRange(RichTxtPost.Document.ContentStart, RichTxtPost.Document.ContentEnd)
        'منسق
        Dim GetPost As String
        GetPost = myInput2
        Dim documentBytes = Encoding.UTF8.GetBytes(GetPost)
        Using reader = New MemoryStream(documentBytes)
            reader.Position = 0
            RichTxtPost.SelectAll()
            RichTxtPost.Selection.Load(reader, DataFormats.Rtf)
        End Using

        Dim pattern As String = ""

        For Each c As Char In Me.TxtSearch.Text.Trim
            pattern = pattern & Regex.Escape(c) & "[\u064B-\u0653]*"
        Next c

        'للبحث عن كلمة واحدة
        Dim reg As New Regex("(" & pattern & ")", RegexOptions.Compiled Or RegexOptions.IgnoreCase)
        'للبحث عن عدة كلمات
        'Dim reg As New Regex("(" & pattern & "| مُحَمَّدٍ " & "| إِبْرَاهِيمَ " & ")", RegexOptions.Compiled Or RegexOptions.IgnoreCase)

        Dim start = RichTxtPost.Document.ContentStart
        While start IsNot Nothing AndAlso start.CompareTo(RichTxtPost.Document.ContentEnd) < 0
            If start.GetPointerContext(LogicalDirection.Forward) = TextPointerContext.Text Then
                Dim match = reg.Match(start.GetTextInRun(LogicalDirection.Forward))

                Dim textrange = New TextRange(start.GetPositionAtOffset(match.Index, LogicalDirection.Forward), start.GetPositionAtOffset(match.Index + match.Length, LogicalDirection.Backward))
                textrange.ApplyPropertyValue(TextElement.ForegroundProperty, New SolidColorBrush(Colors.Red))
                'textrange.ApplyPropertyValue(TextElement.FontWeightProperty, FontWeights.Bold)
                start = textrange.[End]
            End If
            start = start.GetNextContextPosition(LogicalDirection.Forward)
        End While

谢谢你：）

使用阿拉伯语搜索Richbox工具，并在WPF中忽略编队

1 个答案: