|
ewdate As Date
Dim num As Double
Dim y As Long
Dim TempStr As String
baseDateAndTime = #1/6/1900 2:05:00 AM#
y = mvarsYear
TempStr = ""
Dim i As Long
For i = 1 To 24
num = 525948.76 * (y - 1900) + sTermInfo(i - 1)
newdate = DateAdd("n", num, baseDateAndTime) ''''按分钟计算,之所以不按秒钟计算，是因为会溢出
If Abs(DateDiff("d", newdate, mvarDate)) = 0 Then
TempStr = SolarTerm(i - 1)
Exit For
End If
Next
lSolarTerm = TempStr
End Property
''''计算按第几周星期几计算的节日
Public Property Get wHoliday() As String
Dim w As Long
Dim i As Long
Dim b As Long
Dim FirstDay As Date
Dim TempStr As String
b = UBound(wHolidayInfo)
For i = 0 To b
If wHolidayInfo(i).Month = mvarsMonth Then ''''当月份相当时
w = WeekDay(mvarDate)
If wHolidayInfo(i).WeekDay = w Then ''''仅当星期几也相等时
FirstDay = mvarsMonth & "/" & 1 & "/" & mvarsYear ''''取当月第一天
If (DateDiff("ww", FirstDay, mvarDate) = wHolidayInfo(i).WeekAtMonth) Then
TempStr = wHolidayInfo(i).HolidayName
End If
End If
End If
Next
wHoliday = TempStr
End Property
Public Property Get lHoliday() As String
Dim i As Long
Dim b As Long
Dim TempStr As String
Dim oy As Long
Dim odate As Date
Dim ndate As Date
TempStr = ""
b = UBound(lHolidayInfo)
If mvarlMonth = 12 And (mvarlDay = 29 Or mvarlDay = 30) Then
''''保
oy = mvarlYear ''''保存农历年数
odate = mvarDate
ndate = mvarDate + 1
Call sInitDate(Year(ndate), Month(ndate), Day(ndate)) ''''计算第二天的属性
If oy = mvarlYear - 1 Then ''''如果农历年数增加了1
TempStr = "除夕"
Call sInitDate(Year(odate), Month(odate), Day(odate)) ''''恢复到今天原有数据
End If
Else
For i = 0 To b
If (lHolidayInfo(i).Month = mvarlMonth) And _
(lHolidayInfo(i).Day = mvarlDay) Then
TempStr = lHolidayInfo(i).HolidayName
Exit For
End If
Next
End If
lHoliday = TempStr
End Property
''''求公历节日
Public Property Get sHoliday() As String
Dim i As Long
Dim b As Long
Dim TempStr As String
TempStr = ""
b = UBound(sHolidayInfo)
For i = 0 To b
If (sHolidayInfo(i).Month = mvarsMonth) And _
(sHolidayInfo(i).Day = mvarsDay) Then
TempStr = sHolidayInfo(i).HolidayName
Exit For
End If
Next
sHoliday = TempStr
End Property
''''是否是农历的闰月
Public Property Get IsLeap() As Boolean
IsLeap = mvarIsLeap
End Property
Public Property Get lDay() As Long
lDay = mvarlDay
End Property
Public Property Get lMonth() As Long
lMonth = mvarlMonth
End Property
Public Property Get lYear() As Long
lYear = mvarlYear
End Property
Public Property Get sWeekDay() As Long
sWeekDay = WeekDay(mvarDate)
End Property
''''计算星期几中文字串
Public Property Get sWeekDayStr() As String
Select Case WeekDay(mvarDate)
Case vbSunday
sWeekDayStr = "星期日"
Case vbMonday
sWeekDayStr = "星期一"
Case vbTuesday
sWeekDayStr = "星期二"
Case vbWednesday
sWeekDayStr = "星期三"
Case vbThursday
sWeekDayStr = "星期四"
Case vbFriday
sWeekDayStr = "星期五"
Case vbSaturday
sWeekDayStr = "星期六"
End Select
End Property
Public Property Get sDay() As Long
sDay = mvarsDay
End Property
Public Property Get sMonth() As Long
sMonth = mvarsMonth
End Property
Public Property Get sYear() As Long
sYear = mvarsYear
End Property
''''////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Function IsToday(y As Long, m As Long, d As Long) As Boolean
If (Year(Date) = y) And _
(Month(Date) = m) And _
(Day(Date) = d) Then
IsToday = True
Else
IsToday = False
End If
End Function
''''根据年份不同计算当年属于什么朝代
Public Function Era(y As Long) As String
Dim TempStr As String
If y < 1874 Then
TempStr = "未知"
Else
If y <= 1908 Then
TempStr = "清朝光绪"
If y = 1874 Then
TempStr = TempStr & "元年"
Else
TempStr = TempStr & UpNumber(CStr(y - 1874)) & "年"
End If
Else
If y <= 1910 Then
TempStr = "清朝宣统"
If y = 1909 Then
TempStr = TempStr & "元年"
Else
TempStr = TempStr & UpNumber(CStr(y - 1909 + 1)) & "年"
End If
Else
If y < 1949 Then
TempStr = "中华民国"
If y = 1912 Then
TempStr = TempStr & "元年"
Else
TempStr = TempStr & UpNumber(CStr(y - 1912 + 1)) & "年"
End If
Else
&nb
上一页 [1] [2] [3] [4] [5] [6] 下一页
[系统软件]用RegDllView揪出所有已注册的dll/ocx [系统软件]Windows系统的活动大陆基石 细看DLL文件
[系统软件]Windows的活动大陆：细看DLL文件 [常用软件]利用msdvm.dll实现微软虚拟桌面
[VB.NET程序]使用VB6.0设计ActiveX DLL事件 [VB.NET程序]Crystal Report(水晶报表)的报表封装成VB的DLL
[VB.NET程序]用diskid.dll和disk32.dll获得硬盘序列号 [Delphi程序]输出SHELL32.DLL的图标
[Delphi程序]把图标存储在SHELL32.DLL [Delphi程序]DLL 應用 - 設計可抽換的模組
| 
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
