منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب
تبديل الحوف في التكست بكس - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (http://vb4arb.com/vb)
+-- قسم : قسم أسئلة واستفسارات الأعضاء - المنتدى القديم (http://vb4arb.com/vb/forumdisplay.php?fid=94)
+--- قسم : قسم Visual Basic 6 وما قبله (http://vb4arb.com/vb/forumdisplay.php?fid=167)
+--- الموضوع : تبديل الحوف في التكست بكس (/showthread.php?tid=8404)

تبديل الحوف في التكست بكس - بهلوان - 09-04-13

السلام عليكم اخواني الاعزاء ارجو منكم مساعدتي في هذا الموضوع وهو عند الكتابة في التكست بكس1 الذي هو الرئيسي بالاحرف الابتثية عند الضغط على الكوماند نحول الكتابة الى التكست بكس2 بالابجدية اي في التكست1 نكتب بالابتثية والنتيجة تخرج بالتكست2 بالابجدية كتابة فقط ولكم جزيل الشكر اخواني الاعزاء

تبديل الحوف في التكست بكس - 3booody - 09-04-13

اخي ياريت توضح اكثر

تبديل الحوف في التكست بكس - بهلوان - 10-04-13

جزاك الله خيرا اخي الكريم يعني بالتكست1 اذا كتبنا كلمة احمد نعتبرها من الحروف الابتثية ا -ب-ت-ث- ج -ح -خ -د -ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن ه و ي ---- نجعل كل حرف منها مقابل حرف من الابجدية ا ب ج د ه و ز ح ط ي ك ل م ن س ع ف ص ق ر ش ت ث خ ذ ض ظ غ ------ بالتكست2 النتيجة لكلمة احمد نبدل احرف الابتث باحرف الابجد تصبح كلمة احمد (ا و خ ح) اي كل حرف من كلمة احمد في التكست1 يبدل بالحرف المقابله من الابجد ونتيجت التبديل تخرج في التكست2 (ا و خ ح) لحاجتي الماسة لهذا البرنامج مع جزيل الشكر

تبديل الحوف في التكست بكس - VB_Coder - 10-04-13

السلام عليكم

- عرف مصفوفتين نصية واحده للغة الأبتثية والأخرى للأبجدية . عدد عناصر كل مصفوفة بعدد حروف اللغة . سأضع عدد 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

- تحياتي .

تبديل الحوف في التكست بكس - بهلوان - 10-04-13

شكرا جزيلا اخي العزيز وجزاك الله خيرا
ولكن عند الكتابة يحول الى الابجدية الحرف وبكرر معه حرف الابتثية مثلا ت يبدلها بالجيم ويضيف التاء بعدها تصبح جت يجب ان يبدل التاء بالجيم فقط بالتكست2 وقد رفقت لك المثال ولك جزيل الشكر اخي العزيز

تبديل الحوف في التكست بكس - VB_Coder - 11-04-13

السلام عليكم

- فعلا فيه مشكلة . هذا الكود بعد التعديل :
كود :
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

- تحياتي .

تبديل الحوف في التكست بكس - بهلوان - 11-04-13

فعلا هذا تمام شكرا جزيلا اخوك عبد الكريم من العراق جزاك الله خيرا

تبديل الحوف في التكست بكس - ناجي إبراهيم - 11-04-13

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

محاولة قد تكون أقصر:

كود :
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

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

تبديل الحوف في التكست بكس - بهلوان - 11-04-13

حياك الله اخ ناجي العزيز صحيح طريقة مختصرة وشكرا جزيلا لك ولكل من شارك معي لكم جزيل الشكر وتحية خاصة للاخ ناجي ابراهيم