As you may know the Persian Date is one the best calendars of the sientific world.
It starts from the first day of Spring season and evry season is mapped to the
quarters of the year.
I include hereby the formula for convering a Gerigoran date to Hijri-Shamsi date. This a VBA code that is easily readable and convertable to other languages.
I am ready to help you any way. ( and I will help you if decide to add persian Language to eM-Client)
It will be great for us to see Perian dates on eM-Client caledar section.
The Code is as follows:
Option Explicit
'Arrayes for Day and month names, Note that in VB6 I have to define arrayes in this way public
'but in other languages you can assign values to arrays when decaring the variable
’ the source code in VB.NET is also available (diffres mainly in array defenition )
'==========================================================
Private grgSumOfDays, hshSumOfDays, GergorianMonthEnglish, GergorianMonthFarsi, DayNamesFarsi, DayNamesEnglish, HijriShamsiMonth
'================================================================
Public Function ToHijriShamsiDate(Optional GorgianDate As String, Optional SeperatorChar As String = “/”, Optional ShortDate As Boolean = True) As String
If Not IsDate(GorgianDate) Then GorgianDate = Date
Dim hshYear As Integer, hshMonth As Integer, hshDay As Integer
Dim grgLeap As Boolean, hshLeap As Boolean
Dim hshElapsed As Integer, grgElapsed As Integer, XmasToNorooz As Integer
Dim I As Integer
If Not IsArray(grgSumOfDays) Then
initArrays
End If
Dim grgYear As Integer, grgMonth As Integer, grgDay As Integer
grgYear = CInt(Year(GorgianDate))
grgMonth = CInt(Month(GorgianDate))
grgDay = CInt(Day(GorgianDate))
hshYear = grgYear - 621
grgLeap = grgIsLeap(grgYear)
hshLeap = hshIsLeap(hshYear - 1)
grgElapsed = (grgSumOfDays(IIf(grgLeap, 1, 0))(grgMonth - 1)) + grgDay
XmasToNorooz = IIf(hshLeap And grgLeap, 80, 79)
If grgElapsed = hshElapsed Then
hshMonth = I
hshDay = hshElapsed - (hshSumOfDays(IIf(hshLeap, 1, 0))(I - 1))
Exit For
End If
Next I
If Len(SeperatorChar) <> 1 Then SeperatorChar = “/”
If ShortDate Then
ToHijriShamsiDate = hshYear & SeperatorChar & IIf(hshMonth < 10, “0” & hshMonth, hshMonth) & SeperatorChar & IIf(hshDay < 10, “0” & hshDay, hshDay)
Else
ToHijriShamsiDate = DayNamesFarsi(Weekday(GorgianDate, vbSunday) - 1) & "، " & hshDay & " " & HijriShamsiMonth(hshMonth - 1) & "، " & hshYear
End If
End Function
'============================================================
Public Function ToGregorianDate(ShamsiDate As String, Optional ShortDate As Boolean = True, Optional dateTxtEnglish As Boolean = True) As String
Dim grgYear As Integer, grgMonth, grgDay
Dim hshLeap As Boolean, grgLeap As Boolean
Dim hshElapsed As Integer, grgElapsed As Integer
Dim I As Integer
Dim hshYear As Integer, hshMonth As Integer, hshDay As Integer
If Not IsArray(grgSumOfDays) Then
initArrays
End If
hshYear = Val(Left(ShamsiDate, 4))
hshMonth = Val(Mid(ShamsiDate, 6, 2))
hshDay = Val(Right(ShamsiDate, 2))
grgYear = hshYear + 621
hshLeap = hshIsLeap(hshYear)
grgLeap = grgIsLeap(grgYear)
hshElapsed = (hshSumOfDays(IIf(hshLeap, 1, 0))(hshMonth - 1)) + hshDay
If hshMonth > 10 Or (hshMonth = 10 And hshElapsed > 286 + IIf(grgLeap, 1, 0)) Then
grgElapsed = hshElapsed - (286 + IIf(grgLeap, 1, 0))
grgYear = grgYear + 1
grgLeap = grgIsLeap(grgYear)
Else
hshLeap = hshIsLeap(hshYear - 1)
grgElapsed = hshElapsed + 79 + IIf(hshLeap, 1, 0) - IIf(grgIsLeap(grgYear - 1), 1, 0)
End If
For I = 1 To 12
If (grgSumOfDays(IIf(grgLeap, 1, 0))(I)) >= grgElapsed Then
grgMonth = I
grgDay = grgElapsed - (grgSumOfDays(IIf(grgLeap, 1, 0))(I - 1))
Exit For
End If
Next I
ToGregorianDate = grgYear & “/” & IIf(grgMonth < 10, “0” & grgMonth, grgMonth) & “/” & IIf(grgDay < 10, “0” & grgDay, grgDay)
If Not ShortDate Then
If dateTxtEnglish Then
ToGregorianDate = DayNamesEnglish(Weekday(ToMiladi, vbSunday) - 1) & ", " & GergorianMonthEnglish(grgMonth - 1) & " " & IIf(grgDay < 10, “0” & grgDay, grgDay) & ", " & grgYear
Else
ToGregorianDate = DayNamesFarsi(Weekday(ToMiladi, vbSunday) - 1) & "، " & grgDay & " " & GergorianMonthFarsi(grgMonth - 1) & "، " & grgYear
End If
End If
End Function
'====================================================
Private Function grgIsLeap(ByVal Year As Integer) As Boolean
grgIsLeap = ((Year Mod 4) = 0 And ((Year Mod 100) <> 0 Or (Year Mod 400) = 0))
End Function
'====================================================
Private Function hshIsLeap(ByVal Year As Integer) As Boolean
hshIsLeap = (Abs(Year - 1391) Mod 4 = 0)
End Function
'====================================================
Private Sub initArrays()
grgSumOfDays = Array(Array(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365), Array(0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366))
hshSumOfDays = Array(Array(0, 31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365), Array(0, 31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 366))
HijriShamsiMonth = Array(“فروردين”, “ارديبهشت”, “خرداد”, “تير”, “مرداد”, “شهريور”, “مهر”, “آبان”, “آذر”, “دي”, “بهمن”, “اسفند”)
GergorianMonthEnglish = Array(" January ", " February ", " March ", " April ", " May ", " June ", " July ", " August ", " September ", " October ", " November ", " December ")
GergorianMonthFarsi = Array(“ژانويه”, “فوريه”, “مارس”, “آوريل”, “مي”, “ژوئن”, “جولاي”, “آگوست”, “سپتامبر”, “اكتبر”, “نوامبر”, “دسامبر”)
DayNamesFarsi = Array(“يك شنبه”, “دوشنبه”, “سه شنبه”, “چهارشنبه”, “پنج شنبه”, “جمعه”, “شنبه”)
DayNamesEnglish = Array(“Sunday”, “Monday”, “Tuesday”, “Wednesday”, “Thursday”, “Friday”, “Saturday”)
End Sub