تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[كود] تصحيح او تعديل كود البحث في نص مشكل
#1
السلام عليكم

عندي نص مشكل في richtextBox

الان اكتب في مربع نص textBox  كلمة غير مشكلة

سيبحث عن اي كلمة مهما كانت تشكيلها و يلونها

حاولت بعدة طرق ........ لكن انجح طريقة هي نوعا ما طويلة في الانجاز 

تعتمد الطريقة على وضع مصفوفة بكل الحركات فتحة و ضمة و شدة و شدة وفتحة  و تنوين و سكون ........الخ

PHP كود :
Dim harkat() As String = {"""َ""ُ""ِ""ّ""ْ""ًّ""ُّ""ِّ""ً""ٌ""ٍ"


ثم يقوم الكود بوضع مصفوفة تضع فيها كل الاحتمالات التي يمكن ان تكون بها الكلمة يعني
 من اجل مصفوفة حركات بها 12 عنصر ........ من اجل كلمة من ثثلاث حروف سيكون عدد الاحتمالات هو  1728 
اي 12 قوة 3 ......... اي اذا اكنت الكلمة من خمسة حروف فالاحتمالات هي 12 قوة 5 اي 248832


هذا كود انشاء الاحتمالات و عرضها في ليسبوكس للاطهار و حفظها في مصفوفة

PHP كود :
[align=centerDim str TextBox1.Text[/align]
[
align=center       ListBox1.Items.Clear()[/align]
[
align=center       resul.Clear()[/align]
[
align=center       Dim ltr1 str(0)[/align]
[
align=center       Dim ltr2 str(1)[/align]
[
align=center       Dim ltr3 str(2)[/align]
[
align=center       Dim pp 0[/align]
[
align=center       For Each h1 As String In harkat[/align]
[
align=center           For Each h2 As String In harkat[/align]
[
align=center               For Each h3 As String In harkat[/align]
[
align=center                   mot3 ltr3 h3[/align]
[
align=center                   ''''''''''''''''''''[/align]
[
align=center                   mot2 ltr2 h2 mot3[/align]
[
align=center                   ''''''''''''''''''[/align]
[
align=center                   mot1 ltr1 h1 mot2[/align]
[
align=center                   ListBox1.Items.Add(mot1)[/align]
[
align=center                   resul.Add(mot1)[/align]
[
align=center                   pp += 1[/align]
[
align=center               Next[/align]
[
align=center           Next[/align]
[
align=center       Next[/align]
[
align=center][/align]
[
align=center       Label1.Text pp[/align


ثم يقوم كود البحث في عنصر richtextbox  بالمقارنة بكل هذه الاحتمالات و يقوم بتلوينها

كود البحث ذاحل الريشبوكس

PHP كود :
[align=center   Dim mm 0[/align]
[
align=center       RichTextBox1.SelectAll()[/align]
[
align=center       RichTextBox1.SelectionColor Color.Black[/align]
[
align=center       For Each sa As String In resul[/align]
[
align=center           Dim index RichTextBox1.Text.LastIndexOf(sa)[/align]
[
align=center           If index <> -1 Then[/align]
[
align=center               RichTextBox1.Find(saindexRichTextBox1.TextLengthRichTextBoxFinds.None)[/align]
[
align=center               RichTextBox1.SelectionColor Color.Red[/align]
[
align=center               mm += 1[/align]
[
align=center           End If[/align]
[
align=center       Next[/align]
[
align=center][/align]
[
align=center][/align]
[
align=center       Label2.Text mm[/align


لاحظ معي من اجل كلمة ( حمد ) 

 في النص  التالي ( مُحَمَدٌ حَمِدَ الله فهو مَحْمُودٌ أحْمَد فلله الحمد و الحَمْد حَمَّد تَحمِيدا حْمِد استحْمَدَ  )

النتيجة 

النتيجة مرضية الى حد ما

يعين الكود صالح ( فقط ) لكمة من 3 حروف ..........لذلك في الملف السورس حددت 3 حروف كطول اقص لتمستبوكس


----------------------


سؤالي يا كرام كيف اعدل على الكود ليتحمل كلمة من اكثر من 3 حروف ......... 

و ايضا الغاء تشكيل الكلمة التي نبحث عنها ليعمل الكود طبعا 


الملف السورس

.rar   tachkilCoran.rar (الحجم : 69.69 ك ب / التحميلات : 8)


شكرا 
 لعل الكلمة التي تنفعني لم أكتبها بعد
عبد الله بن المبارك
الرد
تم الشكر بواسطة: ابراهيم ايبو
#2
وعليك السلام ورحمة الله وبركاته

اخوي عبد الهادي هذا السؤال من فطاحلة الاسئلة

وانا حاولت ولم اوفق لان طريقة الحل بحسب اسلوبي معقدة جدا وتحتاج الى وقت طويل
لكني الحمدلله استمتع بمثل هذي الاسئلة

واسمحلي اعرض محاولة حلي من باب تقديري لفكرة السؤال
وشكرا

كود :
Public Class Form1
    Dim harkat() As Char = {"", "َ", "ُ", "ِ", "ّ", "ْ", "ًّ", "ُّ", "ِّ", "ً", "ٌ", "ٍ"}
    Dim mot3, mot2, mot1 As String
    Dim resul As New ArrayList

    Dim WChars() As Char
    Dim pp = 0
    Dim newWord As String = ""
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim str = TextBox1.Text
        WChars = str.ToCharArray
        ListBox1.Items.Clear()
        resul.Clear()

        Analyse()
    End Sub

    Sub Analyse()
        Static CharCounter As Integer
        Static HarkahCounter As Integer
        Static limit As Integer
        newWord = ""
        'Do
        Application.DoEvents()
        For a As Integer = 0 To WChars.Count - 1

            newWord &= WChars(a) & harkat(HarkahCounter)

            CharCounter += 1
        Next
        ListBox1.Items.Add(newWord)
        resul.Add(newWord)
        pp += 1
        Label1.Text = pp
        If (CharCounter) = TextBox1.TextLength Then
            'newWord = newWord.Substring(0, 2)

            limit += 1
            CharCounter = 0

            If HarkahCounter < harkat.Count - 1 Then
                HarkahCounter += 1
                Analyse()
            Else
                HarkahCounter = 0
            End If

        End If

        'Loop


    End Sub


    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim mm = 0
        RichTextBox1.SelectAll()
        RichTextBox1.SelectionColor = Color.Black
        For Each sa As String In resul
            Dim index = RichTextBox1.Text.LastIndexOf(sa)
            If index <> -1 Then
                RichTextBox1.Find(sa, index, RichTextBox1.TextLength, RichTextBoxFinds.None)
                RichTextBox1.SelectionColor = Color.Red
                mm += 1
            End If
        Next


        Label2.Text = mm


    End Sub
End Class

الرد
تم الشكر بواسطة: عبد الهادي بهاب , ابراهيم ايبو
#3
السلام عليكم

فيه طريقة اخرى .........حاولت معها ..........بطريقة اخرى اسرع و اسهل من الاولى


وهي ان نستدعي نص الموجود في ritchbox  و نقوم بحذف التشكيل عنه


PHP كود :
 Dim Str RichTextBox1.Text
        Dim NewStr 
""
 
       For gh 0 To Str.Length Dim ass Asc(Str(gh)) : If ass 240 Then NewStr NewStr Str(gh) : End If : Next 
 
الان نضع مصفوفتين بحيث نفكك النصين الاول المشكل و الاخر الغير مشكل
PHP كود :
Dim Arr1 Str.Split(" ")

 
       Dim Arr2 NewStr.Split(" "

الان سنحذف التشكيل من الكلمة المبحوث عنها
PHP كود :
 Dim txtSerch ""
 
       For gh 0 To TextBox1.Text.Length Dim ass Asc((TextBox1.Text(gh))) : If ass 240 Then txtSerch  txtSerch  & (TextBox1.Text(gh) : End If : Next 

الان سنقارن كل كلمة في المصفوفة الثانية الغير مشكلة مع الكلمة المبحوث عنها الغير مشكلة 
و من ثم نستخلص رقم الكلمة في المصفوفة ........و نلون الكلمة من نفس الرقم من المصفوفة الثانية في الريتبوكس
PHP كود :
 Dim mm 0

        RichTextBox1
.SelectAll()
 
       RichTextBox1.SelectionColor Color.Black
        For i 
0 To Arr2.Length 1
            If Arr2
(i).Contains(txtSerchThen
                Dim ali 
Arr1(i)

 
               Dim index RichTextBox1.Text.LastIndexOf(ali)
 
               If index <> -1 Then
                    RichTextBox1
.Find(aliindexRichTextBox1.TextLengthRichTextBoxFinds.None)
 
                   RichTextBox1.SelectionColor Color.Red
                    mm 
+= 1
                End 
If


 
           End If
 
       Next


        Label2
.Text mm 

الكود سيلون كل الكلمة التي فيها الكلمة المبحوث عنها ( كل الكلمة و ليس جزء منها )

الملف فيه الطريقيتين

.rar   tachkil_2.rar (الحجم : 15.73 ك ب / التحميلات : 5)


----------
ملاحظة : يجب تعديل الكود في حالى المسافات ....... في حالة حركات جديدة في خطوط كالقران الكريم

(16-09-20, 03:08 AM)معاند الحظ كتب : وعليك السلام ورحمة الله وبركاته

اخوي عبد الهادي هذا السؤال من فطاحلة الاسئلة

وانا حاولت ولم اوفق لان طريقة الحل بحسب اسلوبي معقدة جدا وتحتاج الى وقت طويل
لكني الحمدلله استمتع بمثل هذي الاسئلة

واسمحلي اعرض محاولة حلي من باب تقديري لفكرة السؤال
وشكرا

كود :
Public Class Form1
    Dim harkat() As Char = {"", "َ", "ُ", "ِ", "ّ", "ْ", "ًّ", "ُّ", "ِّ", "ً", "ٌ", "ٍ"}
    Dim mot3, mot2, mot1 As String
    Dim resul As New ArrayList

    Dim WChars() As Char
    Dim pp = 0
    Dim newWord As String = ""
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim str = TextBox1.Text
        WChars = str.ToCharArray
        ListBox1.Items.Clear()
        resul.Clear()

        Analyse()
    End Sub

    Sub Analyse()
        Static CharCounter As Integer
        Static HarkahCounter As Integer
        Static limit As Integer
        newWord = ""
        'Do
        Application.DoEvents()
        For a As Integer = 0 To WChars.Count - 1

            newWord &= WChars(a) & harkat(HarkahCounter)

            CharCounter += 1
        Next
        ListBox1.Items.Add(newWord)
        resul.Add(newWord)
        pp += 1
        Label1.Text = pp
        If (CharCounter) = TextBox1.TextLength Then
            'newWord = newWord.Substring(0, 2)

            limit += 1
            CharCounter = 0

            If HarkahCounter < harkat.Count - 1 Then
                HarkahCounter += 1
                Analyse()
            Else
                HarkahCounter = 0
            End If

        End If

        'Loop


    End Sub


    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim mm = 0
        RichTextBox1.SelectAll()
        RichTextBox1.SelectionColor = Color.Black
        For Each sa As String In resul
            Dim index = RichTextBox1.Text.LastIndexOf(sa)
            If index <> -1 Then
                RichTextBox1.Find(sa, index, RichTextBox1.TextLength, RichTextBoxFinds.None)
                RichTextBox1.SelectionColor = Color.Red
                mm += 1
            End If
        Next


        Label2.Text = mm


    End Sub
End Class


شكرا على المحاولة استاذ .......الكود لا يجلب الا 12 احتمال ....و بالتالي هامش الخطا كبير .......
ربي يجازيكم ...نواصل معكم كسب الرهان
 لعل الكلمة التي تنفعني لم أكتبها بعد
عبد الله بن المبارك
الرد
#4
اعرف يا اخي انه غير صحيح 

لكني حبيت اشارك واضع محاولتي الاولى لاني سجلت السؤال هذا في بالي كتحدي لي 
اني اوجد طريقة بسيطة للحل. ولهذا لم اكمل لان الطريقة التي في بالي الان معقدة جدا

تحياتي لك

الرد
تم الشكر بواسطة: ابراهيم ايبو
#5
و عليكم السلام و رحمة الله و بركاته

تم تعديل المثال في المرفقات


.rar   Statistic Qoran.rar (الحجم : 17.45 ك ب / التحميلات : 11)
الرد
#6
السلام عليكم اخواني الكرام اسمحولي ان ادلي بدلوي في هذا الموضوع

الحقيقة الموضوع مهم فعلا ومثير للاهتمام لكل من يفكر به فعلا  Big Grin 

حلي عبارة عن خليط من ال Regex وال Linq 

لو فكرنا في النص المطلوب ايجاده باحتمالاته  : حَمد ، حُمِدَ ، حَمْدْ ، حمد 

المشترك بينهم هو انهم مكونين من الحروف المطلوب البحث عنها : حمد ، وبعد كل حرف حركة تشكيل او اكثر

ح بعدها احد حروف التشكيل
م بعدها احد حروف التشكيل
د بعدها احد حروف التشكيل

بحثت فوجدت حروف التشكيل تقع في المدى [\u064B-\u0652] 

يصبح تعبير Regex الذي يمثل عملية البحث هذه :

ح[\u064B-\u0652]*
م[\u064B-\u0652]*
د[\u064B-\u0652]*

الحرف ثم مدى التشكيل [\u064B-\u0652] ثم * للدلالة على ان التشكيل اختيارى ويمكن تكراره

في الحقيقة هذا فعلا كل ما يتطلبه ايجاد "حمد" داخل التشكيل واضافتهم لليست بوكس :

كود :
       Dim matches = Regex.Matches(RichTextBox1.Text, "ح[\u064B-\u0652]*م[\u064B-\u0652]*د[\u064B-\u0652]*")


       For Each m As Match In matches
           ListBox1.Items.Add(m.Value)
       Next


ولكن سأخد خطوة للوراء لتعميم العملية على اي كلمة ،

الان وصلنا الى انه يجب علينا ان نضع بعد كل حرف [\u064B-\u0652]* ونستخدمه ك Regex ونحصل على النتائج ، لفعل ذلك ببساطة :

نعرف متغير عام :

كود :
   Dim matches As MatchCollection


ثم لملئ الليست بوكس 

كود :
       Dim word As String = TextBox1.Text
       Dim expression As String = ""
       For Each l In word
           expression &= l & "[\u064B-\u0652]*"
       Next

       matches = Regex.Matches(RichTextBox1.Text, expression)


       For Each m As Match In matches
           ListBox1.Items.Add(m.Value)
       Next

طيب حصلنا على النتائج كيف نغير اللون ؟ 

نتيجة Regex.Matches تكون عبارة عن كوليكشن من نوع Match نتيجة البحث
الفئة Match تحتوي على خصائص مفيدة مثل Index و Length 
يكون كود تغيير اللون ببساطة :

كود :
       RichTextBox1.SelectAll()
       RichTextBox1.SelectionColor = Color.Black

       For Each m As Match In matches
           RichTextBox1.Select(m.Index, m.Length)
           RichTextBox1.SelectionColor = Color.Red
       Next
النتيجة :

   


ولاني احب Linq كثير ، ايضا هذه طريقة ايجاد تعبير البحث المناسب باستخدام Linq :

كود :
       Dim word As String = TextBox1.Text

       Dim expression = word.
           Select(Function(x) x + "[\u064B-\u0652]*").
           Aggregate(Function(x, y) x + y)

       matches = Regex.Matches(RichTextBox1.Text, expression)


       ListBox1.DisplayMember = "Value"
       ListBox1.DataSource = matches.Cast(Of Match).ToList

اذا لم تكن مهتم ب Linq لا تشغل بالك ابدا باخر كود ، الطريقة الاولى تعمل بكفائة عالية جدا

ربما اضع الطريقة في موضوع منفصل للافادة

المصادر :

https://stackoverflow.com/questions/2962...n-matching
https://stackoverflow.com/questions/5224...ly/7193622
https://stackoverflow.com/questions/3839...s-in-order
https://stackoverflow.com/questions/3849...in-c-sharp


الملفات المرفقة
.zip   statistic_coran.zip (الحجم : 74.45 ك ب / التحميلات : 6)
الرد
#7
ما شاء الله ... تمام التمام
ارجو ان يجد الموضوع طريقه للاستعمال
ربي يجازيكم خيرا
 لعل الكلمة التي تنفعني لم أكتبها بعد
عبد الله بن المبارك
الرد
تم الشكر بواسطة: Anas Mahmoud , Mohamad Anan , حريف برمجة


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [VB.NET] مساعدة في تعديل كود ميدو الفنان 4 148 16-09-20, 06:17 PM
آخر رد: ميدو الفنان
  [VB.NET] تعديل البيانات من خلال فورم آخر EbrNaj00 6 210 16-09-20, 12:42 AM
آخر رد: EbrNaj00
  المساعدة في التعديل على كود تعديل البيانات في قاعدة سيكوال سيرفر momani33 3 80 15-09-20, 08:10 PM
آخر رد: Anas Mahmoud
  [VB.NET] تعديل في عملية البحث abu7shihab 4 189 11-09-20, 08:20 PM
آخر رد: T 1
  [سؤال] تنظيم ارفاق المستندات في قاعدة البيانات Sql واحضار الملفات حسب قيمة البحث محمد العامر 10 394 07-09-20, 12:28 AM
آخر رد: محمد العامر
  [سؤال] مشكل الوضع في حالة تكبير Maximized عبد الهادي بهاب 0 130 24-08-20, 10:09 PM
آخر رد: عبد الهادي بهاب
  [سؤال] طلب تصحيح كود paveldida 1 152 24-08-20, 02:55 PM
آخر رد: اسامه الهرماوي
  السلام عليكم ممكن توضيح بسيط بخصوص البحث داخل الليست بوكس اليوم السابع 5 310 21-08-20, 01:40 PM
آخر رد: اليوم السابع
  لو سمحتم اريد تعديل على هذا المشروع خالد كامل1 3 322 20-08-20, 06:09 PM
آخر رد: خالد كامل1
Sad كود حذف السجلات المختاره عن طريق (التشيك بوكس ) اسف تم تعديل المطلوب عمور2016 8 454 19-08-20, 10:44 PM
آخر رد: عمور2016

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


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