15-04-23, 02:30 AM
السلام عليكم ورحمة الله وبركاته
هذا كود لتحويل الوقت لكلمات عربية
(الوقت المقروء من الساعة أو قاعدة بيانات مثلاً ،، وليس تفقيط للوقت وقت العمل المتراكم الذي يساوي عشرات الساعات، فذاك شيء آخر)
فقط اسند للدالة متغير من نوع وقت وتاريخ وهو سيقوم بإرجاع اللفظ العربي للوقت..
والآن أترككم مع الكود :
كود الاستدعاء هو :
هذا كود لتحويل الوقت لكلمات عربية
(الوقت المقروء من الساعة أو قاعدة بيانات مثلاً ،، وليس تفقيط للوقت وقت العمل المتراكم الذي يساوي عشرات الساعات، فذاك شيء آخر)
فقط اسند للدالة متغير من نوع وقت وتاريخ وهو سيقوم بإرجاع اللفظ العربي للوقت..
والآن أترككم مع الكود :
كود :
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)قال صلى الله عليه وسلم:
«كلمتان خفيفتان على اللسان
ثقيلتان في الميزان،حبيبتان إلى الرحمن:
سبحان الله وبحمده، سبحان الله العظيم».
