تبلیغات


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

(بستن)

آموزش ویژوال بیسیک 6 از مقدماتی تا پیشرفته و حرفه ای - تبدیل تاریخ میلادی به تاریخ شمسی
آموزش ویژوال بیسیک 6 از مقدماتی تا پیشرفته و حرفه ای
زکات علم آموختن است.

آرشیو موضوعی

لینکدونی

آرشیو

لینکستان

آمار در میهن بلاگ

  • کل بازدید :
  • بازدید امروز :
  • بازدید دیروز :
  • بازدید این ماه :
  • بازدید ماه قبل :
  • تعداد نویسندگان :
  • تعداد کل پست ها :
  • آخرین بازدید :
  • آخرین بروز رسانی :

سخن مدیر

استفاده از مطالب این وبلاگ فقط با ذکر منبع بلامانع میباشد.

تبادل بنر تبلیغاتی تبادل لوگوی وبلاگ

کلاسهای آموزش برنامه نویسی :

VB6 - VB.NET - C - C# - ASP - ASP.NET - PHP - SQL

به صورت خصوصی در مشهد با قیمت جلسه ای 15 هزار تومان - (حرفه ای شوید)

جهت کسب اطلاعات بیشتر با شماره 09364222771 تماس بگیرید

نظــــر = شخصیّــت Smiley


مرجع كامل مستند

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

خیلی از شما دوستان دنبال این کد هستید ولی پیدا نمیکنید، حق دارید پیدا نکنید چون این کد اون قدر طولانیه که هیچ کسی اونو تو وبلاگش نمیذاره. در ضمن من این کد رو خودم ننوشتم بلکه از اینترنت گرفتم ولی متأسفانه یادم نمیاد اسم سایتش چی بود امیدوارم که منو حلال کنه. خب حالا یک پروژه جدید باز کنید و از منوی Project گزینه ی Add Module رو انتخاب کنید تا یک Module به فرمتون اضافه بشه و بعد کد زیر رو توش کپی کنید :
 

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 = "یك شنبه"
    Case 1
        GetWeekDayName = "دو شنبه"
    Case 2
        GetWeekDayName = "سه شنبه"
    Case 3
        GetWeekDayName = "چهار شنبه"
    Case 4
        GetWeekDayName = "پنج شنبه"
    Case 5
        GetWeekDayName = "جمعه"
    Case 6
        GetWeekDayName = "شنبه"
    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

حالا کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

Private Sub Form_Load()
    Dim intYear As Integer, intMonth As Integer, intDay As Integer
    Dim strDayName As String, strShamsi As String
    GetJalaliDate Year(Date), Month(Date), Day(Date), intYear, intMonth, intDay, strDayName
    strShamsi = intYear & "/" & intMonth & "/" & intDay & " " & strDayName
    Me.Caption = strShamsi
End Sub

حالا برنامه رو اجرا کنید و از اون لذّت ببرید. موفق باشید.


اینم سورس برنامه (فقط ماژول) (حجم ۲ کیوبایت)


نظــــر بــــدهید...

درباره وبلاگ

بهترین آموزشگاه برنامه نویسی به زبان ویژوال بیسیک 6 از مقدماتی تا پیشرفته و حرفه ای همراه با آموزش آنتی ویروس نویسی حرفه ای و سورس های آماده ویروس
مدیر وبلاگ : امیر امیری

آخرین پست ها

جستجو

نویسندگان

آمار در وبگذر

Page Rank