[Microformt]

الاخوة الكرام
السلام عليكم ورحمة وبركاته
الذكاء الصناعي كتب لي هذه الخوارزمية تحويل التاريخ الميلادي الى تاريخ هجري  



السؤال هنا 
كيف استخدم هذه الخوارزمية في برنامجي نامل المساعدة العاجله؟

كود :

Function GregorianToUmmAlQura(ByVal gDay As Integer, ByVal gMonth As Integer, ByVal gYear As Integer) As Variant

   ' إنشاء مصفوفة لحفظ التاريخ الهجري
   Dim hDate(2) As Integer
   
   ' إنشاء مصفوفة ثنائية لحفظ جدول المعادلات
   ' كل صف يحتوي على خمسة أعمدة: رقم الشهر الهجري، رقم الشهر الميلادي، رقم السنة الميلادية، عدد أيام الشهر، فارق الأيام بين التاريخ الميلادي والهجري
   Dim table(1749, 4) As Integer
   
   ' إضافة قيم جدول المعادلات
   table(0, 0) = 1: table(0, 1) = 7: table(0, 2) = 1937: table(0, 3) = 29: table(0, 4) = -11237
   table(1, 0) = 2: table(1, 1) = 8: table(1, 2) = 1937: table(1, 3) = 30: table(1, 4) = -11208
   table(2, 0) = 3: table(2, 1) = 9: table(2, 2) = 1937: table(2, 3) = 29: table(2, 4) = -11178
   ' ... وهكذا حتى نهاية الجدول
   
   ' حساب رقم الشهر الميلادي منذ يناير سنة 1900
   Dim gMonthNumber As Long
   gMonthNumber = DateDiff("m", #1/1/1900#, DateSerial(gYear, gMonth, gDay))
   
   ' حساب رقم الشهر الميلادي منذ يوليو سنة 1937 (بداية جدول المعادلات)
   Dim gMonthNumberFromTableStart As Long
   gMonthNumberFromTableStart = gMonthNumber - DateDiff("m", #1/1/1900#, #7/1/1937#)
   
   ' البحث في الجدول عن الصف المناسب للتاريخ الميلادي المدخل
   Dim i As Integer
   For i = 0 To 1749
       If gMonthNumberFromTableStart = table(i, 1) + (table(i, 2) - 1937) * 12 Then
           ' تحديد رقم الشهر الهجري
           hDate(1) = table(i, 0)
           ' تحديد رقم السنة الهجرية
           hDate(2) = 1356 + i \ 12
           ' تحديد رقم اليوم الهجري
           hDate(0) = gDay + table(i, 4)
           ' التحقق من عدم تجاوز رقم اليوم عدد أيام الشهر
           If hDate(0) > table(i, 3) Then
               hDate(0) = hDate(0) - table(i, 3)
               hDate(1) = hDate(1) + 1
               If hDate(1) > 12 Then
                   hDate(1) = 1
                   hDate(2) = hDate(2) + 1
               End If
           End If
           Exit For ' الخروج من حلقة التكرار بعد إيجاد الصف المناسب
       End If
   Next i
   
   ' إرجاع التاريخ الهجري كمصفوفة
   GregorianToUmmAlQura = hDate
   
End Function

نامل المساعدة وجزكم الله خيراً