22-10-22, 04:43 AM
السلام عليكم ورحمة الله وبركاته
هذا كود لتفقيط الأوزان / وبـ ثلاث وحدات
مثلاً :
- كيلو - جرام - ملج
أو :
- طن - كيلو - جرام.
وهكذا ,,,
الكود :
هذا كود لتفقيط الأوزان / وبـ ثلاث وحدات
مثلاً :
- كيلو - جرام - ملج
أو :
- طن - كيلو - جرام.
وهكذا ,,,
الكود :
كود :
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