• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Lịch Âm Dương năm 2010

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Lịch Âm Dương năm 2010

Postby truongphu » Wed 22/07/2009 9:11 pm

Thủ thuật: Lịch Âm Dương năm 2010
Tác giả: truongphu
Mô tả: Lich Âm Dương 2010, Code gọn, Đã sửa chửa nhiều so phiên bản 2009


Code: Select all

  1. Dim Ngay As Integer, TenN As String, Thang As Integer, TenT As String, Nam As Integer, TenNa As String, Nh As String
  2. Private Function ToAL(data As Date)
  3. Dim Can() As String, Chi() As String, N As Boolean
  4. Dim DL() As String, i As Byte, days As Byte, cach As Integer
  5. DL = Split("100,1,1,1,0,1,0,1,0,0,1,0,1,0", ",") ' sô' 100 không dùng (Nhuân)
  6. cach = DateDiff("d", #1/1/2010#, data) + 17
  7.   Thang = 11
  8.     For i = 1 To 13
  9.     days = 29 + CByte(DL(i))
  10.            
  11.             If cach > days Then
  12.                 cach = cach - days
  13.                 If i = DL(0) + 1 Then ' phâ'n nâ'y không dùng (Nhuân)
  14.                     Thang = Thang ' phâ'n nâ'y không dùng (Nhuân)
  15.                     N = True ' phâ'n nâ'y không dùng (Nhuân)
  16.                 Else
  17.                     Thang = Thang + 1
  18.                 End If
  19.                 If Thang > 12 Then Thang = Thang - 12
  20.             Else
  21.                 Exit For
  22.             End If
  23.  
  24.     Next
  25. Ngay = cach
  26. If Ngay = 0 Then Ngay = 30
  27. Can = Split("Canh,Tân,Nhâm,Qúy,Giáp,Ât,Bính,Ðinh,Mâu,Ky", ",")
  28. Chi = Split("Thân,Dâu,Tuâ't,Ho'i,Tý,Su'u,Dâ'n,Mão,Thìn,Ty,Ngo,Mùi", ",")
  29. TenN = Can(DateDiff("d", #4/1/1800#, data) Mod 10) & " " & Chi(DateDiff("d", #4/1/1800#, data) Mod 12)
  30. If (Thang = 11) Or (Thang = 12) Then Nam = 2009 Else Nam = 2010
  31. If (Nam = 2009) And (data > #5/5/2010#) Then Nam = 2010
  32. TenT = Can((Nam * 12 + Thang + 7) Mod 10) & " " & Chi((Thang + 5) Mod 12)
  33. If (Thang = 11) Or (Thang = 12) Then TenNa = "Ky Su'u" Else TenNa = "Canh Dâ'n"
  34. If (TenNa = "Ky Su'u") And (data > #5/5/2010#) Then TenNa = "Canh Dâ'n"
  35. If N = True Then Nh = " (Nh)" Else Nh = ""
  36. End Function
  37.  
  38. Private Sub HScroll1_Change()
  39. Select Case HScroll2.Value
  40.     Case 1, 3, 5, 7, 8, 10, 12
  41.     HScroll1.Max = 31
  42.     Case 2
  43.     HScroll1.Max = 28
  44.     Case 4, 6, 9, 11
  45.     HScroll1.Max = 30
  46. End Select
  47. Dim DMY As Date
  48. DMY = CDate(HScroll2.Value & "/" & HScroll1.Value & "/" & "2010")
  49. Label1.Caption = Day(DMY) & "/" & Month(DMY) & "/2010"
  50. Text1 = ToAL(DMY)
  51. Text1 = "Ngày " & TenN & vbCrLf & "Tháng " & TenT & Nh & vbCrLf & "Nam " & TenNa & vbCrLf & Ngay & "/" & Thang & "/" & Nam
  52. End Sub
  53.  
  54. Private Sub HScroll2_Change()
  55. Call HScroll1_Change
  56. End Sub
  57.  
Attachments
Nam 2010 TôT.rar
(2.12 KiB) Downloaded 1212 times


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Code cho Lịch Âm-Dương mọi năm

Postby truongphu » Thu 23/07/2009 8:38 am

Code cho Lịch Âm-Dương mọi năm

Đây là Code tôi chỉnh sửa lại để tiện dùng cho mọi năm (hằng năm)
Vì là code rút gọn tối đa nên bạn phải cung cấp số liệu cho từng năm DL
* Dòng 7, bạn gõ ngày tết dương lịch của năm mới
* Dòng 10, trong hàm Split có 14 số
- Số đầu là tháng nhuận AL, nếu năm không nhuận, gõ số 13
- số thứ 2 là ký hiệu đủ-thiếu của tháng AL vào ngày tết DL: 1 là đủ, 0 là thiếu
- các số tiếp theo là tháng tiếp theo, số cuối tương ứng với tháng AL của tháng 12 DL
* Dòng 11, sau dấu cọng bạn gõ ngày AL tương ứng ngày tết DL; vd 1/1/2010 có AL là 17/11, ta gõ 17
* Dòng 12, gõ tháng AL vào ngày tết DL
Chỉ thế thôi, với Function ToAL sau đây, bạn có thể tạo lịch bất cứ năm nào
(Nếu bạn không thích từng năm phải tự cung cấp số liệu, mời xem bài lịch vạn năm của bạn vie87vn. Các số liệu trong các bài viết về lịch của tôi đều dùng lịch của bạn vie87vn)

Code: Select all

  1. Dim NgàyAL As Integer, TênNgàyAL As String, ThángAL As Integer, TênThángAL As String, Nam As Integer, TênNaM As String, Nh As String
  2.  
  3. Private Function ToAL(data As Date)
  4. Dim Can() As String, Chi() As String, TêTDL As Date
  5. Can = Split("Canh,Tân,Nhâm,Qúy,Giáp,Ât,Bính,Ðinh,Mâu,Ky", ",")
  6. Chi = Split("Thân,Dâu,Tuâ't,Ho'i,Tý,Su'u,Dâ'n,Mão,Thìn,Ty,Ngo,Mùi", ",")
  7. TêTDL = #1/1/2010#  ' <-- Cung câ'p sô' liêu
  8.  
  9. Dim DuLieu() As String, i As Byte, DaysAL As Byte
  10. DuLieu = Split("13,1,1,1,0,1,0,1,0,0,1,0,1,0", ",") ' Nam AL không nhuân ghi sô' 13, nhuân ghi tháng nhuân  ' <-- Cung câ'p sô' liêu
  11. NgàyAL = DateDiff("d", TêTDL, data) + 17 ' Cong thêm ngày AL vào ngày 1/1/2010  ' <-- Cung câ'p sô' liêu
  12.   ThángAL = 11 ' Ghi tháng AL vào ngày 1/1/2010  ' <-- Cung câ'p sô' liêu
  13.     For i = 1 To 13
  14.         DaysAL = 29 + CByte(DuLieu(i))
  15.            
  16.             If NgàyAL > DaysAL Then
  17.                 NgàyAL = NgàyAL - DaysAL
  18.                 If i = DuLieu(0) + 1 Then ' Chi dùng cho tháng nhuân
  19.                     ThángAL = ThángAL ' Chi dùng cho tháng nhuân
  20.                     Nh = " (Nh)" ' Chi dùng cho tháng nhuân
  21.                 Else
  22.                     ThángAL = ThángAL + 1
  23.                 End If
  24.                 If ThángAL > 12 Then ThángAL = ThángAL - 12
  25.             Else
  26.                 Exit For
  27.             End If
  28.     Next
  29.  
  30. TênNgàyAL = Can(DateDiff("d", #4/1/1800#, data) Mod 10) & " " & Chi(DateDiff("d", #4/1/1800#, data) Mod 12)
  31. TênThángAL = Can((Nam * 12 + ThángAL + 7) Mod 10) & " " & Chi((ThángAL + 5) Mod 12)
  32.  
  33.     If ((ThángAL = 11) Or (ThángAL = 12)) And (data < TêTDL + 60) Then ' Ðiê'u chinh tháng 11, 12 Ðâ'u nam DL
  34.         Nam = Year(TêTDL) - 1
  35.     Else
  36.         Nam = Year(TêTDL)
  37.     End If
  38. TênNaM = Can(Nam Mod 10) & " " & Chi(Nam Mod 12)
  39.  
  40. End Function


Đương nhiên code nầy hay hơn code bài trên
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Lịch Âm Dương năm 2010

Postby truongphu » Mon 30/11/2009 11:02 am

Thêm cái lịch tháng cho vui
Attachments
untitled.JPG
Lich tháng-2010.rar
(4.68 KiB) Downloaded 1052 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

btamsgn
Thành viên chính thức
Thành viên chính thức
Posts: 47
Joined: Thu 10/04/2008 4:40 pm
Has thanked: 3 times

Re: Lịch Âm Dương năm 2010

Postby btamsgn » Sun 19/12/2010 7:11 pm

Hi a.Phú,

anh có thể thêm chức năng giờ theo can/chi vào chương trình như chỉ cần nhập ngày tháng năm và giờ sinh của một người nào đó thì chương trình chuyển đổi từ Dương lịch sang âm lịch hoặc từ Âm lịch sang dương lịch khi họ click vào check box âm lịch hoặc dương lịch
ví dụ : ngày 19 tháng 12 năm 2010 vào lúc 17:30 ==>Âm lịch: Ngày 14 tháng một, năm 2010 (ngày Quý Mão, tháng Mậu Tí, năm Canh Dần; giờ Tân Dậu)
http://www.thoigian.com.vn/

kingstar99
Posts: 6
Joined: Wed 02/11/2011 10:09 pm
Has thanked: 1 time
Been thanked: 6 times

Re: Lịch Âm Dương năm 2010

Postby kingstar99 » Sat 24/12/2011 10:07 pm

Bác Phú xem giùm em ! Lổi này là gì, Em copy code của bác paste vào ra thế này ?
Image

User avatar
truongphu
VIP
VIP
Posts: 4766
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 520 times

Re: Lịch Âm Dương năm 2010

Postby truongphu » Sun 25/12/2011 9:58 am

biến TêTDL là biến Date, VB6 cho phép cọng thoải mái với một số nguyên khác...
bạn bị lỗi có lẽ .Net không tương thích?
bạn dùng thử lịch năm 2012 tôi mới viết, còn bài trên tôi viết đã lâu rồi...
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh


Return to “[VB] Chuỗi và Thời gian”

Who is online

Users browsing this forum: No registered users and 0 guests