السلام عليكم اخواني الاعزاء ارجو منكم مساعدتي في هذا الموضوع وهو عند الكتابة في التكست بكس1 الذي هو الرئيسي بالاحرف الابتثية عند الضغط على الكوماند نحول الكتابة الى التكست بكس2 بالابجدية اي في التكست1 نكتب بالابتثية والنتيجة تخرج بالتكست2 بالابجدية كتابة فقط ولكم جزيل الشكر اخواني الاعزاء
جزاك الله خيرا اخي الكريم يعني بالتكست1 اذا كتبنا كلمة احمد نعتبرها من الحروف الابتثية ا -ب-ت-ث- ج -ح -خ -د -ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن ه و ي ---- نجعل كل حرف منها مقابل حرف من الابجدية ا ب ج د ه و ز ح ط ي ك ل م ن س ع ف ص ق ر ش ت ث خ ذ ض ظ غ ------ بالتكست2 النتيجة لكلمة احمد نبدل احرف الابتث باحرف الابجد تصبح كلمة احمد (ا و خ ح) اي كل حرف من كلمة احمد في التكست1 يبدل بالحرف المقابله من الابجد ونتيجت التبديل تخرج في التكست2 (ا و خ ح) لحاجتي الماسة لهذا البرنامج مع جزيل الشكر
- عرف مصفوفتين نصية واحده للغة الأبتثية والأخرى للأبجدية . عدد عناصر كل مصفوفة بعدد حروف اللغة . سأضع عدد 5 عناصر لكل مصفوفة وأنت غير وأكمل العدد والأحرف في المصفوفتين لكل لغة . هذا كود الزر :
كود :
Private Sub Command1_Click()
Dim Abtat(4) As String
Dim Abjd(4) As String
Dim I As Integer
Dim N As Integer
For I = 1 To Len(Trim$(Text1.Text))
If Trim$(Mid$(Trim$(Text1.Text), I, 1)) <> "" Then
For N = LBound(Abtat) To UBound(Abtat)
If Abtat(N) = Mid$(Trim$(Text1.Text), I, 1) Then
Text2.Text = Text2.Text & Abjd(N)
Exit For
End If
Next
Text2.Text = Text2.Text & Trim$(Mid$(Trim$(Text1.Text), I, 1))
Else
Text2.Text = Text2.Text & " "
End If
Next
10-04-13, 04:27 PM (آخر تعديل لهذه المشاركة : 10-04-13, 05:24 PM {2} بواسطة فتحى جمال الدين.)
شكرا جزيلا اخي العزيز وجزاك الله خيرا
ولكن عند الكتابة يحول الى الابجدية الحرف وبكرر معه حرف الابتثية مثلا ت يبدلها بالجيم ويضيف التاء بعدها تصبح جت يجب ان يبدل التاء بالجيم فقط بالتكست2 وقد رفقت لك المثال ولك جزيل الشكر اخي العزيز
For I = 1 To Len(Trim$(Text1.Text))
If Trim$(Mid$(Trim$(Text1.Text), I, 1)) <> "" Then
For N = LBound(Abtat) To UBound(Abtat)
If Abtat(N) = Mid$(Trim$(Text1.Text), I, 1) Then
Text2.Text = Text2.Text & Abjd(N)
Is_Found = True
Exit For
End If
Next
If Is_Found = False Then Text2.Text = Text2.Text & Trim$(Mid$(Trim$(Text1.Text), I, 1))
Else
Text2.Text = Text2.Text & " "
End If
Next
Private Sub Command1_Click()
Dim APos As Long
Dim TxtLen As Long
Dim Idx As Long
Dim AChar As String
Text2.Text = ""
TxtLen = Len(Text1.Text)
For Idx = 1 To TxtLen
AChar = Mid$(Text1.Text, Idx, 1)
APos = InStr(ALEFBA, AChar)
If APos = 0 Then
Text2.Text = Text2.Text & AChar
Else
Text2.Text = Text2.Text & Mid$(ABJADI, APos, 1)
End If
Next Idx
End Sub