[Taha Okla]

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

هذا كود لتفقيط الوقت التراكمي 
مثلاً (وقت العمل  بالساعات والدقائق والثواني   --  لا يوجد أيام (أنتبه))

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

كود :

Public Function UNitToText2(Time_hhmmss As String) As String
   Dim TimeArray As String() = Strings.Split(Time_hhmmss, ":", -1, CompareMethod.Binary)
   If Len(TimeArray(0).ToString()) > 12 Then
       Return "رقم خيالي"
       Exit Function
   End If

   Dim strH As String = NoToTxt(TimeArray(0), "ساعة", "ساعتان", "ساعات")
   Dim StrM As String = Getmmss_String(TimeArray(1), "دقيقة", "دقيقتان", "دقائق")
   Dim StrS As String = Getmmss_String(TimeArray(2), "ثانية", "ثانيتان", "ثوانٍ")

   Dim strALTime As String = (strH + StrM + StrS).Replace("صفر و", "")

   Return strALTime
End Function


Private Function Getmmss_String(mmss As String, sQ1 As String, sQ2 As String, sQ3 As String) As String
   Dim Arr1(0 To 9) As String
   Dim Arr2(0 To 5) 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) = "خمسون"

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

   Dim S1 As Integer = Mid(mmss, 2, 1)
   Dim S11 As String = Arr1(S1)
   Dim S2 As Integer = Mid(mmss, 1, 1)
   Dim S22 As String = Arr2(S2)

   Dim SS0 As String

   If S2 = "0" Then
       Select Case S1
           Case "1"
               S11 = sQ1
           Case "2"
               S11 = sQ2
           Case > 2
               S11 = S11 & " " & sQ3
       End Select
       SS0 = S11
   ElseIf S2 = "1" Then
       Select Case S1
           Case "1"
               S11 = "أحد  "
               S22 = "عشر "
           Case "2"
               S11 = "إثنا  "
               S22 = "عشر "
           Case Else
               S22 = " عشر "
       End Select
       If S1 = "0" Then
           SS0 = S11 & S22 & sQ3
       Else
           SS0 = S11 & S22 & sQ1
       End If
   Else
       If S11.Trim() = "" Then
           SS0 = S22 & " " & sQ1
       Else
           SS0 = S11 & " و " & S22 & " " & sQ1
       End If
   End If
   '=========================================================
   If SS0.Trim() <> "" Then SS0 = " و " & SS0
   Return SS0

End Function

Public Function NoToTxt(TheNo As Long, strhH1 As String, strhH2 As String, strhH3 As String) As String
   Dim MyArry1(0 To 9) As String
   Dim MyArry2(0 To 9) As String
   Dim MyArry3(0 To 9) 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 = 0 Then
       NoToTxt = "صفر"
       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) = "تسع"

   If Len(TheNo.ToString()) > 12 Then
       Return "رقم خيالي"
       Exit Function
   End If

   GetNo = Strings.Format(TheNo, "000000000000")
   '  GetNo = Strings.Format(TheNo, "000,000,000,000")
   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


   Dim NoToTxt2 As String
   If MyFraction <> "" Then

       If Mybillion <> "" Or Mybillion <> "" Or MyThou <> "" Or MyHun <> "" Then
           NoToTxt2 = String.Concat(New String() {ReMark, Mybillion, MyMillion, MyThou, MyHun, " ", strhH1})
       Else
           NoToTxt2 = ReMark + MyFraction
       End If
   Else

       If Strings.Right(MyHun, 4) = "واحد" Then
           MyHun = Strings.Mid(MyHun, 1, Strings.Len(MyHun) - 4) + strhH1
       Else

           If Strings.Right(MyHun, 5) = "اثنان" Then
               MyHun = Strings.Mid(MyHun, 1, Strings.Len(MyHun) - 5) + strhH2
           Else
               Dim flag37 As Boolean = Strings.Right(MyHun, 4) = "ثلاث" Or Strings.Right(MyHun, 4) = "أربع" Or
                                       Strings.Right(MyHun, 3) = "خمس" Or Strings.Right(MyHun, 2) = "ست" Or
                                       Strings.Right(MyHun, 3) = "سبع" Or Strings.Right(MyHun, 4) = "ثمان" Or
                                       Strings.Right(MyHun, 3) = "تسع" Or Strings.Right(MyHun, 3) = "عشر"
               If flag37 Then
                   MyHun = MyHun + " " + strhH3
               Else
                   MyHun = MyHun + " " + strhH1
               End If
           End If
       End If

       If Strings.Len(TheNo) > 1 Then
           Dim T As Integer = Val(Strings.Right(TheNo, 2))
           Dim flag39 As Boolean = T > 10 And T < 20
           If flag39 Then
               MyHun = MyHun.Replace(strhH3, strhH1)
           End If
       End If
       NoToTxt2 = String.Concat(New String() {ReMark, Mybillion, MyMillion, MyThou, MyHun})
   End If



   Return NoToTxt2
End Function

لتستطيع استدعاء التفقيط يجب أن تكون صيغ المدخلات الرقمية بهذا الشكل :
hh : mm : ss    (بدون مسافات)
الـ ss  تبدأ من 0 وتنتهي بـ 59   
الـ mm   تبدأ من 0 وتنتهي بـ 59   
الـ hh تبدأ بالـ 0 وتنتهي بـ 999 مليار (صحيح أن الرقم مبالغ ولكن معذرة إلى الفضائيين اذا فكروا يعلموا أولادهم على الفيجول استديو)..

لاستدعاء الدالة نستخدم الكود :

كود :

Label1.Text = UNitToText2(TextBox1.Text)

ملاحظة : ربما الكود يحتوي على أخطاء..
يرجى الانتباه عند تجريبه ..