الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

الآن برنامج تحويل الأرقام الى حروف

بدأه abd1980 في 3 فبراير 2011 · 11 رد · 16,917 مشاهدة · في Microsoft Visual Basic.NET
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

هذه اول مشاركة لي في هذا المنتدى ولاحظة ان كثيراً من المبرمجين يبحثون عن برنامج يحول الرقم الى حروف وهذه هي مكتبة dll من تصميمي وتقوم بكل دقة بتحويل الأرقام الى حروف عربية بدقة تامة من رقم 1 الى رقم 999,999,999 وقريبا سنضيف ترجمة المليارات وتخدم على فيجول ستوديو .net

طريقة استخدام البرنامج

Option Explicit On

Public Class Form1

Dim horof As New Hoorof.clsHoorofArabic

Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click

MsgBox(horof.تحويل_الأرقام_الى_حروف(CType(TextBox1.Text, Decimal), 3, "دينار", "درهم", True, True))

End Sub

Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click

horof.معلومات_عن_البرنامج()

End Sub

End Class

clsHoorof.rar

وانتظر ردودكم على الموضوع وشكرا

#2

الأخ الكريم abd1980, المنتدى منتدى تعليمي و من قوانينه أن كل برنامج يتم إرفاقه في موضوع يجب إرفاق الكود المصدر معه و ذلك لتعميم الفائدة على الجميع.

سيتم نقل الموضوع إلى المنتدى المناسب في حالة عدم إرفاق الكود المصدر.

بالتوفيق :)

#3

استجابة للأخ المشرف اضع لكم الكود المصدر مع مثال وستلاحظون الفكرة المبسطة لتحويل الأرقام الى حروف وهو كود قصير ويقوم بالتحويل الرقم الى حرف بسرعة وللعلم هذا الكود يحول من الرقم 1 ( واحد ) الى الرقم 999,999,999 (فقط تسعمائة وتسعة وتسعون مليون وتسعمائة وتسعة وتسعون الف وتسعمائة وتسعة وتسعون دينار لاغير) بالنسبة للعملة فهي متغيرة على رغبتك وإذا تركتها فراغ سوف تترجم بدون العملة وشكراً

وانتظر ردودكم وملاحظاتكم اخوكم عبدالرؤوف سالم البشير الزنتاني

منظومة الحروف.rar

1
#4

بارك الله فيك أخي abd1980 و مرحبا بك معنا في منتديات الفريق العربي للبرمجة :)

بالتوفيق :)

#5

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

هل هناك عملية عكسية تقوم بتحويل الاحرف الى ارقام

#6
aftfm كتب:

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

هل هناك عملية عكسية تقوم بتحويل الاحرف الى ارقام

طريقة تحويل الحروف الى ارقام طريقة صعبة لأن الحروف ربما تختلف من حيث الكتابة والفراغات

وشكراً

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

#7

السلام عليكم

لما لا يقوم بتحويل الارقام بعد الفاصلة العشرية الى حروف ايضا،

اتمنى اتمام العمل ليحقق اكبر فائدة مرجوة منه، وجزاك الله خيرا

#8

لقد حملت البرنامج و أشكرك مع أنني لم أرى مدى نجاح البرنامج

#9

أخي عبد الرؤوف سالم

هناك ملاحظتين علي دالة تفقيط الارقام الي حروف

post-46243-017639600 1318956354_thumb.jp

1- هذا الرقم لغوياً ثمانيمائة غير صحيح

2 - 350 درهم غير صحيح ومن المفترض ان يكون 35 درهم فقط

المرفقات
1.jpg

certifiedj.jpg

 

 

Image Hosted by ImageShack.us
#10

السلام عليكم

موديول تفقيط الأرقام

http://www.4shared.com/file/nsMPfv-e/Module1.html

تم تعديل هذه المشاركة بواسطة Mady-AGC في 18 أكتوبر 2011 في 20:36

1

منحة للخريجين وطلاب الجامعات و المعاهد

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

سبحان الله وبحمده سبحان الله العظيم

#11

أخي Mady-AGC

الملف المرفق امتداده bas

هل هذا الملف يخص V.S.Net ؟

certifiedj.jpg

 

 

Image Hosted by ImageShack.us
#12
محمد فؤاد تركي كتب:

أخي Mady-AGC

الملف المرفق امتداده bas

هل هذا الملف يخص V.S.Net ؟

السلام عليكم

الدالة موجودة هنا

	Function NumToTxt(ByVal TheNo As Double) As String
    	Dim MyArry1(0 To 9) As String
    	Dim MyArry2(0 To 9) As String
    	Dim MyArry3(0 To 9) As String
    	Dim MySubCur As String
    	Dim ReMark2 As String
    	Dim MyCur As String
    	Dim Myno As String
    	Dim GetNo As String
    	Dim RdNo As String
    	Dim My100 As String
    	Dim My10 As String
    	Dim My1 As String
    	Dim My11 As String
    	Dim My12 As String
    	Dim GetTxt As String
    	Dim Mybillion As String
    	Dim MyMillion As String
    	Dim MyThou As String
    	Dim MyHun As String
    	Dim MyFraction As String
    	Dim MyAnd As String
    	Dim I As Integer
    	Dim ReMark As String


    	If TheNo > 999999999999.99 Then
        	MsgBox("عفواً الحد الأقصى 12 رقم" & vbNewLine & "" & vbNewLine & "xxx,xxx,xxx.xx مثال", vbInformation + vbMsgBoxRight, "!!تنبيه")
        	NumToTxt = 0
        	Exit Function
    	End If

    	If TheNo < 0 Then
        	TheNo = TheNo * -1
        	ReMark = "يتبقى لكم "
    	Else
        	ReMark = "فقط "
    	End If
    	ReMark2 = " لا غير"
    	MyCur = " جنيه"
    	MySubCur = " قرش"

    	If TheNo = 0 Then
        	NumToTxt = "صفر جنيه"
        	Exit Function
    	End If

    	MyAnd = " و"
    	MyArry1(0) = ""
    	MyArry1(1) = "مائة"
    	MyArry1(2) = "مائتان"
    	MyArry1(3) = "ثلاثمائة"
    	MyArry1(4) = "أربعمائة"
    	MyArry1(5) = "خمسمائة"
    	MyArry1(6) = "ستمائة"
    	MyArry1(7) = "سبعمائة"
    	MyArry1(8) = "ثمانمائة"
    	MyArry1(9) = "تسعمائة"

    	MyArry2(0) = ""
    	MyArry2(1) = " عشر"
    	MyArry2(2) = "عشرون"
    	MyArry2(3) = "ثلاثون"
    	MyArry2(4) = "أربعون"
    	MyArry2(5) = "خمسون"
    	MyArry2(6) = "ستون"
    	MyArry2(7) = "سبعون"
    	MyArry2(8) = "ثمانون"
    	MyArry2(9) = "تسعون"

    	MyArry3(0) = ""
    	MyArry3(1) = "واحد"
    	MyArry3(2) = "اثنان"
    	MyArry3(3) = "ثلاثة"
    	MyArry3(4) = "أربعة"
    	MyArry3(5) = "خمسة"
    	MyArry3(6) = "ستة"
    	MyArry3(7) = "سبعة"
    	MyArry3(8) = "ثمانية"
    	MyArry3(9) = "تسعة"
    	'======================

    	GetNo = Format(TheNo, "000000000000.00")

    	I = 0
    	Do While I < 15

        	If I < 12 Then
            	Myno = Mid$(GetNo, I + 1, 3)
        	Else
            	Myno = "0" + Mid$(GetNo, I + 2, 2)
        	End If

        	If (Mid$(Myno, 1, 3)) > 0 Then

            	RdNo = Mid$(Myno, 1, 1)
            	My100 = MyArry1(RdNo)
            	RdNo = Mid$(Myno, 3, 1)
            	My1 = MyArry3(RdNo)
            	RdNo = Mid$(Myno, 2, 1)
            	My10 = MyArry2(RdNo)

            	If Mid$(Myno, 2, 2) = 11 Then My11 = "إحدى عشر"
            	If Mid$(Myno, 2, 2) = 12 Then My12 = "إثنى عشر"
            	If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة"

            	If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd
            	If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd

            	GetTxt = My100 + My1 + My10

            	If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then
                	GetTxt = My100 + My11
                	If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11
            	End If

            	If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then
                	GetTxt = My100 + My12
                	If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12
            	End If

            	If (I = 0) And (GetTxt <> "") Then
                	If ((Mid$(Myno, 1, 3)) > 10) Then
                    	Mybillion = GetTxt + " مليار"
                	Else
                    	Mybillion = GetTxt + " مليارات"
                    	If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار"
                    	If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران"
                	End If
            	End If

            	If (I = 3) And (GetTxt <> "") Then

                	If ((Mid$(Myno, 1, 3)) > 10) Then
                    	MyMillion = GetTxt + " مليون"
                	Else
                    	MyMillion = GetTxt + " ملايين"
                    	If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون"
                    	If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان"
                	End If
            	End If

            	If (I = 6) And (GetTxt <> "") Then
                	If ((Mid$(Myno, 1, 3)) > 10) Then
                    	MyThou = GetTxt + " ألف"
                	Else
                    	MyThou = GetTxt + " آلاف"
                    	If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف"
                    	If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان"
                	End If
            	End If

            	If (I = 9) And (GetTxt <> "") Then MyHun = GetTxt
            	If (I = 12) And (GetTxt <> "") Then MyFraction = GetTxt
        	End If

        	I = I + 3
    	Loop

    	If (Mybillion <> "") Then
        	If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd
    	End If

    	If (MyMillion <> "") Then
        	If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd
    	End If

    	If (MyThou <> "") Then
        	If (MyHun <> "") Then MyThou = MyThou + MyAnd
    	End If

    	If MyFraction <> "" Then
        	If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then
            	NumToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + MySubCur + ReMark2
        	Else
            	NumToTxt = ReMark + MyFraction + MySubCur + ReMark2
        	End If
    	Else
        	NumToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + MyCur + ReMark2
    	End If
	End Function

تم تعديل هذه المشاركة بواسطة Mady-AGC في 19 أكتوبر 2011 في 19:27

منحة للخريجين وطلاب الجامعات و المعاهد

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

سبحان الله وبحمده سبحان الله العظيم

مواضيع مشابهة