السلام عليكم اخواني الاعزاء ارجو منكم مساعدتي في هذا الموضوع وهو عند الكتابة في التكست بكس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
Abtat(0) = "ا"
Abtat(1) = "ب"
Abtat(2) = "ث"
Abtat(3) = "خ"
Abtat(4) = "ح"
Abjd(0) = "ن"
Abjd(1) = "ج"
Abjd(2) = "د"
Abjd(3) = "و"
Abjd(4) = "ع"
Text2.Text = ""
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
End Sub
- تحياتي .
شكرا جزيلا اخي العزيز وجزاك الله خيرا
ولكن عند الكتابة يحول الى الابجدية الحرف وبكرر معه حرف الابتثية مثلا ت يبدلها بالجيم ويضيف التاء بعدها تصبح جت يجب ان يبدل التاء بالجيم فقط بالتكست2 وقد رفقت لك المثال ولك جزيل الشكر اخي العزيز
السلام عليكم
- فعلا فيه مشكلة . هذا الكود بعد التعديل :
كود :
Dim Abtat(4) As String
Dim Abjd(4) As String
Dim I As Integer
Dim N As Integer
Dim Is_Found As Boolean
Abtat(0) = "ت"
Abtat(1) = "ث"
Abtat(2) = "ج"
Abtat(3) = "ح"
Abtat(4) = "خ"
Abjd(0) = "ج"
Abjd(1) = "د"
Abjd(2) = "ه"
Abjd(3) = "و"
Abjd(4) = "ز"
Text2.Text = ""
Is_Found = False
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 Const ALEFBA = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
Private Const ABJADI = "ابجدهوزحطيكلمنسعفصقرشتثخذضطغ"
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
نرجو الاستفادة و السلام.
حياك الله اخ ناجي العزيز صحيح طريقة مختصرة وشكرا جزيلا لك ولكل من شارك معي لكم جزيل الشكر وتحية خاصة للاخ ناجي ابراهيم