سلام
از دوستان کسی الگوریتم تبدیل تاریخ میلادی به شمسی را داره؟
برنامه اش را نمی خوام روش انجام را می خوام که توضیح داده باشه چه طوری این عمل را انجام میدن.
Printable View
سلام
از دوستان کسی الگوریتم تبدیل تاریخ میلادی به شمسی را داره؟
برنامه اش را نمی خوام روش انجام را می خوام که توضیح داده باشه چه طوری این عمل را انجام میدن.
Public Sal As Long, Mah As Long, Rooz As Long, YearM As Long, MonthM As Long, DayM As Long
Public Sub Tarikh(Sal, Mah, Rooz)
IfError = False
Kabiseh = False
If Rooz > 31 Or Rooz < 1 Or Mah > 12 Or Mah < 1 Then IfError = True
If Mah > 6 And Rooz = 31 Then IfError = True
If Mah = 12 And (Sal + 1) Mod 4 <> 0 And Rooz > 29 Then IfError = True
If (IfError And NoErrorDateConvert = False) Then
MsgBox "ÊÇÑíÎ ãÚÊÈÑ äãí ÈÇÔÏ", vbCritical, ""
Exit Sub
End If
If (Sal + 1) Mod 4 = 0 Then ' ÓÇá ßÈíÓå ÈÇÔÏ
Kabiseh = True
Select Case Mah
Case 1
If Rooz < 13 Then
DayM = Rooz + 19: MonthM = 3: YearM = Sal + 621
Else
DayM = Rooz - 12: MonthM = 4: YearM = Sal + 621
End If
Case 2
If Rooz < 12 Then
DayM = Rooz + 19: MonthM = 4: YearM = Sal + 621
Else
DayM = Rooz - 11: MonthM = 5: YearM = Sal + 621
End If
Case 3
If Rooz < 12 Then
DayM = Rooz + 20: MonthM = 5: YearM = Sal + 621
Else
DayM = Rooz - 11: MonthM = 6: YearM = Sal + 621
End If
Case 4
If Rooz < 11 Then
DayM = Rooz + 20: MonthM = 6: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 7: YearM = Sal + 621
End If
Case 5
If Rooz < 11 Then
DayM = Rooz + 21: MonthM = 7: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 8: YearM = Sal + 621
End If
Case 6
If Rooz < 11 Then
DayM = Rooz + 21: MonthM = 8: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 9: YearM = Sal + 621
End If
Case 7
If Rooz < 10 Then
DayM = Rooz + 21: MonthM = 9: YearM = Sal + 621
Else
DayM = Rooz - 9: MonthM = 10: YearM = Sal + 621
End If
Case 8
If Rooz < 11 Then
DayM = Rooz + 21: MonthM = 10: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 11: YearM = Sal + 621
End If
Case 9
If Rooz < 11 Then
DayM = Rooz + 20: MonthM = 11: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 12: YearM = Sal + 621
End If
Case 10
If Rooz < 12 Then
DayM = Rooz + 20: MonthM = 12: YearM = Sal + 621
ElseIf Rooz = 12 Then
DayM = 1: MonthM = 1: YearM = Sal + 622
Else
DayM = Rooz - 11: MonthM = 1: YearM = Sal + 622
End If
Case 11
If Rooz < 13 Then
DayM = Rooz + 19: MonthM = 1: YearM = Sal + 622
Else
DayM = Rooz - 12: MonthM = 2: YearM = Sal + 622
End If
Case 12
If Rooz < 11 Then
DayM = Rooz + 18: MonthM = 2: YearM = Sal + 622
Else
DayM = Rooz - 10: MonthM = 3: YearM = Sal + 622
End If
End Select
Else ' ÓÇá ßÈíÓå äÈÇÔÏ
Select Case Mah
Case 1
If Rooz < 12 Then
DayM = Rooz + 20: MonthM = 3: YearM = Sal + 621
Else
DayM = Rooz - 11: MonthM = 4: YearM = Sal + 621
End If
Case 2
If Rooz < 11 Then
DayM = Rooz + 20: MonthM = 4: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 5: YearM = Sal + 621
End If
Case 3
If Rooz < 11 Then
DayM = Rooz + 21: MonthM = 5: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 6: YearM = Sal + 621
End If
Case 4
If Rooz < 10 Then
DayM = Rooz + 21: MonthM = 6: YearM = Sal + 621
Else
DayM = Rooz - 9: MonthM = 7: YearM = Sal + 621
End If
Case 5
If Rooz < 10 Then
DayM = Rooz + 22: MonthM = 7: YearM = Sal + 621
Else
DayM = Rooz - 9: MonthM = 8: YearM = Sal + 621
End If
Case 6
If Rooz < 10 Then
DayM = Rooz + 22: MonthM = 8: YearM = Sal + 621
Else
DayM = Rooz - 9: MonthM = 9: YearM = Sal + 621
End If
Case 7
If Rooz < 9 Then
DayM = Rooz + 22: MonthM = 9: YearM = Sal + 621
Else
DayM = Rooz - 8: MonthM = 10: YearM = Sal + 621
End If
Case 8
If Rooz < 10 Then
DayM = Rooz + 22: MonthM = 10: YearM = Sal + 621
Else
DayM = Rooz - 9: MonthM = 11: YearM = Sal + 621
End If
Case 9
If Rooz < 10 Then
DayM = Rooz + 21: MonthM = 11: YearM = Sal + 621
Else
DayM = Rooz - 9: MonthM = 12: YearM = Sal + 621
End If
Case 10
If Rooz < 11 Then
DayM = Rooz + 21: MonthM = 12: YearM = Sal + 621
Else
DayM = Rooz - 10: MonthM = 1: YearM = Sal + 622
End If
Case 11
If Rooz < 12 Then
DayM = Rooz + 20: MonthM = 1: YearM = Sal + 622
Else
DayM = Rooz - 11: MonthM = 2: YearM = Sal + 622
End If
Case 12
GoTo EsfandHandleNoKabiseh
End Select
End If
Exit Sub
EsfandHandleNoKabiseh:
If (Abs(1380 - Sal)) Mod 4 = 0 Then
If Rooz < 10 Then
DayM = Rooz + 19: MonthM = 2: YearM = Sal + 622
Else
DayM = Rooz - 9: MonthM = 3: YearM = Sal + 622
End If
ElseIf (Abs(1381 - Sal)) Mod 4 = 0 Then
If Rooz < 10 Then
DayM = Rooz + 19: MonthM = 2: YearM = Sal + 622
Else
DayM = Rooz - 9: MonthM = 3: YearM = Sal + 622
End If
ElseIf (Abs(1382 - Sal)) Mod 4 = 0 Then
If Rooz < 11 Then
DayM = Rooz + 19: MonthM = 2: YearM = Sal + 622
Else
DayM = Rooz - 10: MonthM = 3: YearM = Sal + 622
End If
End If
End Sub
Public Sub M2H(Year, month, day)
Select Case month
Case 1
If (Year - 1) Mod 4 = 0 Then
If day < 20 Then
Rooz = day + 11: Mah = 10: Sal = Year - 622
Else
Rooz = day - 19: Mah = 11: Sal = Year - 622
End If
Else
If day < 21 Then
Rooz = day + 10: Mah = 10: Sal = Year - 622
Else
Rooz = day - 20: Mah = 11: Sal = Year - 622
End If
End If
Case 2
If (Year - 1) Mod 4 = 0 Then
If day < 19 Then
Rooz = day + 12: Mah = 11: Sal = Year - 622
Else
Rooz = day - 18: Mah = 12: Sal = Year - 622
End If
Else
If day < 20 Then
Rooz = day + 11: Mah = 11: Sal = Year - 622
Else
Rooz = day - 19: Mah = 12: Sal = Year - 622
End If
End If
Case 3
If ((Year) Mod 4 = 0) Then
If day < 20 Then
Rooz = day + 10: Mah = 12: Sal = Year - 622
Else
Rooz = day - 19: Mah = 1: Sal = Year - 621
End If
Else
If ((Year) Mod 2 = 0) Then
If day < 21 Then
Rooz = day + 9: Mah = 12: Sal = Year - 622
Else
Rooz = day - 20: Mah = 1: Sal = Year - 621
End If
Else
If Int((Year + Year - 1) / 2) Mod 4 = 0 Then
If day < 21 Then
Rooz = day + 10: Mah = 12: Sal = Year - 622
Else
Rooz = day - 20: Mah = 1: Sal = Year - 621
End If
End If
If Int((Year + Year - 1) / 2) Mod 4 <> 0 Then
If day < 21 Then
Rooz = day + 9: Mah = 12: Sal = Year - 622
Else
Rooz = day - 20: Mah = 1: Sal = Year - 621
End If
End If
End If
End If
Case 4
If (Year) Mod 4 = 0 Then
If day < 20 Then
Rooz = day + 12: Mah = 1: Sal = Year - 621
Else
Rooz = day - 19: Mah = 2: Sal = Year - 621
End If
Else
If day < 21 Then
Rooz = day + 11: Mah = 1: Sal = Year - 621
Else
Rooz = day - 20: Mah = 2: Sal = Year - 621
End If
End If
Case 5
If (Year) Mod 4 = 0 Then
If day < 21 Then
Rooz = day + 11: Mah = 2: Sal = Year - 621
Else
Rooz = day - 20: Mah = 3: Sal = Year - 621
End If
Else
If day < 22 Then
Rooz = day + 10: Mah = 2: Sal = Year - 621
Else
Rooz = day - 21: Mah = 3: Sal = Year - 621
End If
End If
Case 6
If (Year) Mod 4 = 0 Then
If day < 21 Then
Rooz = day + 11: Mah = 3: Sal = Year - 621
Else
Rooz = day - 20: Mah = 4: Sal = Year - 621
End If
Else
If day < 22 Then
Rooz = day + 10: Mah = 3: Sal = Year - 621
Else
Rooz = day - 21: Mah = 4: Sal = Year - 621
End If
End If
Case 7
If (Year) Mod 4 = 0 Then
If day < 22 Then
Rooz = day + 10: Mah = 4: Sal = Year - 621
Else
Rooz = day - 21: Mah = 5: Sal = Year - 621
End If
Else
If day < 23 Then
Rooz = day + 9: Mah = 4: Sal = Year - 621
Else
Rooz = day - 22: Mah = 5: Sal = Year - 621
End If
End If
Case 8
If (Year) Mod 4 = 0 Then
If day < 22 Then
Rooz = day + 10: Mah = 5: Sal = Year - 621
Else
Rooz = day - 21: Mah = 6: Sal = Year - 621
End If
Else
If day < 23 Then
Rooz = day + 9: Mah = 5: Sal = Year - 621
Else
Rooz = day - 22: Mah = 6: Sal = Year - 621
End If
End If
Case 9
If (Year) Mod 4 = 0 Then
If day < 22 Then
Rooz = day + 10: Mah = 6: Sal = Year - 621
Else
Rooz = day - 21: Mah = 7: Sal = Year - 621
End If
Else
If day < 23 Then
Rooz = day + 9: Mah = 6: Sal = Year - 621
Else
Rooz = day - 22: Mah = 7: Sal = Year - 621
End If
End If
Case 10
If (Year) Mod 4 = 0 Then
If day < 22 Then
Rooz = day + 9: Mah = 7: Sal = Year - 621
Else
Rooz = day - 21: Mah = 8: Sal = Year - 621
End If
Else
If day < 23 Then
Rooz = day + 8: Mah = 7: Sal = Year - 621
Else
Rooz = day - 22: Mah = 8: Sal = Year - 621
End If
End If
Case 11
If (Year) Mod 4 = 0 Then
If day < 21 Then
Rooz = day + 10: Mah = 8: Sal = Year - 621
Else
Rooz = day - 20: Mah = 9: Sal = Year - 621
End If
Else
If day < 22 Then
Rooz = day + 9: Mah = 8: Sal = Year - 621
Else
Rooz = day - 21: Mah = 9: Sal = Year - 621
End If
End If
Case 12
If (Year) Mod 4 = 0 Then
If day < 21 Then
Rooz = day + 10: Mah = 9: Sal = Year - 621
Else
Rooz = day - 20: Mah = 10: Sal = Year - 621
End If
Else
If day < 22 Then
Rooz = day + 9: Mah = 9: Sal = Year - 621
Else
Rooz = day - 21: Mah = 10: Sal = Year - 621
End If
End If
End Select
Sal = Val(Right(Str(Sal), 2))
End Sub
سلام
این روش اصلاَ جالب نیست! و ندیده میگویم که فقط بین بازه 33 ساله جاری از شروع کبیسه پنجساله 1375 - 1370 درست کار میکند.
حال کد نویسی ندارم، چیز آماده هم ندارم، ولی سریعترین راه که دقت مناسبی هم داره این است که تاریخ شمسی جاری را به تعداد روزهای گذشته از هجرت تبدیل کنید و آنگاه تفاوت روزهای میلادی و شمسی را لحاظ کرده و مجدداَ تعداد روزها را به تاریخ میلادی تبدیل کنید، و بلعکس. طرف میلادی مشکل ندارم چون VB6 تاریخ را به صورت تعداد روز نگه میدارد و برای طرف شمسی هم فقط کافیست لحاظ کنید که هر چهر سال کبیسه ای داریم و هر 33 سال هم یک کبیسه 5 ساله.
البته این هم کامل کامل نیست ولی در نوع خود دقت بسیار بالایی دارد.
راحت هم است، کمی فکر کنید متوجه میشوید.
تعداد روزها از اول هجرت=تعداد روزهای از تحویل سال + سال * 365 + تعدا دکبیسه های پشت سر گذاشته
من هم موافقم این روش اصلا دقیق نیست و تاریخ اشتباهی رو برمیگردونه!
توی بخش "حل مشکلات فارسی و ..." نمونه های تاریخ شمسی رو گذاشتن،اونا باز به مراتب بهتره.اونا رو نگاه کنین و یه تست بکنید.
DateParam = Trim(DateParam)
Y = CInt(Left(DateParam, InStr(DateParam, "/") - 1))
m = CInt(Mid(DateParam, InStr(DateParam, "/") + 1, InStrRev(DateParam, "/") - InStr(DateParam, "/") - 1))
D = CInt(Mid(DateParam, InStrRev(DateParam, "/") + 1))
If Y < 1300 Then Y = Y + 1300
Miladi Y, m, D
ChangeToMiladi = CStr(DateSerial(Y, m, D))
End Function
Sub Miladi(Y, m, D)
'******************* Leap year
If Y = 1378 Then
If m = 12 And D = 10 Then
Y = 2000: m = 2: D = 29: Exit Sub
End If
If m = 12 And D > 10 Then
D = D - 1
End If
ElseIf Y = 1379 Then
D = D - 1
If D = 0 Then
m = m - 1
If m > 0 And m < 7 Then D = 31
If m > 6 Then D = 30
If m = 0 Then
D = 29
m = 12
Y = Y - 1
End If
End If
End If
'*******************
If m < 10 Or (m = 10 And D < 11) Then
Y = Y + 621
Else
Y = Y + 622
End If
Select Case m
Case 1
If D < 12 Then
m = 3: D = D + 20
Else
m = 4: D = D - 11
End If
Case 2
If D < 11 Then
m = 4: D = D + 20
Else
m = 5: D = D - 10
End If
Case 3
If D < 11 Then
m = 5: D = D + 21
Else
m = 6: D = D - 10
End If
Case 4
If D < 10 Then
m = 6: D = D + 21
Else
m = 7: D = D - 9
End If
Case 5, 6, 8
If D < 10 Then
m = m + 2: D = D + 22
Else
m = m + 3: D = D - 9
End If
Case 7
If D < 9 Then
m = 9: D = D + 22
Else
m = 10: D = D - 8
End If
Case 9
If D < 10 Then
m = 11: D = D + 21
Else
m = 12: D = D - 9
End If
Case 10
If D < 11 Then
m = 12: D = D + 21
Else
m = 1: D = D - 10
End If
Case 11
If D < 12 Then
m = 1: D = D + 20
Else
m = 2: D = D - 11
End If
Case 12
If D < 10 Then
m = 2: D = D + 19
Else
m = 3: D = D - 9
End If
End Select
End Sub
Function ChangeToShamsi(DateParam)
m = CInt(Left(DateParam, InStr(DateParam, "/") - 1))
D = CInt(Mid(DateParam, InStr(DateParam, "/") + 1, InStrRev(DateParam, "/") - InStr(DateParam, "/") - 1))
Y = CInt(Mid(DateParam, InStrRev(DateParam, "/") + 1))
If Y = 0 Then Y = 2000
If Y < 1000 Then Y = Y + 1900
Shamsi Y, m, D
If m < 10 Then m = "0" + Trim(m)
If D < 10 Then D = "0" + Trim(D)
ChangeToShamsi = Trim(Y) & "/" & Trim(m) & "/" & Trim(D)
End Function
Sub Shamsi(Y, m, D)
'******************* Leap year
If Y = 2000 Then
If m > 2 Then
Temp = DateSerial(Y, m, D)
Temp = Temp + 1
Y = Year(Temp)
m = Month(Temp)
D = Day(Temp)
End If
End If
'*******************
If m < 3 Or (m = 3 And D < 21) Then
Y = Y - 622
Else
Y = Y - 621
End If
Select Case m
Case 1
If D < 21 Then
m = 10: D = D + 10
Else
m = 11: D = D - 20
End If
Case 2
If D < 20 Then
m = 11: D = D + 11
Else
m = 12: D = D - 19
End If
Case 3
If D < 21 Then
m = 12: D = D + 9
Else
m = 1: D = D - 20
End If
Case 4
If D < 21 Then
m = 1: D = D + 11
Else
m = 2: D = D - 20
End If
Case 5, 6
If D < 22 Then
m = m - 3: D = D + 10
Else
m = m - 2: D = D - 21
End If
Case 7, 8, 9
If D < 23 Then
m = m - 3: D = D + 9
Else
m = m - 2: D = D - 22
End If
Case 10
If D < 23 Then
m = 7: D = D + 8
Else
m = 8: D = D - 22
End If
Case 11, 12
If D < 22 Then
m = m - 3: D = D + 9
Else
m = m - 2: D = D - 21
End If
End Select
End Sub
این کد هم میلادی رو به شمسی بر می گردونه هم برعکس. فقط باید به فرمت تاریخ توجه بشه. می توانی تو ماژول بنویسی و تو برنامه تابع رو صدا کنی.
ممنون ولی اگه لطف کنی این پست رو ویرایش کنی و کد ها رو توی تگ های مربوطه بذاری ممنون میشیم.