Module chuyển Dương Lich sang Âm lịch

Bộ sưu tập mã nguồn các ứng dụng tiện ích
Đăng trả lời
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 530 times

Module chuyển Dương Lich sang Âm lịch

Gửi bài by truongphu »

Tên chương trình: Module chuyển Dương Lich sang Âm lịch
Ngôn ngữ lập trình: VB6
Tác giả: Nguyễn Quốc Sản. truongphu bổ sung nhỏ
Chức năng: Module chuyển Dương Lich sang Âm lịch
Module chuyển Dương Lich sang Âm lịch nầy do tác giả Nguyễn Quốc Sản viết trực tiếp bằng VB6.
Đăng trên website của tác giả Hồ Ngọc Đức.
(Khác với các module trước dịch từ java sang vb6)

Tôi (truongphu) có bổ sung thêm function NamÂmLich
và ở Function Solar2Lunar của tác giả Nguyễn Quốc Sản, tôi (tp) tạm ngừng kết quả trả về,
để bổ sung vào đó năm Âm lịch theo tên gọi, chứ không mang số của DL

Module:
  1.  
  2. Option Explicit ' Nguyê~n Quô'c Sa?n
  3. Const PI As Double = 3.14159265358979 ' Atn(1) * 4
  4.  
  5. Function jdFromDate(ByVal dd As Long, ByVal mm As Long, ByVal yy As Long) As Long
  6.     Dim a As Double, y As Long, m As Long, jd As Long
  7.     a = Fix((14 - mm) / 12)
  8.     y = yy + 4800 - a
  9.     m = mm + 12 * a - 3
  10.     jd = dd + Fix((153 * m + 2) / 5) + 365 * y _
  11.         + Fix(y / 4) - Fix(y / 100) + Fix(y / 400) - 32045
  12.     If jd < 2299161 Then
  13.         jd = dd + Fix((153 * m + 2) / 5) + 365 * y + Fix(y / 4) - 32083
  14.     End If
  15.     jdFromDate = jd
  16. End Function
  17.  
  18. Function NewMoon(ByVal k As Long) As Double
  19.     Dim T As Double, T2 As Double, T3 As Double, dr As Double
  20.     Dim Jd1 As Double, m As Double, Mpr As Double
  21.     Dim F As Double, C1 As Double, deltat As Double, JdNew As Double
  22.     T = k / 1236.85 ' Time in Julian centuries from 1900 January 0.5
  23.    T2 = T * T
  24.     T3 = T2 * T
  25.     dr = PI / 180
  26.     Jd1 = 2415020.75933 + 29.53058868 * k + 0.0001178 * T2 - 0.000000155 * T3
  27.     Jd1 = Jd1 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009173 * T2) * dr)
  28.     m = 359.2242 + 29.10535608 * k - 0.0000333 * T2 - 0.00000347 * T3
  29.     Mpr = 306.0253 + 385.81691806 * k + 0.0107306 * T2 + 0.00001236 * T3
  30.     F = 21.2964 + 390.67050646 * k - 0.0016528 * T2 - 0.00000239 * T3
  31.     C1 = (0.1734 - 0.000393 * T) * Sin(m * dr) + 0.0021 * Sin(2 * dr * m)
  32.     C1 = C1 - 0.4068 * Sin(Mpr * dr) + 0.0161 * Sin(dr * 2 * Mpr)
  33.     C1 = C1 - 0.0004 * Sin(dr * 3 * Mpr)
  34.     C1 = C1 + 0.0104 * Sin(dr * 2 * F) - 0.0051 * Sin(dr * (m + Mpr))
  35.     C1 = C1 - 0.0074 * Sin(dr * (m - Mpr)) + 0.0004 * Sin(dr * (2 * F + m))
  36.     C1 = C1 - 0.0004 * Sin(dr * (2 * F - m)) - 0.0006 * Sin(dr * (2 * F + Mpr))
  37.     C1 = C1 + 0.001 * Sin(dr * (2 * F - Mpr)) + 0.0005 * Sin(dr * (2 * Mpr + m))
  38.     If (T < -11) Then
  39.         deltat = 0.001 + 0.000839 * T + 0.0002261 * T2 _
  40.                 - 0.00000845 * T3 - 0.000000081 * T * T3
  41.     Else
  42.         deltat = -0.000278 + 0.000265 * T + 0.000262 * T2
  43.     End If
  44.     JdNew = Jd1 + C1 - deltat
  45.     NewMoon = JdNew
  46. End Function
  47.  
  48. Function SunLongitude(ByVal jdn As Double) As Double
  49.     Dim T As Double, T2 As Double, dr As Double, m As Double
  50.     Dim L0 As Double, DL As Double, L As Double
  51.     T = (jdn - 2451545) / 36525
  52.         ' Time in Julian centuries from 2000-01-01 120000 GMT
  53.    T2 = T * T
  54.     dr = PI / 180 ' degree to radian
  55.    m = 357.5291 + 35999.0503 * T - 0.0001559 * T2 - 0.00000048 * T * T2
  56.     L0 = 280.46645 + 36000.76983 * T + 0.0003032 * T2
  57.     DL = (1.9146 - 0.004817 * T - 0.000014 * T2) * Sin(dr * m)
  58.     DL = DL + (0.019993 - 0.000101 * T) * Sin(dr * 2 * m) _
  59.         + 0.00029 * Sin(dr * 3 * m)
  60.     L = L0 + DL ' true longitude, degree
  61.    L = L * dr
  62.     L = L - PI * 2 * (Fix(L / (PI * 2))) ' Normalize to (0, 2*PI)
  63.    SunLongitude = L
  64. End Function
  65.  
  66. Function getSunLongitude(ByVal dayNumber As Double, ByVal timeZone As Byte) As Long
  67.     getSunLongitude = Fix(SunLongitude(dayNumber - 0.5 - timeZone / 24) / PI * 6)
  68. End Function
  69.  
  70. Function getNewMoonDay(ByVal k As Long, ByVal timeZone As Long) As Long
  71.     getNewMoonDay = Fix(NewMoon(k) + 0.5 + timeZone / 24)
  72. End Function
  73.  
  74. Function getLunarMonth11(ByVal yy As Long, ByVal timeZone As Long) As Long
  75.     Dim k As Long, off As Double, nm As Long, sunLong As Double
  76.     off = jdFromDate(31, 12, yy) - 2415021
  77.     k = Fix(off / 29.530588853)
  78.     nm = getNewMoonDay(k, timeZone)
  79.     sunLong = getSunLongitude(nm, timeZone) ' sun longitude at local midnight
  80.    If (sunLong >= 9) Then
  81.         nm = getNewMoonDay(k - 1, timeZone)
  82.     End If
  83.     getLunarMonth11 = nm
  84. End Function
  85.  
  86.  
  87. Function getLeapMonthOffset(ByVal a11 As Double, ByVal timeZone As Long) As Long
  88.     Dim k As Long, last As Long, Arc As Long, I As Long
  89.     k = Fix((a11 - 2415021.07699869) / 29.530588853 + 0.5)
  90.     last = 0
  91.     I = 1 ' We start with the month following lunar month 11
  92.    Arc = getSunLongitude(getNewMoonDay(k + I, timeZone), timeZone)
  93.     Do
  94.         last = Arc
  95.         I = I + 1
  96.         Arc = getSunLongitude(getNewMoonDay(k + I, timeZone), timeZone)
  97.     Loop While (Arc <> last And I < 14)
  98.     getLeapMonthOffset = I - 1
  99. End Function
  100.  
  101. Function Solar2Lunar(ByVal dd As Long, ByVal mm As Long, _
  102. Optional ByVal yy As Long = 0, Optional ByVal timeZone As Long = 7) As String
  103.     Dim k As Long, diff As Long, leapMonthDiff As Long, dayNumber As Long
  104.     Dim monthStart As Double, a11 As Long, b11 As Long
  105.     Dim lunarDay As Double, lunarMonth As Long, lunarYear As Long, lunarLeap As Long
  106.  
  107.     If yy = 0 Then yy = year(Date)
  108.     dayNumber = jdFromDate(dd, mm, yy)
  109.     k = Fix((dayNumber - 2415021.07699869) / 29.530588853)
  110.     monthStart = getNewMoonDay(k + 1, timeZone)
  111.     If (monthStart > dayNumber) Then
  112.         monthStart = getNewMoonDay(k, timeZone)
  113.     End If
  114.  
  115.     a11 = getLunarMonth11(yy, timeZone)
  116.     b11 = a11
  117.     If (a11 >= monthStart) Then
  118.         lunarYear = yy
  119.         a11 = getLunarMonth11(yy - 1, timeZone)
  120.     Else
  121.         lunarYear = yy + 1
  122.         b11 = getLunarMonth11(yy + 1, timeZone)
  123.     End If
  124.     lunarDay = dayNumber - monthStart + 1
  125.     diff = Fix((monthStart - a11) / 29)
  126.     lunarLeap = 0
  127.     lunarMonth = diff + 11
  128.     If (b11 - a11 > 365) Then
  129.         leapMonthDiff = getLeapMonthOffset(a11, timeZone)
  130.         If (diff >= leapMonthDiff) Then
  131.             lunarMonth = diff + 10
  132.             If (diff = leapMonthDiff) Then lunarLeap = 1
  133.         End If
  134.     End If
  135.     If (lunarMonth > 12) Then lunarMonth = lunarMonth - 12
  136.     If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
  137.     ' NguyenQuocSan
  138.    'Solar2Lunar = Format(lunarDay, "00") & _
  139.                 "/" & Format(lunarMonth, "00") & _
  140.                 "/" & Format(lunarYear, "0000 \A\L") & IIf(lunarLeap, " (" & lunarMonth & " N)", "")
  141.  
  142.     'truongphu bô sung
  143.    Dim NamAL$ NamAL = NamÂmLich(lunarYear) & IIf(lunarLeap, " (" & lunarMonth & " N)", "")
  144.     Solar2Lunar = Format(lunarDay, "00") & _
  145.                 "/" & Format(lunarMonth, "00") & "/" & NamAL
  146. End Function
  147.  
  148. Function NamÂmLich(ByVal year As Long) As String
  149.     Dim Can$(), Chi$() ' truongphu
  150.    Can = Split("Canh,Tân,Nhâm,Qúy,Giáp,Ât,Bính,Ðinh,Mâu,Ky", ",")
  151.     Chi = Split("Thân,Dâu,Tuât,Ho'i,Tý,Suu,Dân,Mao,Thìn,Ty,Ngo,Mùi", ",")
  152.     NamÂmLich = Can(year Mod 10) & " " & Chi(year Mod 12)
  153. End Function

untitled.JPG
untitled.JPG (15.95 KiB) Đã xem 11885 lần
Hay không?

Project sử dụng module như hình minh họa:
Tập tin đính kèm
Mã nguôn DL-Al Nguyen Quôc San - truongphu.rar
(3.92 KiB) Đã tải về 1026 lần
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
target_locked
Thành viên chính thức
Thành viên chính thức
Bài viết: 44
Ngày tham gia: Thứ 4 01/04/2009 12:04 pm
Has thanked: 4 times
Been thanked: 1 time

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by target_locked »

Không ngờ code đổi sang Âm lịch lại ngắn gọn như vậy.
Thanks Bác. :)
btamsgn
Thành viên chính thức
Thành viên chính thức
Bài viết: 47
Ngày tham gia: Thứ 5 10/04/2008 4:40 pm
Has thanked: 3 times

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by btamsgn »

Chào TrươngPhu,

Bạn giúp mình code liệt kê 24 ngày đầu tiên tiết khí trong 1 năm? thanks,


Thanks,
Tâm
Hình đại diện của thành viên
truongphu
VIP
VIP
Bài viết: 4785
Ngày tham gia: Chủ nhật 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 530 times

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by truongphu »

Kinh độ Mặt Trời Tiếng Việt Tiếng Hoa1 Tiếng Nhật Tiếng Triều2 Ý nghĩa3 Ngày dương lịch4
315° Lập xuân 立春 立春(りっしゅん) 입춘(立春) Bắt đầu mùa xuân 4 tháng 2
330° Vũ thủy 雨水 雨水(うすい) 우수(雨水) Mưa ẩm 19 tháng 2
345° Kinh trập 驚蟄(惊蛰) 啓蟄(けいちつ) 경칩(驚蟄) Sâu nở 5 tháng 3
0° Xuân phân 春分 春分(しゅんぶん) 춘분(春分) Giữa xuân 21 tháng 3
15° Thanh minh 清明 清明(せいめい) 청명(清明) Trời trong sáng 5 tháng 4
30° Cốc vũ 穀雨(谷雨) 穀雨(こくう) 곡우(穀雨) Mưa rào 20 tháng 4
45° Lập hạ 立夏 立夏(りっか) 입하(立夏) Bắt đầu mùa hè 6 tháng 5
60° Tiểu mãn 小滿(小满) 小満(しょうまん) 소만(小滿) Lũ nhỏ, duối vàng 21 tháng 5
75° Mang chủng 芒種(芒种) 芒種(ぼうしゅ) 망종(芒種) Chòm sao tua rua mọc 6 tháng 6
90° Hạ chí 夏至 夏至(げし) 하지(夏至) Giữa hè 21 tháng 6
105° Tiểu thử 小暑 小暑(しょうしょ) 소서(小暑) Nóng nhẹ 7 tháng 7
120° Đại thử 大暑 大暑(たいしょ) 대서(大暑) Nóng oi 23 tháng 7
135° Lập thu 立秋 立秋(りっしゅう) 입추(立秋) Bắt đầu mùa thu 7 tháng 8
150° Xử thử 處暑(处暑) 処暑(しょしょ) 처서(處暑) Mưa ngâu 23 tháng 8
165° Bạch lộ 白露 白露(はくろ) 백로(白露) Nắng nhạt 8 tháng 9
180° Thu phân 秋分 秋分(しゅうぶん) 추분(秋分) Giữa thu 23 tháng 9
195° Hàn lộ 寒露 寒露(かんろ) 한로(寒露) Mát mẻ 8 tháng 10
210° Sương giáng 霜降 霜降(そうこう) 상강(霜降) Sương mù xuất hiện 23 tháng 10
225° Lập đông 立冬 立冬(りっとう) 입동(立冬) Bắt đầu mùa đông 7 tháng 11
240° Tiểu tuyết 小雪 小雪(しょうせつ) 소설(小雪) Tuyết xuất hiện 22 tháng 11
255° Đại tuyết 大雪 大雪(たいせつ) 대설(大雪) Tuyết dày 7 tháng 12
270° Đông chí 冬至 冬至(とうじ) 동지(冬至) Giữa đông 22 tháng 12
285° Tiểu hàn 小寒 小寒(しょうかん) 소한(小寒) Rét nhẹ 6 tháng 1
300° Đại hàn 大寒 大寒(だいかん) 대한(大寒) Rét đậm 21 tháng 1

http://vi.wikipedia.org/wiki/Ti%E1%BA%BFt_kh%C3%AD
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh
tuybutduyen
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 66
Ngày tham gia: Thứ 3 29/05/2012 2:17 pm
Has thanked: 11 times
Tiếp xúc:

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by tuybutduyen »

Các Anh Chị cho mình hỏi, nếu chuyển từ Âm lịch sang Dương lịch thì làm thế nào?
Cảm ơn các Anh Chị!
btamsgn
Thành viên chính thức
Thành viên chính thức
Bài viết: 47
Ngày tham gia: Thứ 5 10/04/2008 4:40 pm
Has thanked: 3 times

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by btamsgn »

Chào bạn,
Cảm ơn bạn
Bạn có thể cho mình xin code xem ngày tiết khí đầu tiên hay không? Vì một năm có 24 tiết khí

Ví dụ: form gồm combobox1(24 tiết khí), textbox1(năm) và textbox2(ngày tiết khí). Trong combo box liệt kê sẵn 24 tiết khí của 1 năm bất kì. Khi chọn tiết khí "tiểu hàn" trong combox1 và gõ năm 2013 trong textbox1 sẽ hiện ngày tiết khí đó trong textbox2 là ngày 05 tháng 01 năm 2013

Rất mong nhận được thông tin trợ giúp từ bạn.

Thanks,
Tâm

truongphu đã viết:Kinh độ Mặt Trời Tiếng Việt Tiếng Hoa1 Tiếng Nhật Tiếng Triều2 Ý nghĩa3 Ngày dương lịch4
315° Lập xuân 立春 立春(りっしゅん) 입춘(立春) Bắt đầu mùa xuân 4 tháng 2
330° Vũ thủy 雨水 雨水(うすい) 우수(雨水) Mưa ẩm 19 tháng 2
345° Kinh trập 驚蟄(惊蛰) 啓蟄(けいちつ) 경칩(驚蟄) Sâu nở 5 tháng 3
0° Xuân phân 春分 春分(しゅんぶん) 춘분(春分) Giữa xuân 21 tháng 3
15° Thanh minh 清明 清明(せいめい) 청명(清明) Trời trong sáng 5 tháng 4
30° Cốc vũ 穀雨(谷雨) 穀雨(こくう) 곡우(穀雨) Mưa rào 20 tháng 4
45° Lập hạ 立夏 立夏(りっか) 입하(立夏) Bắt đầu mùa hè 6 tháng 5
60° Tiểu mãn 小滿(小满) 小満(しょうまん) 소만(小滿) Lũ nhỏ, duối vàng 21 tháng 5
75° Mang chủng 芒種(芒种) 芒種(ぼうしゅ) 망종(芒種) Chòm sao tua rua mọc 6 tháng 6
90° Hạ chí 夏至 夏至(げし) 하지(夏至) Giữa hè 21 tháng 6
105° Tiểu thử 小暑 小暑(しょうしょ) 소서(小暑) Nóng nhẹ 7 tháng 7
120° Đại thử 大暑 大暑(たいしょ) 대서(大暑) Nóng oi 23 tháng 7
135° Lập thu 立秋 立秋(りっしゅう) 입추(立秋) Bắt đầu mùa thu 7 tháng 8
150° Xử thử 處暑(处暑) 処暑(しょしょ) 처서(處暑) Mưa ngâu 23 tháng 8
165° Bạch lộ 白露 白露(はくろ) 백로(白露) Nắng nhạt 8 tháng 9
180° Thu phân 秋分 秋分(しゅうぶん) 추분(秋分) Giữa thu 23 tháng 9
195° Hàn lộ 寒露 寒露(かんろ) 한로(寒露) Mát mẻ 8 tháng 10
210° Sương giáng 霜降 霜降(そうこう) 상강(霜降) Sương mù xuất hiện 23 tháng 10
225° Lập đông 立冬 立冬(りっとう) 입동(立冬) Bắt đầu mùa đông 7 tháng 11
240° Tiểu tuyết 小雪 小雪(しょうせつ) 소설(小雪) Tuyết xuất hiện 22 tháng 11
255° Đại tuyết 大雪 大雪(たいせつ) 대설(大雪) Tuyết dày 7 tháng 12
270° Đông chí 冬至 冬至(とうじ) 동지(冬至) Giữa đông 22 tháng 12
285° Tiểu hàn 小寒 小寒(しょうかん) 소한(小寒) Rét nhẹ 6 tháng 1
300° Đại hàn 大寒 大寒(だいかん) 대한(大寒) Rét đậm 21 tháng 1

http://vi.wikipedia.org/wiki/Ti%E1%BA%BFt_kh%C3%AD
Angel464
Bài viết: 4
Ngày tham gia: Thứ 2 06/05/2013 1:52 pm
Has thanked: 3 times

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by Angel464 »

Chào bác Trượng Phu,

Bác cho xin thêm code tính giờ hoàng đạo như trong code của bác Ngọc Đức luôn ạ.

Cảm ơn nhiều,
Angel464
Bài viết: 4
Ngày tham gia: Thứ 2 06/05/2013 1:52 pm
Has thanked: 3 times

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by Angel464 »

Sao buồn thế! Chẳng có ai có ý kiến giúp cả.

Bác nào dành PHP chuyển giúp đoạn này qua VB giúp:
private static function getGioHoangDao($jd)
{
$chiOfDay = ($jd + 1) % 12;
$gioHD = self::getHoangDao($chiOfDay % 6); // same values for Ty' (1) and Ngo. (6), for Suu and Mui etc.
$ret = "";
$count = 0;
for ($i = 0; $i < 12; $i++) {
$s = substr($gioHD, $i, 1);
if ($s == '1') {
$ret .= self::getListChi()[$i];
$ret .= ' (' . (($i * 2 + 23) % 24) . '-' . (($i * 2 + 1) % 24) . ')';
if ($count++ < 5) $ret .= ', ';
//if (count == 3) ret += '\n';
}
}
return $ret;
}
Xin cảm ơn.
Hình đại diện của thành viên
phanthequang4101987
Thành viên danh dự
Thành viên danh dự
Bài viết: 116
Ngày tham gia: Thứ 3 01/04/2008 6:39 am
Đến từ: Nghi Xuân - Hà Tĩnh
Has thanked: 4 times
Been thanked: 21 times
Tiếp xúc:

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by phanthequang4101987 »

Tối về tôi gửi cho mã có tính giờ,ngày hoàng đạo
†™_Çøø£_™†.......♥.......†™_U††»ñhøç_™†
Đưa người ta chưa đưa qua sông
mà sao nghe tiếng sóng trong lòng
.(¯`v´¯)_______ÎÎ_____ÎÎ________(¯`v´¯)
Angel464
Bài viết: 4
Ngày tham gia: Thứ 2 06/05/2013 1:52 pm
Has thanked: 3 times

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by Angel464 »

Xin cảm ơn bạn nhiều lắm,

Cuối cùng đã có người giúp tôi!

Trân trọng,
Hình đại diện của thành viên
phanthequang4101987
Thành viên danh dự
Thành viên danh dự
Bài viết: 116
Ngày tham gia: Thứ 3 01/04/2008 6:39 am
Đến từ: Nghi Xuân - Hà Tĩnh
Has thanked: 4 times
Been thanked: 21 times
Tiếp xúc:

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by phanthequang4101987 »

Đây là mã nguồn khá toàn diện mà mình làm dở ko phát triển thêm bạn tham khảo
Tập tin đính kèm
vi du lich viet.rar
Ví dụ
(536.16 KiB) Đã tải về 241 lần
†™_Çøø£_™†.......♥.......†™_U††»ñhøç_™†
Đưa người ta chưa đưa qua sông
mà sao nghe tiếng sóng trong lòng
.(¯`v´¯)_______ÎÎ_____ÎÎ________(¯`v´¯)
Angel464
Bài viết: 4
Ngày tham gia: Thứ 2 06/05/2013 1:52 pm
Has thanked: 3 times

Re: Module chuyển Dương Lich sang Âm lịch

Gửi bài by Angel464 »

Cảm ơn bạn nhiều,
Đăng trả lời

Quay về