[Taha Okla]

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

هذا  كود لتفقيط الأوزان / وبـ ثلاث وحدات 
مثلاً  : 
-  كيلو - جرام - ملج
أو :
- طن - كيلو - جرام.

وهكذا ,,,

الكود : 

كود :

   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
       TextBox2.Text = UNitToText(TextBox1.Text, "كيلو", "جرام", "ملجرام")
   End Sub

   '===================================================================================================

   Function UNitToText(ByVal TheNo As Double, ByVal pUnit As String, ByVal pMilUnit As String, ByVal pMicroUnit As String) As String

       Dim strNum As String = Format(TheNo, "000000.000")
       '========================================================
       Dim Arr0() As String = Split(strNum, ".")

       If Arr0(0).Length > 6 Then
           Return "##########"
           Exit Function
       End If
       '========================================================
       Dim strMicroUnit As String
       If Val(Arr0(1)) > 0 Then
           strMicroUnit = Str3NumAsText(Arr0(1)) & " " & pMicroUnit
       Else
           strMicroUnit = ""
       End If

       Dim strMilUnit As String
       If Val(Mid(Arr0(0), 4, 3)) > 0 Then
           strMilUnit = Str3NumAsText(Mid(Arr0(0), 4, 3)) & " " & pMilUnit
       Else
           strMilUnit = ""
       End If

       Dim strUnit As String
       If Val(Mid(Arr0(0), 1, 3)) > 0 Then
           strUnit = Str3NumAsText(Mid(Arr0(0), 1, 3)) & " " & pUnit
       Else
           strUnit = ""
       End If

       If strUnit <> "" And (strMilUnit <> "" Or strMicroUnit <> "") Then
           strUnit = strUnit & " و "
       End If

       If strMilUnit <> "" And strMicroUnit <> "" Then
           strMilUnit = strMilUnit & " و "
       End If

       Return strUnit & strMilUnit & strMicroUnit

   End Function

   Private Function Str3NumAsText(T3Num As String) As String
       Dim Arr1(0 To 9) As String
       Dim Arr2(0 To 9) As String
       Dim Arr3(0 To 9) As String

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

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

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

       Dim S1 As Integer = Mid(T3Num, 3, 1)
       Dim S11 As String = Arr1(S1)
       Dim S2 As Integer = Mid(T3Num, 2, 1)
       Dim S22 As String = Arr2(S2)
       Dim S3 As Integer = Mid(T3Num, 1, 1)
       Dim S33 As String = Arr3(S3)

       If S2 = 1 Then
           If S1 = 1 Then
               S11 = "أحد"
               S22 = " عشر"
           ElseIf S1 = 2 Then
               S11 = "إثنا"
               S22 = " عشر"
           ElseIf S1 <> 0 Then
               S22 = " عشر"
           End If
       End If

       Dim andS1 As String, andS2 As String
       If (S3 = 0) Then
           andS1 = " و "
           andS2 = " " '010 011 001 021
           If S2 <= 1 And S1 >= 0 Then
               andS1 = ""
           ElseIf S2 > 1 And S1 > 0 Then
               andS1 = " و "
           End If
       Else
           andS1 = " و "
           andS2 = " و "
           If (S2 = 0) And (S1 = 0) Then  ' 100  200
               andS1 = ""
               andS2 = ""
           ElseIf (S2 <= 1) And (S1 >= 0) Then '101  110 108 119
               andS1 = " "
           ElseIf S2 > 1 And S1 > 0 Then
               andS1 = " و "
               andS2 = " و "

           End If
       End If

       Dim StrUnit As String = S33 & andS2 & S11 & andS1 & S22

       '=========================================================
       Return StrUnit

   End Function