daList(1985) = "011010100101000220"
daList(1986) = "011011010100000209"
daList(1987) = "101011011010060129"
daList(1988) = "101010110110000217"
daList(1989) = "100100110111000206"
daList(1990) = "010010010111150127"
daList(1991) = "010010010111000215"
daList(1992) = "011001001011000204"
daList(1993) = "011010100101030123"
daList(1994) = "111010100101000210"
daList(1995) = "011010110010180131"
daList(1996) = "010110101100000219"
daList(1997) = "101010110110000207"
daList(1998) = "100100110110150128"
daList(1999) = "100100101110000216"
daList(2000) = "110010010110000205"
daList(2001) = "110101001010140124"
daList(2002) = "110101001010000212"
daList(2003) = "110110100101000201"
daList(2004) = "010110101010120122"
daList(2005) = "010101101010000209"
daList(2006) = "101010101101170129"
daList(2007) = "001001011101000218"
daList(2008) = "100100101101000207"
daList(2009) = "110010010101150126"
daList(2010) = "101010010101000214"
daList(2011) = "101101001010000214"
AddYear = tYear
RunYue = False
If IsGetGl Then
AddMonth = Val(Mid(daList(AddYear), 15, 2))
AddDay = Val(Mid(daList(AddYear), 17, 2))
conDate = DateSerial(AddYear, AddMonth, AddDay)
AddDay = tDay
For i = 1 To tMonth - 1
AddDay = AddDay 29 Val(Mid(daList(tYear), i, 1))
Next i
'MsgBox DateDiff("d", conDate, Date)
setDate = DateAdd("d", AddDay - 1, conDate)
GetYLDate = setDate
tYear = Year(setDate)
tMonth = Month(setDate)
tDay = Day(setDate)
Exit Function
End If
CHUSHIHUA:
AddMonth = Val(Mid(daList(AddYear), 15, 2))
AddDay = Val(Mid(daList(AddYear), 17, 2))
conDate = DateSerial(AddYear, AddMonth, AddDay)
setDate = DateSerial(tYear, tMonth, tDay)
getDay = DateDiff("d", conDate, setDate)
If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA
' addday = NearDay
AddDay = 1: AddMonth = 1
For i = 1 To getDay
AddDay = AddDay 1
If AddDay = 30 Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 Mid(daList(AddYear), 13, 1)) Then
If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then
RunYue = True
Else
RunYue = False
AddMonth = AddMonth 1
End If
AddDay = 1
End If
Next
md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
dd$ = Mid(md$, (AddDay - 1) * 2 1, 2)
mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) "月"
YouGetDate = DateSerial(AddYear, AddMonth, AddDay)
tiangan$ = "甲乙丙丁戊已庚辛壬癸"
dizhi$ = "子丑寅卯辰巳午未申酉戌亥"
Dim ganzhi(0 To 59) As String * 2
For i = 0 To 59
ganzhi(i) = Mid(tiangan$, (i Mod 10) 1, 1) Mid(dizhi$, (i Mod 12) 1, 1)
'ff$ = ff$ ganzhi(i)
Next i
'MsgBox ff$, , Len(ff$)
YLyear = ganzhi((AddYear - 4) Mod 60)
shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) 1, 1)
If RunYue Then mm$ = "闰" mm$
GetYLDate = mm$ dd$
End Function
'下面是一个使用的例子，你需要在窗体上加上一个按扭，并命名为Command1，然后将下列代码复制到窗体的代码中
Private Sub Command1_Click()
Dim ty As Integer, tm As Integer, td As Integer, yl As String, sx As String
'取公历1999年10月28日的农历日期
ty = 1999
tm = 10
td = 28
t = GetYLDate(ty, tm, td, yl, sx)
MsgBox t
MsgBox ty & "-" & tm & "-" & td & " " & yl & " " & sx
'取1999年农历十月28的公历日期
t = GetYLDate(ty, tm, td, yl, sx, True)
MsgBox t
MsgBox ty & "-" & tm & "-" & td & " " & yl & " " & sx
End Sub
上一篇： 用VB设计VCD播放器的方法与技巧
下一篇： VB的“提问”与“回答”
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
