[Taha Okla]

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

هذا كود لتحويل الوقت لكلمات عربية 
(الوقت المقروء من الساعة أو قاعدة بيانات مثلاً ،، وليس تفقيط للوقت وقت العمل المتراكم الذي يساوي عشرات الساعات، فذاك شيء آخر)

فقط اسند للدالة متغير من نوع وقت وتاريخ   وهو سيقوم بإرجاع اللفظ العربي للوقت..

والآن أترككم مع الكود :

كود :

Public Function UNitToText(ByVal Time_hhmmss As DateTime) As String

   Dim strNum_tt As String = Time_hhmmss.ToString("tt")
   Dim strNum As String = Time_hhmmss.ToString("hh:mm:ss")

   '========================================================
   Dim TimeArray() As String = Split(strNum, ":")

   Dim strH As String, StrM As String, StrS As String

   strH = GetHour_String(TimeArray(0))

   StrM = Getmmss_String(TimeArray(1), "دقيقة", "دقيقتان", "دقائق")

   StrS = Getmmss_String(TimeArray(2), "ثانية", "ثانيتان", "ثوانٍ")

   Dim str_tt As String = " مساءاً"
   If strNum_tt = "AM" Then str_tt = " صباحاً"

   Dim hs1 As String = "الساعة "

   Return hs1 & strH & str_tt & StrM & StrS
End Function

Private Function GetHour_String(hH As String) As String

   Select Case hH
       Case "00"
           Return "الثانية عشر"
       Case "01"
           Return "الواحدة"
       Case "02"
           Return "الثانية"
       Case "03"
           Return "الثالثة"
       Case "04"
           Return "الرابعة"
       Case "05"
           Return "الخامسة"
       Case "06"
           Return "السادسة"
       Case "07"
           Return "السابعة"
       Case "08"
           Return "الثامنة"
       Case "09"
           Return "التاسعة"
       Case "10"
           Return "العاشرة"
       Case "11"
           Return "الحادية عشر"
       Case "12"
           Return "الثانية عشر"
       Case Else
           Return ""
   End Select
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

كود الاستدعاء هو : 

كود :

Label1.Text = UNitToText(DateTime.Now)