Mã nguồn lịch ÂD 2016 đơn giản

[truongphu]

Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]

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

GeSHi © Codebox Plus

Hay không?