Trang 4 / 4 FirstFirst 1234
Hiển thị kết quả từ 31 đến 40 / 40
  1. #31
    Tham gia
    15-12-2004
    Location
    HN
    Bài viết
    37
    Like
    0
    Thanked 0 Times in 0 Posts
    cảm ơm tumickey mhưng tiếc quá mình không biết tí gì về JavaScript bạn nào có code vb không

  2. #32
    Tham gia
    17-07-2002
    Location
    Cần Thơ
    Bài viết
    602
    Like
    0
    Thanked 0 Times in 0 Posts
    bạn có thể coi thuật toán mà làm trong đó có hết đó
    http://www.informatik.uni-leipzig.de.../calrules.html
    NGoài viết bằng js còn viết bằng java và php nữa .

  3. #33
    Tham gia
    03-12-2003
    Bài viết
    339
    Like
    0
    Thanked 0 Times in 0 Posts
    Quá hay ~ quá khó!

  4. #34
    Tham gia
    26-05-2004
    Bài viết
    199
    Like
    0
    Thanked 0 Times in 0 Posts
    Tôi có 01 đoạn về ngày tháng năm âm, dương lịch = VB.NET
    Chọn tháng ==> Thứ ; Ngày dương lịch, Ngày âm lịch (Nhâm Thìn chẳng hạn)
    Tháng âm lịch (Kỷ Sửu chẳng hạn), Tiết khí.

    Bác nào tham khảo mail cho tôi nhé.

  5. #35
    Tham gia
    21-12-2004
    Bài viết
    134
    Like
    0
    Thanked 0 Times in 0 Posts
    Bạn tham khảo tại đây: http://www.forum.caulacbovb.com/viewtopic.php?t=1681

    Chúc vui!

  6. #36
    Tham gia
    15-08-2007
    Bài viết
    1
    Like
    0
    Thanked 0 Times in 0 Posts
    Tumickey ơi cho mình hỏi
    -mấy cái thông số của hàm chuyển đổi từ dd/mm/yy sang Julius và ngược lại làm sao có được vậy

  7. #37
    Tham gia
    20-05-2009
    Bài viết
    1
    Like
    0
    Thanked 0 Times in 0 Posts
    mình có một giải thuật đổi dương lịch ra âm lịch và ngược lại nhưng lâu qua để đâu không kiếm thấy bữa nào kiếm thấy minh post lên ha

  8. #38
    Tham gia
    09-12-2009
    Bài viết
    1
    Like
    0
    Thanked 0 Times in 0 Posts
    Thật không dể ti nào !
    Hic

  9. #39
    Tham gia
    13-03-2013
    Bài viết
    2
    Like
    1
    Thanked 0 Times in 0 Posts

    Code java

    Quote Được gửi bởi baotrung View Post
    Thanks for your link, Lazy_programmer

    Mình đã load về cái source code bằng JAVA, xem wa thấy giải thuật wá phức tộp, họ không dùng cách tra bảng đâu, mình post len đây để mọi người cùng ngâm kứu và chuyển ngữ sang VB.

    Mong mọi người cộng tác. Tks
    cho em các source code bằng java với

  10. #40
    Tham gia
    13-08-2012
    Location
    Vĩnh Cửu, Đồng Nai
    Bài viết
    95
    Like
    9
    Thanked 9 Times in 8 Posts
    Chương trình đổi âm - dương lịch bằng VBA
    (Nguồn: ?)

    Code:
    'CHUYEN DOI NGAY AM DUONG LICH
    '-----------------------------
    'Su dung 2 ham:
    
    '1. Ham Solar2Lunar(Day;Month;Year;TimeZone)
    '- La ham chuyen doi Duong lich sang Am lich, trong do:
    '- Day;Month;Year  la ngay thang nam Duong lich
    '- TimeZone: gio khu vuc; O Viet Nam thi TimeZone=7
    
    '2. Ham Lunar2Solar(LunarDay;LunarMonth;LunarYear;LunarLeap;TimeZone)
    '- La ham chuyen doi am lich sang duong lich, trong do:
    '- LunarDay;LunarMonth;LunarYear la ngay thang nam Am lich
    '- LunarLeap=0: neu LunarMonth la thang Thuong; Va =1: neu la thang Nhuan
    '- TimeZone: gio khu vuc; O Viet Nam thi TimeZone=7
    
    '3. Vi du trong Excel, trong cell:
    '=Solar2Lunar(21;11;2014;7)          --Ngay 21/11/2014 Duong lich
        'Ket qua la: 29/09/2014 AL (9 N) -->Am lich
    '=Lunar2Solar(29;9;2014;1;7)         --Ngay 29/9/2014 Am lich, thang nhuan
        'Ket qua la: 21/11/2014          -->Duong lich
    
    
    Option Explicit
    Const PI As Double = 3.14159265358979 ' Atn(1) * 4
    
    
    Private Function jdFromDate(ByVal dd As Long, ByVal mm As Long, ByVal yy As Long) As Long
        Dim a As Double, y As Long, m As Long, jd As Long
        a = Fix((14 - mm) / 12)
        y = yy + 4800 - a
        m = mm + 12 * a - 3
        jd = dd + Fix((153 * m + 2) / 5) + 365 * y _
            + Fix(y / 4) - Fix(y / 100) + Fix(y / 400) - 32045
        If jd < 2299161 Then
            jd = dd + Fix((153 * m + 2) / 5) + 365 * y + Fix(y / 4) - 32083
        End If
        jdFromDate = jd
    End Function
    ' Convert a Julian day number to day/month/year. Parameter jd is an integer
    Private Function jdToDate(ByVal jd As Long)
        Dim a As Long, b As Long, C As Long, d As Long, E As Long, m As Long
        Dim Day As Long, Month As Long, Year As Long
        If (jd > 2299160) Then ' After 5/10/1582, Gregorian calendar
            a = jd + 32044
            b = Fix((4 * a + 3) / 146097)
            C = a - Fix((b * 146097) / 4)
        Else
            b = 0
            C = jd + 32082
        End If
        d = Fix((4 * C + 3) / 1461)
        E = C - Fix((1461 * d) / 4)
        m = Fix((5 * E + 2) / 153)
        Day = E - Fix((153 * m + 2) / 5) + 1
        Month = m + 3 - 12 * Fix(m / 10)
        Year = b * 100 + d - 4800 + Fix(m / 10)
        jdToDate = Array(Day, Month, Year)
    End Function
    
    ' Compute the time of the k-th new moon after the new moon of 1/1/1900 13:52 UCT
    ' (measured as the number of days since 1/1/4713 BC noon UCT,
    ' e.g., 2451545.125 is 1/1/2000 15:00 UTC).
    ' Returns a floating number, e.g.,
    ' 2415079.9758617813 for k=2 or 2414961.935157746 for k=-2
    
    Private Function NewMoon(ByVal k As Long) As Double
        Dim T As Double, T2 As Double, T3 As Double, dr As Double
        Dim Jd1 As Double, m As Double, Mpr As Double
        Dim f As Double, C1 As Double, deltat As Double, JdNew As Double
        T = k / 1236.85 ' Time in Julian centuries from 1900 January 0.5
        T2 = T * T
        T3 = T2 * T
        dr = PI / 180
        Jd1 = 2415020.75933 + 29.53058868 * k + 0.0001178 * T2 - 0.000000155 * T3
        Jd1 = Jd1 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009173 * T2) * dr)
            ' Mean new moon
        m = 359.2242 + 29.10535608 * k - 0.0000333 * T2 - 0.00000347 * T3
            ' Sun's mean anomaly
        Mpr = 306.0253 + 385.81691806 * k + 0.0107306 * T2 + 0.00001236 * T3
            ' Moon's mean anomaly
        f = 21.2964 + 390.67050646 * k - 0.0016528 * T2 - 0.00000239 * T3
            ' Moon's argument of latitude
        C1 = (0.1734 - 0.000393 * T) * Sin(m * dr) + 0.0021 * Sin(2 * dr * m)
        C1 = C1 - 0.4068 * Sin(Mpr * dr) + 0.0161 * Sin(dr * 2 * Mpr)
        C1 = C1 - 0.0004 * Sin(dr * 3 * Mpr)
        C1 = C1 + 0.0104 * Sin(dr * 2 * f) - 0.0051 * Sin(dr * (m + Mpr))
        C1 = C1 - 0.0074 * Sin(dr * (m - Mpr)) + 0.0004 * Sin(dr * (2 * f + m))
        C1 = C1 - 0.0004 * Sin(dr * (2 * f - m)) - 0.0006 * Sin(dr * (2 * f + Mpr))
        C1 = C1 + 0.001 * Sin(dr * (2 * f - Mpr)) + 0.0005 * Sin(dr * (2 * Mpr + m))
        If (T < -11) Then
            deltat = 0.001 + 0.000839 * T + 0.0002261 * T2 _
                    - 0.00000845 * T3 - 0.000000081 * T * T3
        Else
            deltat = -0.000278 + 0.000265 * T + 0.000262 * T2
        End If
        JdNew = Jd1 + C1 - deltat
        NewMoon = JdNew
    End Function
    
    ' Compute the longitude of the sun at any time.
    ' Parameter: floating number jdn, the number of days since 1/1/4713 BC noon
    
    Private Function SunLongitude(ByVal jdn As Double) As Double
        Dim T As Double, T2 As Double, dr As Double, m As Double
        Dim L0 As Double, DL As Double, l As Double
        T = (jdn - 2451545) / 36525
            ' Time in Julian centuries from 2000-01-01 12:00:00 GMT
        T2 = T * T
        dr = PI / 180 ' degree to radian
        m = 357.5291 + 35999.0503 * T - 0.0001559 * T2 - 0.00000048 * T * T2
            ' mean anomaly, degree
        L0 = 280.46645 + 36000.76983 * T + 0.0003032 * T2
            ' mean longitude, degree
        DL = (1.9146 - 0.004817 * T - 0.000014 * T2) * Sin(dr * m)
        DL = DL + (0.019993 - 0.000101 * T) * Sin(dr * 2 * m) _
            + 0.00029 * Sin(dr * 3 * m)
        l = L0 + DL ' true longitude, degree
        l = l * dr
        l = l - PI * 2 * (Fix(l / (PI * 2))) ' Normalize to (0, 2*PI)
        SunLongitude = l
    End Function
    
    ' Compute sun position at midnight of the day with the given Julian day number.
    ' The time zone if the time difference between local time and UTC: 7.0 for UTC+7:00.
    ' The function returns a number between 0 and 11.
    ' From the day after March equinox and the 1st major term after March equinox,
    ' 0 is returned. After that, return 1, 2, 3 ...
    Private Function getSunLongitude(ByVal dayNumber As Double, ByVal timeZone As Byte) As Long
        getSunLongitude = Fix(SunLongitude(dayNumber - 0.5 - timeZone / 24) / PI * 6)
    End Function
    
    ' Compute the day of the k-th new moon in the given time zone.
    ' The time zone if the time difference between local time and UTC: 7.0 for UTC+7:00
    Private Function getNewMoonDay(ByVal k As Long, ByVal timeZone As Long) As Long
        getNewMoonDay = Fix(NewMoon(k) + 0.5 + timeZone / 24)
    End Function
    
    ' Find the day that starts the luner month 11 of the given year
    ' for the given time zone
    Private Function getLunarMonth11(ByVal yy As Long, ByVal timeZone As Long) As Long
        Dim k As Long, off As Double, nm As Long, sunLong As Double
        '' off = jdFromDate(31, 12, yy) - 2415021.076998695
        off = jdFromDate(31, 12, yy) - 2415021
        k = Fix(off / 29.530588853)
        nm = getNewMoonDay(k, timeZone)
        sunLong = getSunLongitude(nm, timeZone) ' sun longitude at local midnight
        If (sunLong >= 9) Then
            nm = getNewMoonDay(k - 1, timeZone)
        End If
        getLunarMonth11 = nm
    End Function
    
    ' Find the index of the leap month after the month starting on the day a11.
    Private Function getLeapMonthOffset(ByVal a11 As Double, ByVal timeZone As Long) As Long
        Dim k As Long, last As Long, Arc As Long, i As Long
        k = Fix((a11 - 2415021.07699869) / 29.530588853 + 0.5)
        last = 0
        i = 1 ' We start with the month following lunar month 11
        Arc = getSunLongitude(getNewMoonDay(k + i, timeZone), timeZone)
        Do
            last = Arc
            i = i + 1
            Arc = getSunLongitude(getNewMoonDay(k + i, timeZone), timeZone)
        Loop While (Arc <> last And i < 14)
        getLeapMonthOffset = i - 1
    End Function
    
    ' Comvert solar date dd/mm/yyyy to the corresponding lunar date
    Public Function Solar2Lunar( _
            ByVal dd As Long, _
            ByVal mm As Long, _
            Optional ByVal yy As Long = 0, _
            Optional ByVal timeZone As Long = 7) As String
        Dim k As Long, diff As Long, leapMonthDiff As Long, dayNumber As Long
        Dim monthStart As Double, a11 As Long, b11 As Long
        Dim lunarDay As Double, lunarMonth As Long, lunarYear As Long, lunarLeap As Long
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        If yy = 0 Then yy = Year(Date)
        dayNumber = jdFromDate(dd, mm, yy)
        k = Fix((dayNumber - 2415021.07699869) / 29.530588853)
        monthStart = getNewMoonDay(k + 1, timeZone)
        If (monthStart > dayNumber) Then
            monthStart = getNewMoonDay(k, timeZone)
        End If
        ' alert(dayNumber + " -> " + monthStart)
        a11 = getLunarMonth11(yy, timeZone)
        b11 = a11
        If (a11 >= monthStart) Then
            lunarYear = yy
            a11 = getLunarMonth11(yy - 1, timeZone)
        Else
            lunarYear = yy + 1
            b11 = getLunarMonth11(yy + 1, timeZone)
        End If
        lunarDay = dayNumber - monthStart + 1
        diff = Fix((monthStart - a11) / 29)
        lunarLeap = 0
        lunarMonth = diff + 11
        If (b11 - a11 > 365) Then
            leapMonthDiff = getLeapMonthOffset(a11, timeZone)
            If (diff >= leapMonthDiff) Then
                lunarMonth = diff + 10
                If (diff = leapMonthDiff) Then lunarLeap = 1
            End If
        End If
        If (lunarMonth > 12) Then lunarMonth = lunarMonth - 12
        If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
        Solar2Lunar = Format(lunarDay, "00") & _
                    "/" & Format(lunarMonth, "00") & _
                    "/" & Format(lunarYear, "0000 \A\L") & IIf(lunarLeap, " (" & lunarMonth & " N)", "")
    End Function
    
    ' Convert a lunar date to the corresponding solar date
    Public Function Lunar2Solar( _
            ByVal lunarDay As Long, _
            ByVal lunarMonth As Long, _
            Optional ByVal lunarYear As Long = 0, _
            Optional ByVal lunarLeap As Long = 0, _
            Optional ByVal timeZone As Long = 7) As Date
        Dim k As Long, a11 As Long, b11 As Long, off As Long, leapOff As Long
        Dim LeapMonth As Long, monthStart As Long
        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        If lunarYear = 0 Then lunarYear = Year(Date)
        If (lunarMonth < 11) Then
            a11 = getLunarMonth11(lunarYear - 1, timeZone)
            b11 = getLunarMonth11(lunarYear, timeZone)
        Else
            a11 = getLunarMonth11(lunarYear, timeZone)
            b11 = getLunarMonth11(lunarYear + 1, timeZone)
        End If
        k = Fix(0.5 + (a11 - 2415021.07699869) / 29.530588853)
        off = lunarMonth - 11
        If (off < 0) Then off = off + 12
        If (b11 - a11 > 365) Then
            leapOff = getLeapMonthOffset(a11, timeZone)
            LeapMonth = leapOff - 2
            If (LeapMonth < 0) Then LeapMonth = LeapMonth + 12
            If (lunarLeap <> 0 And lunarMonth <> LeapMonth) Then
                Lunar2Solar = Array(0, 0, 0)
                Exit Function
            ElseIf (lunarLeap <> 0 Or off >= leapOff) Then
                off = off + 1
            End If
        End If
        monthStart = getNewMoonDay(k + off, timeZone)
        Dim R
        R = jdToDate(monthStart + lunarDay - 1)
        Lunar2Solar = DateSerial(R(2), R(1), R(0))
    End Function
    Life - Love - Freedom

Trang 4 / 4 FirstFirst 1234

Bookmarks

Quy định

  • Bạn không thể tạo chủ đề mới
  • Bạn không thể trả lời bài viết
  • Bạn không thể gửi file đính kèm
  • Bạn không thể sửa bài viết của mình
  •