[السندبااد]

بصراحة أنا دخت بالنت والبحث والتجريب حتى أصل لكود احترافي

ولكن الفضل لله تعالى وكرمه وصلت إلى الكود الاحترافي الذي يُمكنني من خلاله البحث في الريتش بوكس مع المحافظ على تنسيقاتها وترتيبها

البحث مع تجاهل التشكيل ، سواء البحث عن كلمة واحدة أو عدة كلمات ، وعندما يعطيك النتيجة ستكون الكلمة ملونة حتى لو كانت في الريتش مشكولة

إليكم الكود :

 

كود :

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

وهذه الصورة لا تحتاج لتعليق :
   

الجميل في هذا الكود وفي Regex أنك تستطيع تنويع البحث
فمثلاً لو بحثت عن لفظ الجلالة الله بدون فستخرج لك في كل الحالات مرفوعة ومجرورة ومكسورة
ولو بحث عن لفظ الجلالة اللهُ في حالة الرفع فستخرج لك النتائج في حالة الرفع فقط

---

على فكرة كوننا نتحدث عن تجاهل التشكيل هنالك دالة لحذف التشكيل وتجاهله من أي عبارة
أو حتى لاستخدامها في البحث داخل قاعدة البيانات
وهذه الدالية غير دالة ReplaceString التي استخدمتها أنا في برنامج خزانة المقالات
بل هي دالة RemoveDiacritics تفضلوا كود الدالة :

كود :

Private Shared Function RemoveDiacritics(text As String) As String
        Dim normalizedString = text.Normalize(NormalizationForm.FormD)
        Dim stringBuilder = New StringBuilder()

        For Each c As Object In normalizedString
            Dim unicodeCategory__1 = CharUnicodeInfo.GetUnicodeCategory(c)
            If unicodeCategory__1 <> UnicodeCategory.NonSpacingMark Then
                stringBuilder.Append(c)
            End If
        Next

        Return stringBuilder.ToString().Normalize(NormalizationForm.FormC)
    End Function