تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[سؤال] البحث مع تجاهل التشكيل في الريتش بوكس
#1
Question 
السلام عليكم ورحمة الله وبركاته
سابقاً تجاوزت مشكلة البحث مع التشكيل سواء في قواعد البيانات أو أدوات العرض ، والحمد لله تجاوزت ذلك في تقنية WPF إلا أنني اصطدمت بحاجز أداة RichTextBox ؛ فعند البحث في الريتش بوكس يعطيني نتائج صحيحة ولكن لو كان البحث مع تجاهل التشكيل فلن يتم تلوين كلمة البحث الموجودة بشكل صحيح ، البرنامج على هذ الرابط :

وهنا صفحة البرنامج وهو مفتوح المصدر تم نشره على صفحات هذا المنتدى سابقاً :
الملف باسم : Makalat-Source.rar

طبعاً أنا برمجت دالة لتجاهل التشكيل وستجدها ضمن البرنامج باسم ReplaceString وهي تعمل بشكل جيد كما سترى
فقد استخدمتها ضمن البحث في قواعد البيانات مع تجاهل التشكيل

 المشكلة فقط في تلوين الكلمة عندما يكون النص في الريتش بوكس مشكولاً
بعد أن تحمل السورس شغل البرنامج واختر مقالة التحيات والصلوات الإبراهيمية
واكتب في مربع البحث مثلاً كلمة الله
ثم انقر زر "بحث في هذه المقالة"
ستجد النتائج صحيحة ولكن التلوين خطأ لأن كلمة الله في الريتش بوكس مشكولة

ولو بحثت في مقالة سامي باني حسين عن كلمة سامي
ستجد النتائج صحيحة والتلوين صحيح لأن كلمة سامي في الريتش بوكس غير مشكولة
فاعلم أنه لا إله إلا الله
الرد }}}}
تم الشكر بواسطة:
#2
سبب المشكلة التي وضعتها هو أنه عند البحث عن كلمة غير مشكولة فإنه يقوم بحسب عدد حروفها وعدد الخانات في الجملة ليبدأ التلوين من عندها ؛ مثلاً : بسم الله الرحمن الرحيم ، عند البحث عن كلمة الرحيم سيعرف أن عدد الحروف 6 وبداية الكلمة عند الخانة 17 وبناء عليه سيتم التلوين ، ولكن لو كانت الجملة مشكولة فهنا سيحدث التشويش ؛ لأن التشكيل يعتبر خانة ؛ فكلمة الرَّحيم سيعتبر أن عدد حروفها 8 ، وهكذا.

بعيداً عن هذه الطريقة وصلت لحل عن طريق Regex وكانت النتائج مذهلة ومرضية 100 % ولكن المشكلة أن البحث عن طريق Regex سيُفقِد الريتش بوكس تنسيقها وسيكون لها تنسيق مخصص بعد البحث. Undecided
فاعلم أنه لا إله إلا الله
الرد }}}}
تم الشكر بواسطة:
#3
بصراحة أنا دخت بالنت والبحث والتجريب حتى أصل لكود احترافي
ولكن الفضل لله تعالى وكرمه وصلت إلى الكود الاحترافي الذي يُمكنني من خلاله البحث في الريتش بوكس مع المحافظ على تنسيقاتها وترتيبها
البحث مع تجاهل التشكيل ، سواء البحث عن كلمة واحدة أو عدة كلمات ، وعندما يعطيك النتيجة ستكون الكلمة ملونة حتى لو كانت في الريتش مشكولة
إليكم الكود :
 
كود :
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
فاعلم أنه لا إله إلا الله
الرد }}}}
تم الشكر بواسطة: الشاكي لله , الشاكي لله , الوادي
#4
الحمدلله انك وجدت الحل Smile
الرد }}}}
تم الشكر بواسطة: السندبااد , السندبااد
#5
روووعة، باينه من الصورة.


هل يمكن تطبيق هذا البحث الرائع على RichTextBox الخاصة بالجوال بيسيك أو العملية مخصصة لأدوات wpf
الرد }}}}
تم الشكر بواسطة: السندبااد
#6
(27-07-16, 03:12 AM)الشاكي لله كتب : الحمدلله انك وجدت الحل Smile

ربنا يكرمك أخي وأستاذي العزيز
أنت دوماً سبّاق للخير ولا تقصر أبداً

Smile

(27-07-16, 01:21 PM)الوادي كتب : روووعة، باينه من الصورة.


هل يمكن تطبيق هذا البحث الرائع على RichTextBox الخاصة بالجوال بيسيك أو العملية مخصصة لأدوات wpf

أهلاً بك أخي العزيز
نعم يمكن لأن Regex مدعومة في الفيجوال بيسك
المسألة بسيطة جداً
في الفيجوال بيسك اكتب كوداً عادياً للبحث في الريتش بوكس مع تلوين الكلمة
ثم عدل في الكود بإضافة التعليمات المتعلقة بـ Regex الموجودة أول الكود السابق
Smile

فاعلم أنه لا إله إلا الله
الرد }}}}
تم الشكر بواسطة: الوادي
#7
السلام عليكم ورحمة الله وبركاته
من أراد أن يبحث عن أكثر من كلمة في الريتش بوكس فليستخدم هذا الكود :

كود :
        'إما أن تعمل مصفوفة بهذا الشكل
        'Dim Days(6) As String
        'Days(0) = "الله"
        'Days(1) = "رسول"
        'Days(2) = "عن"
        'Days(3) = "قال"
        'Days(4) = "من"
        'Days(5) = "عليه"
        'Days(6) = "سلم"

        'أو مصفوفة بهذا الشكل
        Dim Days() As String = {"الله", "رسول", "عن", "قال", "من", "عليه", "سلم"}

        'عدد محتويات المصفوفة
        'MsgBox((Days.Count))

        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 ii = 0 To Days.Count - 1
            For Each c As Char In Days(ii).ToString
                pattern = pattern & Regex.Escape(c) & "[\u064B-\u0653]*"
            Next c
            'تنسيق الكلمات لتخرج بالنهاية هكذا
            '"(عليه|سلم|من|قال|عن|رسول|الله)"
            pattern = "(" & pattern & ")" & "|"
        Next
        'سنحذف من آخر المتغير القوس والعمود |)
        pattern = Mid(pattern, 1, Len(pattern) - 2)
        'MsgBox(pattern)

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

        If reg.Matches(range.Text).Count < 1 Then
            MsgBox("لا يوجد نتائج")
        Else
            MsgBox("عدد النتائج : " & reg.Matches(range.Text).Count)
        End If

        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.HotPink))
                textrange.ApplyPropertyValue(Inline.TextDecorationsProperty, TextDecorations.Underline)
                'textrange.ApplyPropertyValue(Inline.FontStyleProperty, FontStyles.Italic)
                'textrange.ApplyPropertyValue(TextElement.FontWeightProperty, FontWeights.Bold)
                start = textrange.[End]
            End If
            start = start.GetNextContextPosition(LogicalDirection.Forward)
        End While
فاعلم أنه لا إله إلا الله
الرد }}}}
تم الشكر بواسطة: abulayth


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
Lightbulb [درس فيديو] شرح عمل DataBinding لليستا بوكس تم تعديل القالب الخاص بها السندبااد 2 598 22-02-16, 10:47 PM
آخر رد: السندبااد
  [سؤال] كيف أدرج سمايلز بين كلمتين في الريتش بوكس ؟ السندبااد 5 382 03-01-16, 03:02 PM
آخر رد: السندبااد
  [سؤال] عدم عرض النتائج في الليستا فيو والداتا جريد عند البحث مع تجاهل التشكيل السندبااد 9 1,662 09-11-14, 04:54 PM
آخر رد: hoob computer

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم