مطلوب تلوين كلمة البحث

السلام عليكم يامحب لله ورسوله

بصراحه في البداية استسهلت البرنامج ولما شفت التشكيل شفت المشكلة

المشكلة انك لما تبعد التشكيل عن النص الاصلي لعملية المقارنة وافترضنا حددت الموقع مثلا ( كلمة "جبال" الموقع 65 طول الكلمة 4 لما تروح للنص الاصلي (النص مع التشكيل ) الموقع بيختلف للكملة حتى الكلمة نفسها الطول لها يختلف اذا كانت مشكلة "جٍبَال" طولها 6

المهم حط هذي الاجراء الخاص بالتلوين ( البرنامج جاهز في المرفقات )

Private Sub setColor()
    Dim n As Long, txt As String, tS As String, l As Long, rchLen As Long, g As Integer, l2 As Long
    txt = ReplaceString2(RtfMessage.Text)
    tS = ReplaceString(TxtSearch)
    For g = 1 To Len(txt) - 1
10:
        l = 1
        l2 = 1
        If Mid(txt, g, l) = Mid(tS, 1, l) Then
            n = g
            rchLen = 0
20:
            rchLen = rchLen + 1
            If Mid(txt, g, l2) = Mid(txt, g, l2) & ReplaceString(Mid(txt, g + l2, rchLen)) Then GoTo 20
            If Trim(ReplaceString(Mid(txt, g, l2 + rchLen - 1))) = Mid(tS, 1, l) Then
                If l = Len(tS) Then
                    RtfMessage.SelStart = g - 1
                    RtfMessage.SelLength = l2 + rchLen - 1
                    RtfMessage.SelColor = 255
                   g = g + 1
                    GoTo 10
                End If
                l = l + 1
                l2 = l2 + rchLen
                rchLen = 0
                GoTo 20
            Else
                g = g + 1
                GoTo 10
            End If
        End If
    Next g

End Sub

وهذه الدالة الثانية

Public Function ReplaceString2(In_Text As String) As String
     Dim x As Long
    Dim strChar As String
    Dim strReturn As String

    For x = 1 To Len(In_Text)
        strChar = Mid(In_Text, x, 1)
        Select Case strChar
        Case "أ", "إ", "آ"
            strChar = "ا"
        Case "ه"
            strChar = "ة"
        Case "ؤ"
            strChar = "و"
        Case "ئ", "ي"
            strChar = "ى"

        End Select

        strReturn = strReturn & strChar
    Next
    DoEvents
    ReplaceString2 = strReturn
End Function

وبعدين في حدث النقر على MSHFlexGrid1_Click

setColor

وعفوا

moder_msg.rar

السلام عليكم أخى الحبيب

ماشاء الله عليك

ربنا يحفظك ويبارك فى عمرك ويرزقك العلم النافع والعمل الصالح

وجزاك الله عنى خير الجزاء

محتاج إضافه تانيه إن أمكن يااخى

محتاج طريقة لقياس سرعه اظهار نتائج البحث

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

محب لله ورسوله كتب:

السلام عليكم أخى الحبيب

ماشاء الله عليك

ربنا يحفظك ويبارك فى عمرك ويرزقك العلم النافع والعمل الصالح

وجزاك الله عنى خير الجزاء

محتاج إضافه تانيه إن أمكن يااخى

محتاج طريقة لقياس سرعه اظهار نتائج البحث

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

اضف Timer1 و Label4 الى النافذة بحيث label4 بتكون فيها الفترة الزمنية

وقم بتعديل زر البحث command1 الى التالي

Private Sub Command1_Click()
Label4.Caption = 0
Timer1.Interval = 1
    Call Amro
Timer1.Interval = 0

End Sub

اما في حدث timer1 يكون كالتالي:

Private Sub Timer1_Timer()
Static t As Integer
If Val(Label4.Caption) = 0 Then t = 0
t = t + 1
Label4.Caption = t
End Sub

والعفو اذا مافهمتك

السلام عليكم أخى الحبيب

ربنا يحفظك ياأخى ويرضى عنك

ظهر عندى مشكله بعد اضافة الكود الاول الخاص بتلوين كلمة البحث

وهى عند غلق البرنامج بيهنج

لا اعلم لماذا

بالنسبه للكود الثانى

انا كل مره باستخدم فيها زر البحث بتختلف النتيجه

فهل هناك طريقه لظبط النتيجه اكثر حتى يمكن المقارنه بشكل ادق ؟

محب لله ورسوله كتب:

ظهر عندى مشكله بعد اضافة الكود الاول الخاص بتلوين كلمة البحث

وهى عند غلق البرنامج بيهنج

لا اعلم لماذا

عدل السطر التالي الموجود في setColor

If Mid(txt, g, l2) = Mid(txt, g, l2) & ReplaceString(Mid(txt, g + l2, rchLen)) Then GoTo 20

الى الكود التالي :

If Mid(txt, g, l2) = Mid(txt, g, l2) & ReplaceString(Mid(txt, g + l2, rchLen)) Then If g + rchLen <= Len(txt) Then GoTo 20

اقتباس

بالنسبه للكود الثانى

انا كل مره باستخدم فيها زر البحث بتختلف النتيجه

فهل هناك طريقه لظبط النتيجه اكثر حتى يمكن المقارنه بشكل ادق ؟

بالنسبة للمشكلة الثانية انت حاول وإن شاء الله اذا قدرت ما بقصر معاك

السلام عليكم ورحمة الله وبركاته

وجدت هذا الكود واظنه هيكون ادق فى النتيجه

ولكنى حاولت تطبيقه على مثالى ولكنى لم استطع

الكود

//attachment/39039

ارجو تطبيقه على مثالى

وجزاكم الله عنى خيراً

محب لله ورسوله كتب:

السلام عليكم ورحمة الله وبركاته

وجدت هذا الكود واظنه هيكون ادق فى النتيجه

ولكنى حاولت تطبيقه على مثالى ولكنى لم استطع

الكود

/index.php?app=core&module=attach§ion=attach&attach_id=39039

ارجو تطبيقه على مثالى

وجزاكم الله عنى خيراً

اخي البرنامج استخدم نفس الفكرة عنصر تحكم timer

على العموم جرب طريقة ثانية موجودة في مشاركة لي على /index.php?showtopic=260455

عن طريق

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

استأذنك اخى الحبيب

إنك تطبقلى الكود على البرنامج لانى لم استطع

بارك الله فيك

اضف في genral declarations

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

اي تضيفه بعد هذا الكود

Option Explicit
Dim Cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim logReturnCount As Long

عدل كود الزر البحث الى التالي ( لاتنسى تضيف عنصر تحكم label4 )

Private Sub Command1_Click()
Dim s As Double, e As Double
s = timeGetTime
    Call Amro
e = timeGetTime
 Label4.Caption = e - s

End Sub

طبعا بيفرق معاك في كل مرة حاجة بسيطة

مثلا بحث عن كلمة "من"

بطريقة timer كان يعطي ما بين 1 و 2

اما بهذي الطريقة فالرقم اكبر 40 , 38

لذا فهذي الطريق تعطيك مجال اكثر للمقارنة

السلام عليكم ورحمة الله وبركاته

اخى الحبيب realdie 10

ظهر عندى مشكله متعلقه بعملية التلوين وهى

إنه عند محاوله البحث عن اكثر من كلمة لا يتم التلوين

فما هو حل هذه المشكله ؟

بارك الله فيك