تبدیل تاریخ شمسی به میلادی و بالعکس

با سلام به دوستان .
من میخوام یه پروژه بنویسم که اگه کسی تاریخ شمسی رو به برنامه داد به میلادی تبدیل کنه یا برعکس .


برای روز که همونه . چون همه ی ماههای اونا هم 30 روزه هستش . برای سال هم اگه میلادی داد 621 رو ازش کم میکنه . ولی برای ماه ! هرکاری کردم هیچی به دهنم نرسید :blink: . اگه میشه سورس آماده رو بزارید ممنون میشم :blush: . چون وفت فکر کردن ندارم ;) !

سلام
دل انگیز بابا.!!!!اگه یک جستجوی کوچیک کنی کلی مطلب پیدا میکنی.
دوستان کدهای زیادی گذاشتند (گرچه ناقص است و فقط در بازه دوره های 33 ساله جاری درست کار میکنند) اگر هم داری با Vb8 کار میکینی که خودش ماژولی برای تبدیلات شمسی دارد.

shamsi.dll میتونه کمکت کنه
یه نگاهی به اینجا بنداز : [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

اینم واسه تبدیل میلادی به شمسی :

کد:

---

Option Explicit

Private Const mcDayOff = 226894

Private mvarGDayTab
Private mvarJDayTab
Private mcSolar As Double

Public Sub GetJalaliDate(ByVal vGYear As Integer, ByVal vGMonth As Integer, ByVal vGDay As Integer, pJYear As Integer, pJMonth As Integer, pJDay As Integer, pDayName As String)

       
    Dim mGTotalDay As Long
 
    SetConstants
   
    mGTotalDay = GetDayFromFirstGregorianDay(vGYear, vGMonth, vGDay)
    pDayName = GetWeekDayName(mGTotalDay)
    GetJalaliYearMonthDay mGTotalDay, vGYear, vGMonth, vGDay
    pJDay = vGDay
    pJMonth = vGMonth
    pJYear = vGYear
End Sub

Private Sub SetConstants()
   
    mvarGDayTab = Array(Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), Array(0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31))
    mvarJDayTab = Array(Array(0, 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29), Array(0, 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 30))
    mcSolar = 365.25 - 0.25 / 33
   
End Sub

Private Function GetDayFromFirstGregorianDay(ByVal vGYaer As Integer, ByVal vGMonth As Integer, ByVal vGDay As Integer) As Long
   
    Dim mGYearDiv4 As Integer, mGYearDiv100 As Integer, mGYearDiv400 As Integer
    Dim mGTotalDays As Long
   
    mGYearDiv4 = vGYaer \ 4
    mGYearDiv100 = vGYaer \ 100
    mGYearDiv400 = vGYaer \ 400
   
    mGTotalDays = GetGDayFromBeginOfYear(vGYaer, vGMonth, vGDay)
    mGTotalDays = CLng(vGYaer - 1) * 365 + mGTotalDays + mGYearDiv4 - mGYearDiv100 + mGYearDiv400
   
    GetDayFromFirstGregorianDay = mGTotalDays
End Function

Private Function GetGDayFromBeginOfYear(ByVal vGYear As Integer, ByVal vGMonth As Integer, ByVal vGDay As Integer) As Long
    Dim mGLeap As Integer
    Dim mCount As Integer
   
    GetGDayFromBeginOfYear = vGDay
    mGLeap = IsLeapGregorian(vGYear)
    For mCount = 1 To vGMonth - 1
        GetGDayFromBeginOfYear = GetGDayFromBeginOfYear + mvarGDayTab(mGLeap)(mCount)
    Next mCount
   
End Function

Private Function IsLeapGregorian(ByVal vGYear As Integer) As Integer

    If (vGYear Mod 4 = 0 And vGYear Mod 100 <> 0) Or (vGYear Mod 400 = 0) Then
        IsLeapGregorian = 1
    Else
        IsLeapGregorian = 0
    End If
End Function

Private Function GetJalaliYearMonthDay(vGTotalDay As Long, pJYear As Integer, pJMonth As Integer, pJDay As Integer)
   
    Dim mJTotalDay As Long
    Dim mJYear As Integer
    Dim mJDay As Integer
    Dim mJLeaps As Integer
   
    mJTotalDay = vGTotalDay - mcDayOff
    mJYear = mJTotalDay \ mcSolar
   
    mJLeaps = GetAllJalaliLeapFromBegin(mJYear)
   
    mJDay = mJTotalDay - (365 * CLng(mJYear) + mJLeaps)
    mJYear = mJYear + 1

    Do While mJDay <= 0
        mJYear = mJYear - 1
        If IsLeapJalali(mJYear) = 1 Then
            mJDay = mJDay + 366
        Else
            mJDay = mJDay + 365
        End If
    Loop
       
    If (mJDay = 366 And IsLeapJalali(mJYear) = 0) Then
        mJDay = 1
        mJYear = mJYear + 1
    End If
    pJYear = mJYear
    GetJalaliMonthDay mJYear, mJDay, pJMonth, pJDay
   
End Function

Private Function IsLeapJalali(ByVal vJYear As Integer) As Integer
   
    Dim mTemp As Integer
   
    mTemp = vJYear Mod 33
    If mTemp = 1 Or mTemp = 5 Or mTemp = 9 Or mTemp = 13 Or mTemp = 17 Or mTemp = 22 Or mTemp = 26 Or mTemp = 30 Then
        IsLeapJalali = 1
    Else
        IsLeapJalali = 0
    End If
End Function

Private Function GetAllJalaliLeapFromBegin(ByVal vJYear As Integer) As Integer

    Dim mJLeap As Integer
    Dim mCurrentCycle As Integer
    Dim mJDiv33 As Integer
    Dim mCount As Integer
    Dim mTemp As Integer
   
    mJDiv33 = vJYear \ 33
    mCurrentCycle = vJYear - (mJDiv33 * 33)
    mJLeap = mJDiv33 * 8
    If mCurrentCycle > 0 Then
        mTemp = IIf(mCurrentCycle <= 18, mCurrentCycle, 18)
        For mCount = 1 To mTemp Step 4
            mJLeap = mJLeap + 1
        Next
    End If
   
    If mCurrentCycle > 21 Then
        mTemp = IIf(mCurrentCycle <= 30, mCurrentCycle, 30)
        For mCount = 22 To mTemp Step 4
            mJLeap = mJLeap + 1
        Next
    End If
    GetAllJalaliLeapFromBegin = mJLeap

End Function


Private Sub GetJalaliMonthDay(ByVal vJYear As Integer, ByVal vJDayOfYear As Integer, pJMonth As Integer, pJDay As Integer)
    Dim mCount As Integer
    Dim mJLeap As Integer

    mJLeap = IsLeapJalali(vJYear)
    mCount = 1
    Do While vJDayOfYear > mvarJDayTab(mJLeap)(mCount)
        vJDayOfYear = vJDayOfYear - mvarJDayTab(mJLeap)(mCount)
        mCount = mCount + 1
    Loop
    pJMonth = mCount
    pJDay = vJDayOfYear
End Sub



Private Function GetWeekDayName(DayFromBegin As Long) As String
    Dim temp As Integer
   
    temp = DayFromBegin Mod 7
    Select Case temp
   
    Case 0
        GetWeekDayName = "1 Shanbe"
    Case 1
        GetWeekDayName = "2 Shanbe"
    Case 2
        GetWeekDayName = "3 Shanbe"
    Case 3
        GetWeekDayName = "4 Shanbe"
    Case 4
        GetWeekDayName = "5 Shanbe"
    Case 5
        GetWeekDayName = "Jomee"
    Case 6
        GetWeekDayName = "Shanbe"
    End Select
   
End Function

Public Sub GetGregorianDate(ByVal vJYear As Integer, ByVal vJMonth As Integer, ByVal vJDay As Integer, ByRef pGYear As Integer, ByRef pGMonth As Integer, ByRef pGDay As Integer, pDayName As String)
   
    Dim mJTotalDays As Long
    Dim mGYear As Integer
    Dim mGMonth As Integer
    Dim mGDay As Integer
   
    SetConstants
   
    mJTotalDays = GetDayFromFirstJalaliDay(vJYear, vJMonth, vJDay)
    GetWeekDayName (mJTotalDays + mcDayOff)
    GetGregorianYearMonthDay mJTotalDays, mGYear, mGMonth, mGDay
    pGYear = mGYear
    pGMonth = mGMonth
    pGDay = mGDay
End Sub

Private Function GetDayFromFirstJalaliDay(ByVal vJYear As Integer, ByVal vJMonth As Integer, ByVal vJDay As Integer) As Long

    Dim mJLeap As Integer
    Dim mTemp As Integer

    mJLeap = GetAllJalaliLeapFromBegin(vJYear - 1)
    mTemp = GetJDayFromBeginOfYear(vJYear, vJMonth, vJDay)
    GetDayFromFirstJalaliDay = CLng((vJYear - 1)) * 365 + mJLeap + mTemp

End Function

Private Function GetJDayFromBeginOfYear(ByVal vJYear As Integer, ByVal vJMonth As Integer, ByVal vJDay As Integer) As Integer

    Dim mCount As Integer
    Dim mJLeap As Integer
   
    GetJDayFromBeginOfYear = vJDay
    mJLeap = IsLeapJalali(vJYear)
    For mCount = 1 To vJMonth - 1
        GetJDayFromBeginOfYear = GetJDayFromBeginOfYear + mvarJDayTab(mJLeap)(mCount)
    Next mCount

End Function

Private Sub GetGregorianYearMonthDay(vJTotalDays As Long, pGYear As Integer, pGMonth As Integer, pGDay As Integer)
   
    Dim mGTotalDays As Long

    Dim mGDiv4 As Integer
    Dim mGDiv100 As Integer
    Dim mGDiv400 As Integer
    Dim mGDays As Integer
   
    mGTotalDays = vJTotalDays + mcDayOff
    pGYear = mGTotalDays \ mcSolar
    mGDiv4 = pGYear \ 4
    mGDiv100 = pGYear \ 100
    mGDiv400 = pGYear \ 400
   
    ' Find Gregorian day of year
    mGDays = mGTotalDays - (365 * CLng(pGYear)) - (mGDiv4 - mGDiv100 + mGDiv400)
    pGYear = pGYear + 1
   
    Do While mGDays <= 0
        pGYear = pGYear - 1
        If IsLeapGregorian(pGYear) = 1 Then
            mGDays = mGDays + 366
        Else
            mGDays = mGDays + 365
        End If
    Loop
   
    If (mGDays = 366 And IsLeapGregorian(pGYear) = 0) Then
        mGDays = 1
        pGYear = pGYear + 1
    End If
    GetGregorianMonthDay pGYear, mGDays, pGMonth, pGDay
End Sub

Private Sub GetGregorianMonthDay(ByVal vGYear As Integer, ByVal vGDayOfYear As Integer, pGMonth As Integer, pGDay As Integer)
    Dim mCount As Integer
    Dim mGLeap
   
    mGLeap = IsLeapGregorian(vGYear)
    mCount = 1
   
    Do While vGDayOfYear > mvarGDayTab(mGLeap)(mCount)
        vGDayOfYear = vGDayOfYear - mvarGDayTab(mGLeap)(mCount)
        mCount = mCount + 1
    Loop
    pGMonth = mCount
    pGDay = vGDayOfYear
End Sub

---

[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

مرسی از همگی

نقل قول:

---

اینم واسه تبدیل میلادی به شمسی :

---

میشه بگی در فرم چه چیزهایی قرار بدم ؟
چون یکم نا مفهومه

نقل قول:

---

اگر هم داری با Vb8 کار میکینی که خودش ماژولی برای تبدیلات شمسی دارد.

---

سلام
فکر کنم منظورت همون VB.NET است

نقل قول:

---

میشه بگی در فرم چه چیزهایی قرار بدم ؟
چون یکم نا مفهومه

---

این توابعی که تعریف کرده رو باید مثل یه متغیر راهش رفتار کنی . اگه حالا دوست عزیزی که گفته این تابع رو توی یه کلاس تعریف کرده یا نه خوب میشه !!
مواردی که ذکر میکنید نحوه استفاده هم را ذکر کنید

کد:

---

Dim pYear As Integer, pMonth  As Integer, pDay As Integer, str As String
    GetJalaliDate year(Date), month(Date), day(Date), pYear, pMonth, pDay, str
    T_DATE1.text = pYear & "/"
    If pMonth < 10 Then T_DATE1.text = T_DATE1.text + "0" & pMonth Else T_DATE1.text = T_DATE1.text & pMonth
    T_DATE1.text = T_DATE1.text + "/"
    If pDay < 10 Then T_DATE1.text = T_DATE1.text + "0" & pDay Else T_DATE1.text = T_DATE1.text & pDay
    T_DATE2.text = pYear & "/"
    If pMonth < 10 Then T_DATE2.text = T_DATE2.text + "0" & pMonth Else T_DATE2.text = T_DATE2.text & pMonth
    T_DATE2.text = T_DATE2.text + "/"
    If pDay < 10 Then T_DATE2.text = T_DATE2.text + "0" & pDay Else T_DATE2.text = T_DATE2.text & pDay

---

delphianddotnet درست میگه .
اگه میتونی برو سمت vb8 خیلی راحت تری

نقل قول:

---

delphianddotnet درست میگه .
اگه میتونی برو سمت vb8 خیلی راحت تری

---

دوست عزيز هركي به يه چيزي علاقه داره .
يكي از دوستاي منم معتاد كارهاي گرافيكي با دلفي . يعني بايد ببينيد چه چيزهايي درست ميكنه .
حالا نگفتيد بايد چه Object هايي در فرم قرار بدم ؟