+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (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=6835)
مساعدة لتغيير الاحرف الى ارقام - بهلوان - 04-11-12
السلام عليكم اخواني الاعزاء اريد تحويل الاحرف الابجديه لكلمة بالتكست 1 الى ارقام مثلا (امجد) الابجدية الالف 1 الباء 2 الجيم3 الدال 4 ....... الى الياء 28 فتخرج امجد بالتكست 2 (1-13-3-4) او تجمع القيمة وتوضع في التكست 2 مع فائق تقديري لكم وشكرا جزيلا
مساعدة لتغيير الاحرف الى ارقام - بهلوان - 07-11-12
السلام عليكم ورحمة الله وبركاته اخواني الاعزاء صارلي اسبوع منتظر اجابة معقولة لا أحد يساعد الا بطلب اغاثة لكم موضوعي السابق اللي عند حل لا يقصر ومشكورين
مساعدة لتغيير الاحرف الى ارقام - ناجي إبراهيم - 07-11-12
السلام عليكم...
1. ضع على الـ Form 3 مربعات نص (Text1 و Text2 و Text3) و زر أمر (Command1).
2. انسخ الكود التالي:
كود :
Private ArabLetters As String
Private Hamzat As String
Private Sub Command1_Click()
Dim Idx As Long
Dim MyText As String
Dim ALetter As String
Dim APos As Long
Dim AResult As String
Dim ASum As Long
Text2.Text = ""
Text3.Text = "0"
AResult = ""
ASum = 0
MyText = Trim(Text1.Text)
If MyText = "" Then Exit Sub
For Idx = 1 To Len(MyText)
ALetter = Mid$(MyText, Idx, 1)
APos = InStr(Hamzat, ALetter)
If APos = 0 Then
If AResult <> "" Then AResult = AResult & " - "
APos = InStr(ArabLetters, ALetter)
If APos = 0 Then
AResult = AResult & "¿"
Else
AResult = AResult & CStr(APos)
ASum = ASum + APos
End If
Else
If AResult <> "" Then AResult = AResult & " - "
AResult = AResult & "1"
ASum = ASum + 1
End If
Next Idx
Text2.Text = AResult
Text3.Text = CStr(ASum)
End Sub
Private Sub Form_Load()
Hamzat = "ءاأإؤئ"
ArabLetters = "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ"
End Sub3. شغل البرنامج و اكتب الكلمة في Text1 ثم انقر الزر. ستظهر الأرقام المقابلة للحروف في Text2 و مجموع قيمها في Text3.
* الكود يستعمل الترتيب الأبجدي (أبجد هوز حطي... إلخ.) و ليس الترتيب الألفبائي (أ.ب.ت.ث. ... إلخ)، و طبعاً يمكنك تغيير ذلك.
* الكود يتجاهل أي رمز آخر غير الحروف العربية، بما في ذلك الفراغات، و يضع بدل قيمتها علامة استفهام.
* الكود يعتبر الألف و جميع أشكال الهمزة حرفاً واحداً (نفس القيمة = 1).
4. نرجو الاستفادة و السلام.
مساعدة لتغيير الاحرف الى ارقام - عبدالله الصافي - 07-11-12
بارك الله فيك أخي الكريم فعلا كود جامد جدا .
ولكن أود أن أطلب منك شرح للدوال المستخدمة.
وفعلا جربته أيضا علي الأحرف الأنجليزية وأشتغل بشكل جيد جدا.
مساعدة لتغيير الاحرف الى ارقام - ناجي إبراهيم - 07-11-12
السلام عليكم...
ما يغلى عليك غالي، أخي عبدالله الصافي (و بقية الإخوة طبعاً
)...أولاً وضعت الهمزات في نص (String) مستقل لأن الهمزة تأخذ أشكالاً مختلفة ( ء أ إ ؤ ئ ا ) حسب موقعها و حركتها.
الدوال:
الدالة Trim: تأخذ نصاً (String) و تعيد نسخة منه بعد إزالة الفراغات السابقة (Leading spaces) و الفراغات اللاحقة (Trailing spaces) الفراغات السابقة هي التي توجد قبل أول حرف أو رمز في الـ String و الفراغات اللاحقة هي التي توجد بعد آخر حرف أو رمز في النص. وطبعاً هذه الدالة لا تحذف الفراغات الموجودة داخل النص (بين الكلمات و الحروف أو الرموز).
الدالة Mid: تعمل على إرجاع جزء من النص (String) مع تحديد بدابة الجزء المطلوب و طوله. صيغتها العامة كالتالي:
كود :
X = Mid$(AString, Start, Length)= AString: هو النص الذي نريد الحصول على جزء منه.
= Start: رقم الحرف أو الرمز الذي نريد أن يبدأ الجزء منه. أول حرف أو رمز في النص رقمه 1.
= Length: طول الجزء الذي نريد الحصول عليه. هذا البارامتر اختياري، أي يمكن عدم تحديده، و في هذه الحالة تعيد الدالة جزءاً يمتد من الحرف أو الرمز الذي رقمه Start إلى نهاية النص.
مثلاً:
كود :
MyStr = "بسم الله الرحمن الرحيم"
X = Mid(MyStr, 10, 6)
MsgBox Xالدالة InStr: تتأكد من وجود نص ضمن نص آخر. إذا وجدت النص المطلوب فإنها تعيد موقع أول تواجد له، و إذا لم تجده تعيد صفراً (0). و صيغتها العامة كالتالي:
كود :
N = InStr(AString1, AString2)= AString1: النص الذي نبحث فيه.
= AString2: النص الذي نبحث عنه.
مثلاً:
كود :
J = InStr("محمد رسول الله صلى الله عليه و سلم و لا رسول بعده", "رسول")الدالة CStr: تعمل على تحويل قيمة عددية إلى String.
* ملاحظة: لعلك لاحظت أن بعض الدوال تكتب مع الرمز $ أو من غيره، مثل:
كود :
Mid و Mid$
Trim و Trim$* الدالة الأخيرة: نرجو الاستفادة و السلام!
مساعدة لتغيير الاحرف الى ارقام - عبدالله الصافي - 08-11-12
والله لا أعلم ماذا أقول لك , غير ما قاله رسول الله صلي الله عليه وسلم.
بارك الله فيك وجعله في ميزان حسناتك.
ونرجو من الأخوة الكرام عند وضع كود جديد أن يقوم بعمل شرح بسيط له حتي نتمكن من إستخدامه بشكل صحيح في مشاريع أخري.
مساعدة لتغيير الاحرف الى ارقام - بهلوان - 08-11-12
السلام عليكم شكرا جزيلا اخي العزيز ناجي على الكود الرائع كنت في امس الحاجة له جزاك الله خيرا
مساعدة لتغيير الاحرف الى ارقام - بهلوان - 08-11-12
[COLOR="#FF0000"]جزاك الله خير اخ ناجي ولو قد اكون اثقلت عيك الموضوع لكن اذا كانت الابجدية قيمها كالاتي
ا=1 ب=2 ج=3 د=4 ه=5 و=6 ز=7 ح=8 ط=9 ي=10 ك=20 ل=30 م=40 ن=50 س=60 ع=70 ف=80 ص=90 ق=100 ر=200 ش=300 ت=400 ث=500 خ=600 ذ=700 ض=800 ظ=900 غ=1000 هل لعمل لها مصفوفة وكيف ربطها بالكود السابق وشكرا لك مع فائق احترامي[/COLOR]
مساعدة لتغيير الاحرف الى ارقام - عبدالله الصافي - 08-11-12
بهلوان كتب :[COLOR="#FF0000"]جزاك الله خير اخ ناجي ولو قد اكون اثقلت عيك الموضوع لكن اذا كانت الابجدية قيمها كالاتي
ا=1 ب=2 ج=3 د=4 ه=5 و=6 ز=7 ح=8 ط=9 ي=10 ك=20 ل=30 م=40 ن=50 س=60 ع=70 ف=80 ص=90 ق=100 ر=200 ش=300 ت=400 ث=500 خ=600 ذ=700 ض=800 ظ=900 غ=1000 هل لعمل لها مصفوفة وكيف ربطها بالكود السابق وشكرا لك مع فائق احترامي[/COLOR]
طلبك إن شاء الله كما تريد بالمرفقات
مساعدة لتغيير الاحرف الى ارقام - ناجي إبراهيم - 08-11-12
السلام عليكم...
الشكر للأخ عبد الله الصافي على الحل، و يمكن اختصاره باستعمال جملة Select Case مع الكود الأصلي:
كود :
Private ArabLetters As String
Private Hamzat As String
Private Sub Command1_Click()
Dim Idx As Long
Dim MyText As String
Dim ALetter As String
Dim APos As Long
Dim AResult As String
Dim ASum As Long
Text2.Text = ""
Text3.Text = "0"
AResult = ""
ASum = 0
MyText = Trim(Text1.Text)
If MyText = "" Then Exit Sub
For Idx = 1 To Len(MyText)
ALetter = Mid$(MyText, Idx, 1)
APos = InStr(Hamzat, ALetter)
If APos = 0 Then
If AResult <> "" Then AResult = AResult & " - "
APos = InStr(ArabLetters, ALetter)
[color=#FF0000]Select Case[/color] APos
Case 0
AResult = AResult & "؟"
Case Is > 18
AResult = AResult & CStr((APos - 18) * 100)
ASum = ASum + (APos - 18) * 100
Case Is > 9
AResult = AResult & CStr((APos - 9) * 10)
ASum = ASum + (APos - 9) * 10
Case Else
AResult = AResult & CStr(APos)
ASum = ASum + APos
[color=#FF0000]End Select[/color]
Else
If AResult <> "" Then AResult = AResult & " - "
AResult = AResult & "1"
ASum = ASum + 1
End If
Next Idx
Text2.Text = AResult
Text3.Text = CStr(ASum)
End Sub
Private Sub Form_Load()
Hamzat = "ءاأإؤئ"
ArabLetters = "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ"
End Subنرجو الاستفادة و السلام.