نمایش نتایج 1 تا 6 از 6

نام تاپیک: الگوریتم تاریخ شمسی

  1. #1

    Question الگوریتم تاریخ شمسی

    سلام
    از دوستان کسی الگوریتم تبدیل تاریخ میلادی به شمسی را داره؟
    برنامه اش را نمی خوام روش انجام را می خوام که توضیح داده باشه چه طوری این عمل را انجام میدن.

  2. #2
    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

  3. #3
    کاربر دائمی آواتار __H2__
    تاریخ عضویت
    اسفند 1385
    محل زندگی
    یک جایی بین Framework و نارمک!
    پست
    1,059
    سلام
    این روش اصلاَ جالب نیست! و ندیده میگویم که فقط بین بازه 33 ساله جاری از شروع کبیسه پنجساله 1375 - 1370 درست کار میکند.

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

    البته این هم کامل کامل نیست ولی در نوع خود دقت بسیار بالایی دارد.
    راحت هم است، کمی فکر کنید متوجه میشوید.
    تعداد روزها از اول هجرت=تعداد روزهای از تحویل سال + سال * 365 + تعدا دکبیسه های پشت سر گذاشته

  4. #4
    کاربر دائمی آواتار CodeMasterX
    تاریخ عضویت
    بهمن 1385
    محل زندگی
    Iran, Shiraz
    سن
    35
    پست
    960
    من هم موافقم این روش اصلا دقیق نیست و تاریخ اشتباهی رو برمیگردونه!
    توی بخش "حل مشکلات فارسی و ..." نمونه های تاریخ شمسی رو گذاشتن،اونا باز به مراتب بهتره.اونا رو نگاه کنین و یه تست بکنید.

  5. #5
    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


    این کد هم میلادی رو به شمسی بر می گردونه هم برعکس. فقط باید به فرمت تاریخ توجه بشه. می توانی تو ماژول بنویسی و تو برنامه تابع رو صدا کنی.

  6. #6
    کاربر دائمی آواتار CodeMasterX
    تاریخ عضویت
    بهمن 1385
    محل زندگی
    Iran, Shiraz
    سن
    35
    پست
    960
    ممنون ولی اگه لطف کنی این پست رو ویرایش کنی و کد ها رو توی تگ های مربوطه بذاری ممنون میشیم.

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •