• 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

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

Bộ sưu tập mã nguồn các ứng dụng tiện ích
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4755
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 13 time
Been thanked: 509 time

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

Gửi bàigửi bởi truongphu » T.Bảy 30/01/2016 8:49 pm

  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.  


Hay không? :D


o0o--truongphu--o0o

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

Quay về “[VB] Mã nguồn chương trình tiện ích”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.0 khách