منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
[سؤال] أختصار هذا الكود - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم لغات البرمجة الاخرى (http://vb4arb.com/vb/forumdisplay.php?fid=4)
+--- قسم : قسم لغة vb6.0 (http://vb4arb.com/vb/forumdisplay.php?fid=18)
+---- قسم : قسم أسئلة vb6.0 (http://vb4arb.com/vb/forumdisplay.php?fid=28)
+---- الموضوع : [سؤال] أختصار هذا الكود (/showthread.php?tid=690)

أختصار هذا الكود - baderb14 - 25-10-13

سلام عليكم

انا اريد منع الكتابة في التكست غير الاعداد وتم استخدام هذا الكود

PHP كود :
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
     KeyAscii = 0
     End If
End Sub 
ولكن ليس من المعقول تكرارة في كل تكست ...

اريد كتابة الكود مرة واحد مع استخدام الفاصلة في الكود ووضع اسم التكست الثاني

RE: أختصار هذا الكود - ناجي إبراهيم - 25-10-13

السلام عليكم...

للأسف VB6 لا تدعم مشاركة نفس الإجراء لأكثر من كائن واحد. لكن يمكن تجاوز ذلك باستعمال الـ Class Modules كالتالي:

1. أضف إلى المشروع Class Module و قم بتسميتها باسم CNumberOnlyTextBox (من خلال الخاصية Name).
2. ضع بها الكود التالي:
كود :
Option Explicit

Private WithEvents m_TextBox As TextBox

Public Sub AttachTextBox(ATextBox As TextBox)
    Set m_TextBox = ATextBox
End Sub

Private Sub m_TextBox_KeyPress(KeyAscii As Integer)
    If KeyAscii > 31 Then
        If Chr$(KeyAscii) = "." Then
            If InStr(m_TextBox.Text, ".") <> 0 Then
                If m_TextBox.SelLength > 0 Then
                    If InStr(m_TextBox.SelText, ".") = 0 Then
                        KeyAscii = 0
                    End If
                Else
                    KeyAscii = 0
                End If
            End If
        ElseIf InStr("0123456789", Chr$(KeyAscii)) = 0 Then
            KeyAscii = 0
        End If
    End If
End Sub

3. أضف إلى المشروع Class Module أخرى و قم بتسميتها باسم CNumberOnlyTextBoxes (من خلال الخاصية Name).
4. ضع بها الكود التالي:
كود :
Option Explicit

Private TextBoxCollection As Collection

Private Sub Class_Initialize()
    Set TextBoxCollection = New Collection
End Sub

Private Sub Class_Terminate()
    Dim Idx As Long
    
    For Idx = TextBoxCollection.Count To 1 Step -1
        TextBoxCollection.Remove Idx
    Next Idx
    
    Set TextBoxCollection = Nothing
End Sub

Public Sub Add(ATextBox As TextBox)
    Dim ANewTextBox As New CNumberOnlyTextBox
    ANewTextBox.AttachTextBox ATextBox
    TextBoxCollection.Add ANewTextBox
End Sub

* تقول لماذا كل ذلك؟ - تذكر أنك تكتب الأكواد السابقة مرة واحدة فقط.

* الآن لأي Form بها مربعات نص تريدها أن تقبل أرقاماً فقط (بالإضافة إلى الفاصلة العشرية) نقوم بالتالي:

أ. في قسم التصريحات العام:
كود :
Private NumTextBoxes As New CNumberOnlyTextBoxes

ب. و في إجراء الحدث Load للـ Form نضيف مربعات النص المطلوبة:
كود :
Private Sub Form_Load()
    NumTextBoxes.Add Text1
    NumTextBoxes.Add Text3
End Sub

و إذا أردت أن تضيف مربعات نص أخرى (كي تقبل أرقاماً) فيكفي أن تضيف لكل منها سطراً واحداً في الحدث Form_Load.

نرجو الاستفادة و السلام.

RE: أختصار هذا الكود - تركي الحلواني - 25-10-13

بعد إذن اخي ناجي
تفضل هده الـ Function ضعها في Module

PHP كود :
Public Function gWriteOnleNumber(IntKeyAscii As Integer)
If (IntKeyAscii < 48 Or IntKeyAscii > 57) Then
    gWriteOnleNumber = 0
Else
    gWriteOnleNumber = IntKeyAscii
End If
If IntKeyAscii = 8 Then gWriteOnleNumber = IntKeyAscii
If IntKeyAscii = 13 Then gWriteOnleNumber = IntKeyAscii
If IntKeyAscii = 46 Then gWriteOnleNumber = IntKeyAscii

End Function 
وضع هذا في حدث الـ KeyPress في كل تكست

PHP كود :
KeyAscii = gWriteOnleNumber(KeyAscii) 


RE: أختصار هذا الكود - mamas1 - 26-10-13

انتظر حتى غد
سأريك طريقة جميلة لتفادي هذا المشكل

RE: أختصار هذا الكود - baderb14 - 26-10-13

(25-10-13, 09:43 PM)ناجي إبراهيم كتب : * الآن لأي Form بها مربعات نص تريدها أن تقبل أرقاماً فقط (بالإضافة إلى الفاصلة العشرية) نقوم بالتالي:

أ. في قسم التصريحات العام:
كود :
Private NumTextBoxes As New CNumberOnlyTextBoxes

ب. و في إجراء الحدث Load للـ Form نضيف مربعات النص المطلوبة:
كود :
Private Sub Form_Load()
    NumTextBoxes.Add Text1
    NumTextBoxes.Add Text3
End Sub

و إذا أردت أن تضيف مربعات نص أخرى (كي تقبل أرقاماً) فيكفي أن تضيف لكل منها سطراً واحداً في الحدث Form_Load.

نرجو الاستفادة و السلام.
شكرا لك اخي ناجي وبارك الله فيك
جزاك الله الف خير
لم اعرف اطبق هذه أتمنى التوضيح اكثر
اخ تركي الحلواني
تم التطبيق وبالفعل نجحت ولقد نالت على اعجابي لسهولتها وسرعه تطبيقها
جزاك الله الف خير
وبارك الله فيك
(26-10-13, 02:11 AM)mamas1 كتب : انتظر حتى غد
سأريك طريقة جميلة لتفادي هذا المشكل

بانتظارك اخي
بارك الله فيك

RE: أختصار هذا الكود - mamas1 - 26-10-13

الفكرة هي صنع برنامج يكتب الأكواد بطريقة سريعة و مهما كان العدد
أنظر هذا المشروع بصفة عامة و يمكنك تخصيصه

RE: أختصار هذا الكود - baderb14 - 26-10-13

(26-10-13, 04:06 PM)mamas1 كتب : الفكرة هي صنع برنامج يكتب الأكواد بطريقة سريعة و مهما كان العدد
أنظر هذا المشروع بصفة عامة و يمكنك تخصيصه

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

ماقصرتم وبيض الله وجيهكم