««تاريخ»» کمک کمک....

شروع موضوع توسط Mehdi Hamedali ‏1 آپریل 2004 در انجمن برنامه نویسی

  1. Mehdi Hamedali

    Mehdi Hamedali کاربر تازه وارد

    تاریخ عضویت:
    ‏16 نوامبر 2003
    نوشته ها:
    267
    تشکر شده:
    0
    سلام به همه دوستان
    مي خواهم برنامه تاريخ خود ويندوز رو چك كنه و بعد اونه به شمسي برشگردونه
    نمي خواهم دونبال چيزي بگردم پس تمام كد هاي برنامه نويسي شو اينجا بنويسيد
    زبان مورد نظر VB
    هرچه زود تر بهتر

    قربان شما
    م ح ع
     
  2. خرید بک لینکبازدیدیار - افزایش بازدید سایت و سیگنال های برند
  3. littlerabbit

    littlerabbit مدیر بازنشسته کاربر فعال

    تاریخ عضویت:
    ‏13 جولای 2003
    نوشته ها:
    667
    تشکر شده:
    5
    محل سکونت:
    Iran
    سلام
    كد رو يه سال پيش نوشتم منتها به وي بي 6 هست. خودت بايد به نت مهاجرتش بدي (متاسفانه من حوصله اين كارو ندارم)
    کد:
    'Convert Jalali date to Gregorian date.
    'Base on code for access wrotten by Saeed Aminian (from [url]http://saeedaminian.persianblog.com[/url] )
    
    'If this code work it was wrotten by me.
    'If not, I don't know who wrot it.
    
    'Little rabbit, 1382/4/30 - 2003/7/21
    
    
    
    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

    فرود
     
  4. littlerabbit

    littlerabbit مدیر بازنشسته کاربر فعال

    تاریخ عضویت:
    ‏13 جولای 2003
    نوشته ها:
    667
    تشکر شده:
    5
    محل سکونت:
    Iran
    اي بابا چرا كد اينقدر بي ريخته؟ دست كم بايست راست به چپ ميشد بازم هوار از دست احسان!!!!!!!!
     
  5. Mehdi Hamedali

    Mehdi Hamedali کاربر تازه وارد

    تاریخ عضویت:
    ‏16 نوامبر 2003
    نوشته ها:
    267
    تشکر شده:
    0
    سلام به همه دوستان
    فرود جان دستت درد نكه فكر مي كنم كار رو راه بندازه
    راستي اين كد ها رو براي كد هاي 98 يا 6 مي خواستم
    به هر حال متشكر

    قربان شما
    MHa
     
  6. littlerabbit

    littlerabbit مدیر بازنشسته کاربر فعال

    تاریخ عضویت:
    ‏13 جولای 2003
    نوشته ها:
    667
    تشکر شده:
    5
    محل سکونت:
    Iran
    منظورت از 98 يا 6 چيه؟ من كه نفهميدم!!!
     
  7. Mehdi Hamedali

    Mehdi Hamedali کاربر تازه وارد

    تاریخ عضویت:
    ‏16 نوامبر 2003
    نوشته ها:
    267
    تشکر شده:
    0
    سلام به همه دوستان
    آقا فرود عزيز
    منظور من همون VB قديم بود نه VB.Net
    زیاد جدی نگیر

    قربان شما
    MHa
     
  8. Mehdi Hamedali

    Mehdi Hamedali کاربر تازه وارد

    تاریخ عضویت:
    ‏16 نوامبر 2003
    نوشته ها:
    267
    تشکر شده:
    0
    سلام به همه دوستان
    فرود جان خوشگل پسر آيا خودت اين كد ها رو امتحان كردي
    فكر كنم كار نكنه
    من كه نتونستم اين كار رو كنم
    جواب هاي مزخرفي ميده روز رو 78 نشون ميده يا ماه رو قبل از سال نشون ميده تازه سالش هم 3 سال عقبه
    يك امتحاني بكن
    تازه نگفتم كه اين قدر هم حرفه اي باشه
    من مي خواستم كه وقتي يك فرمي Lode ميشه تاريخ روز رو كه شمسيه تو يك textBox به نام DateN نمايش بده همين
    با اين حال دستت درد نكنه

    قربان شما
    MHa
     
  9. littlerabbit

    littlerabbit مدیر بازنشسته کاربر فعال

    تاریخ عضویت:
    ‏13 جولای 2003
    نوشته ها:
    667
    تشکر شده:
    5
    محل سکونت:
    Iran
    تست كردم جواب داد و درست هم جواب داد!!!كدي رو كه استفاده كردم همين جاست
     

    فایل های ضمیمه:

    • Date.zip
      اندازه فایل:
      3.2 KB
      نمایش ها:
      265
  10. Mehdi Hamedali

    Mehdi Hamedali کاربر تازه وارد

    تاریخ عضویت:
    ‏16 نوامبر 2003
    نوشته ها:
    267
    تشکر شده:
    0
    سلام به همه دوستان
    فرود جان
    با چه VB اين فرم رو نوشتي با 98 يعني همون VB6
    يك سئوال ديگه هم دارم اين كه تو اكسس 2000 يا XP يا Net. چي كار مي كنه
    ببخشيد اين رو مي پرسم چون مي سيستم رو تازه عوض كردم و مجبور شدم تمام سيستم عامل هام رو پاك كنم الان فقط برنامه Access.Net رو تو خونه و نرم افزار هاي Access 2000 & XP رو نصب دارم و تو شركت هم از نظر نصب نرم افزار هاي مختلف دستم رو بستند
    شرمنده
    :happy:
    ;)

    قربان شما
    MHa
     
  11. Mehdi Hamedali

    Mehdi Hamedali کاربر تازه وارد

    تاریخ عضویت:
    ‏16 نوامبر 2003
    نوشته ها:
    267
    تشکر شده:
    0
    سلام به همه دوستان
    فرود جان نگفتم برنامه مشكل داره
    البته مشكل جابجا نوشتن ماه سال از خودم بود ولي در كل به دليل جابجا شدن سال هاي كبيسه به مدت يك سال اين برنامه هم تاريخ را يك روز جلو تر و يا بهتر بگم تاريخ را تاريخ روز بعد نشان مي دهد
    يك نگاهي بنداز بعد نيست
    :D
    :happy:
    :cool:

    قربان شما
    MHA
     
  12. littlerabbit

    littlerabbit مدیر بازنشسته کاربر فعال

    تاریخ عضویت:
    ‏13 جولای 2003
    نوشته ها:
    667
    تشکر شده:
    5
    محل سکونت:
    Iran
    مرسي ديدم سعي ميكنم رفعش كنم اگه شد (وقت شد)
     
  13. Mehdi Hamedali

    Mehdi Hamedali کاربر تازه وارد

    تاریخ عضویت:
    ‏16 نوامبر 2003
    نوشته ها:
    267
    تشکر شده:
    0
    سلام به همه دوستان
    دوست عزيز آقا فرود من اين مشكل رو حل كردم اگه به خاطر من اين كار رو مي كني ممنون ولي اگه به خاطر بچه هاست حرفي ندارم
    اصلاح شده برنامه رو هم برات مي فرستم

    در هر حال از لطفت سپاسگزارم

    قربان شما
    :king:
    MHa
     
عسل طبیعی و گرده گل ایرانیخدمات پی پال، وسترن یونیون