[عبد الهادي بهاب]

السلام عليكم

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


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

PHP كود :

 Dim Str = RichTextBox1.Text
        Dim NewStr = ""
        For gh = 0 To Str.Length - 1 : 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 - 1 : 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(txtSerch) Then
                Dim ali = Arr1(i)

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


            End If
        Next


        Label2.Text = mm 


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

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

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


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

---

(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 احتمال ....و بالتالي هامش الخطا كبير .......
ربي يجازيكم ...نواصل معكم كسب الرهان