Поиск инструмента Richbox для слова на арабском языке с формацией игнорируется В WPF

Question

У меня нет инструмента RichBox в тексте, написанном на арабском языке, диакритических меток, а когда вы ищете арабское слово, диакритические знаки не окрашивают слово правильно, как вы видите:

enter image description here

Но если вы ищете слово там, где нет диакритических знаков, то это будет слово правильно расцветку, как вы видите:

enter image description here

Этот поиск кода я использую, и я думаю, что это проблема, так что я надеюсь, что вы измените его мне:

 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 

спасибо :)