PDA

View Full Version : الگوریتم تاریخ شمسی


vb_nima
دوشنبه 03 اردیبهشت 1386, 10:50 صبح
سلام
از دوستان کسی الگوریتم تبدیل تاریخ میلادی به شمسی را داره؟
برنامه اش را نمی خوام روش انجام را می خوام که توضیح داده باشه چه طوری این عمل را انجام میدن.
romina2006
دوشنبه 03 اردیبهشت 1386, 11:22 صبح
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 "&Ecirc;&Ccedil;&Ntilde;&iacute;&Icirc; &atilde;&Uacute;&Ecirc;&Egrave;&Ntilde; &auml;&atilde;&iacute; &Egrave;&Ccedil;&Ocirc;&Iuml;", vbCritical, ""
Exit Sub
End If
If (Sal + 1) Mod 4 = 0 Then ' &Oacute;&Ccedil;&aacute; &szlig;&Egrave;&iacute;&Oacute;&aring; &Egrave;&Ccedil;&Ocirc;&Iuml;
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 ' &Oacute;&Ccedil;&aacute; &szlig;&Egrave;&iacute;&Oacute;&aring; &auml;&Egrave;&Ccedil;&Ocirc;&Iuml;
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
__H2__
دوشنبه 03 اردیبهشت 1386, 13:50 عصر
سلام
این روش اصلاَ جالب نیست! و ندیده میگویم که فقط بین بازه 33 ساله جاری از شروع کبیسه پنجساله 1375 - 1370 درست کار میکند.

حال کد نویسی ندارم، چیز آماده هم ندارم، ولی سریعترین راه که دقت مناسبی هم داره این است که تاریخ شمسی جاری را به تعداد روزهای گذشته از هجرت تبدیل کنید و آنگاه تفاوت روزهای میلادی و شمسی را لحاظ کرده و مجدداَ تعداد روزها را به تاریخ میلادی تبدیل کنید، و بلعکس. طرف میلادی مشکل ندارم چون VB6 تاریخ را به صورت تعداد روز نگه میدارد و برای طرف شمسی هم فقط کافیست لحاظ کنید که هر چهر سال کبیسه ای داریم و هر 33 سال هم یک کبیسه 5 ساله.

البته این هم کامل کامل نیست ولی در نوع خود دقت بسیار بالایی دارد.
راحت هم است، کمی فکر کنید متوجه میشوید.
تعداد روزها از اول هجرت=تعداد روزهای از تحویل سال + سال * 365 + تعدا دکبیسه های پشت سر گذاشته
CodeMasterX
دوشنبه 03 اردیبهشت 1386, 15:25 عصر
من هم موافقم این روش اصلا دقیق نیست و تاریخ اشتباهی رو برمیگردونه!
توی بخش "حل مشکلات فارسی و ..." نمونه های تاریخ شمسی رو گذاشتن،اونا باز به مراتب بهتره.اونا رو نگاه کنین و یه تست بکنید.
nasim532
چهارشنبه 05 اردیبهشت 1386, 11:48 صبح
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


این کد هم میلادی رو به شمسی بر می گردونه هم برعکس. فقط باید به فرمت تاریخ توجه بشه. می توانی تو ماژول بنویسی و تو برنامه تابع رو صدا کنی.
CodeMasterX
چهارشنبه 05 اردیبهشت 1386, 16:31 عصر
ممنون ولی اگه لطف کنی این پست رو ویرایش کنی و کد ها رو توی تگ های مربوطه بذاری ممنون میشیم.