الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

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

بدأه محب لله ورسوله في 4 أبريل 2012 · 10 رد · 1,071 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

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

الأخوه الافاضل

احتاج إلى مساعدتكم فى حل مشكله تلوين كلمة البحث فى هذا المثال

فى هذا المثال أريد تلوين كلمة البحث لتظهر بلون مختلف فى الريتش تكست عند استعراض نتائج البحث

وقد حاولت بأكثر من طريقه ولم يعمل الكود بشكل صحيح نظراً لان البحث يتجاهل نظام التشكيل

فأرجوا منكم حل هذه المشكله

والتعديل على المثال

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

moder_msg.rar

#2

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

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

المشكلة انك لما تبعد التشكيل عن النص الاصلي لعملية المقارنة وافترضنا حددت الموقع مثلا ( كلمة "جبال" الموقع 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

تم تعديل هذه المشاركة بواسطة realdie10 في 4 أبريل 2012 في 19:42

1

وما من كاتب إلا سيفنى *** ويبقى الدهر ماكتبت يــداه

فلا تكتب بكفك غير شيء *** يسرك في القيامة ان تراه

لا تنسى تشجيعي بالنقر على

add.png اذا كانت مشاركتي مفيدة
#3

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

اضف 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

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

1

وما من كاتب إلا سيفنى *** ويبقى الدهر ماكتبت يــداه

فلا تكتب بكفك غير شيء *** يسرك في القيامة ان تراه

لا تنسى تشجيعي بالنقر على

add.png اذا كانت مشاركتي مفيدة
#5

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

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

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

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

لا اعلم لماذا

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

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

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

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

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

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

لا اعلم لماذا

عدل السطر التالي الموجود في 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

اقتباس

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

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

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

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

وما من كاتب إلا سيفنى *** ويبقى الدهر ماكتبت يــداه

فلا تكتب بكفك غير شيء *** يسرك في القيامة ان تراه

لا تنسى تشجيعي بالنقر على

add.png اذا كانت مشاركتي مفيدة
#7

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

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

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

الكود

//attachment/39039

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

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

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

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

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

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

الكود

/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

تم تعديل هذه المشاركة بواسطة realdie10 في 12 أبريل 2012 في 00:26

وما من كاتب إلا سيفنى *** ويبقى الدهر ماكتبت يــداه

فلا تكتب بكفك غير شيء *** يسرك في القيامة ان تراه

لا تنسى تشجيعي بالنقر على

add.png اذا كانت مشاركتي مفيدة
#9

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

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

بارك الله فيك

#10

اضف في 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

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

1

وما من كاتب إلا سيفنى *** ويبقى الدهر ماكتبت يــداه

فلا تكتب بكفك غير شيء *** يسرك في القيامة ان تراه

لا تنسى تشجيعي بالنقر على

add.png اذا كانت مشاركتي مفيدة
#11

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

اخى الحبيب realdie 10

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

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

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

بارك الله فيك

مواضيع مشابهة