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

يوجد طريقة بسيطة اتت علي راسي الان اونا اقرا المشاركة ، وهي :

من المعروفان شيفرة الحرف العربي تكون اكبر 128 دائما ،، لذلك يتم الفحص شيرفرة الحرف الذي يطبع في النص واذا كانت اكبر من 128 تسمع له بالكتابة اما اذا لا بقم بحذفه .

طريقة معرفة شيفرة اي حرف بالامر البسيط التالي :

Dim ChrCode As Integer 

ChrCode  = Asc("A")

وستقوم بالفحص علي رقم الكود في كل مرة يتم كتابة حرف اي في الحدث Change للتكست :

وهذا الكود كاملا

Private Sub Text1_Change()

Dim ChrCode As Integer

    If Len(Text1.Text) = 0 Then Exit Sub
If Asc(Mid(Text1.Text, Len(Text1.Text), 1)) > 128 Then
        Exit Sub
            Else
            'Delete Char..
        Text1.Text = Mid(Text1.Text, 1, Len(Text1.Text) - 1)
End If
    

End Sub

دعواتك لي

اشكرك اخى لكن الكون يعطى خطا لم يكتب اى حاجة فى التيكست بوكس

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

/index.php?showtopic=67573

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

أخى العزيز

إن شاء الله عندى الحل الذى تريده

عليك عمل الخطوتين التاليتين

أولا فى الجزء الخاص بالإعلانات العامة General_Decalre

''***** To Change Keyboard Language*****
Private Const HKL_PREV = 0
Private Const HKL_NEXT = 1
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal FLAGS As Long) As Long

ثم فى الحدث الذى تريده أن يغير اللغة مثلا txtArabic_GotFocus

تكتب الكود التالى

''**** To write in Arabic ****
  If GetKeyboardLayout(0) = &H4090409 Then ActivateKeyboardLayout HKL_NEXT, 0

أو الكود التالى مثلا فى txtEnglish_GotFocus

'**** To write in English ****
If GetKeyboardLayout(0) <> &H4090409 Then ActivateKeyboardLayout HKL_PREV, 0

بس نصيحتى أنك تحاول أن لا تزعج المستخدم ببرنامجك وكلما دخل عليه تغيرت لغته - فقد حدث هذا معى وأصبح برنامجى أنانى بصورة أو بأخرى

أسأل الله لك التوفيق

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

معلش أخى العزيز

قرأت مشاركتك على عجل فأجبت بتسرع

الكود السابق يغير لغة لوحة المفاتيح بصورة تلقائية ولكن لا يمنع تغيير اللغة والكتابة بغيرها

وهو مازال مفيد فى حالتك

ولكن ينقصك كود إضافى تكتبه فى حدث KeyPress

Private Sub txtWrite_KeyPress(KeyAscii As Integer)
 Dim St As String
 St = "اكتب كل الحروف التى تريده أن يتقيد بها هنا"
 If KeyAscii > 27 Then
  If InStr(St, Chr(KeyAscii)) = 0 Then
    KeyAscii = 0
    Beep
  End If
 End If
End Sub

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

لعلك فهمتنى

أخي العزيز

للكتابة بالعربية هذا الكود

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii > 64 And KeyAscii < 123 Then KeyAscii = 0

End Sub

وللكتابة بالأنكليزي فقط بدل الأرقام ( 123 و الـ 64 )

أخوك ميثم