?? 123.bas
字號:
'***************************************************
'* 返回dY年dM月dD日農歷的節氣 *
'***************************************************
Dim i As Integer, j As Integer, dY As Integer, dM As Integer, dD As Integer
Dim D As String, D1 As String, D2 As String, DDD As Date
Dim DDD1 As Date, DDD2 As Date, Ddd3 As Date
dY = Year(ddy)
dM = Month(ddy)
dD = Day(ddy)
D = Trim(Str(Year(ddy))) + "," + Trim(Str(Month(ddy))) + "," + Trim(Str(15 - Val(Mid(seaSonY(dY - 1901), ((dM - 1) * 4 + 1), 2))))
D1 = Trim(Str(Year(ddy))) + "," + Trim(Str(Month(ddy))) + "," + Trim(Str(15 + Val(Mid(seaSonY(dY - 1901), ((dM - 1) * 4 + 3), 2))))
If Month(ddy) > 1 Then
D2 = Trim(Str(Year(ddy))) + "," + Trim(Str(Month(ddy) - 1)) + "," + Trim(Str(15 + Val(Mid(seaSonY(dY - 1901), ((dM - 2) * 4 + 3), 2))))
Else
D2 = Trim(Str(Year(ddy) - 1)) + "," + Trim(Str(12)) + "," + Trim(Str(15 + Val(Mid(seaSonY(dY - 1901), ((dM + 12 - 2) * 4 + 3), 2))))
End If
DDD = D
DDD1 = D1
DDD2 = D2
If ddy >= DDD Then
seaSonYx = solarTerm((dM - 1) * 2) + "第" + Trim(Str(ddy - DDD + 1)) + "天"
Else
If dM < 2 Then
seaSonYx = solarTerm(11 * 2 + 1) + "第" + Trim(Str(ddy - DDD2 + 1)) + "天"
Else
seaSonYx = solarTerm((dM - 2) * 2 + 1) + "第" + Trim(Str(ddy - DDD2 + 1)) + "天"
End If
End If
If ddy >= DDD1 Then
seaSonYx = solarTerm((dM - 1) * 2 + 1) + "第" + Trim(Str(ddy - DDD1 + 1)) + "天"
End If
End Function
Public Function ssFtv(m As Integer, D As Integer)
Dim aa
'***************************************************
'* 返回陽歷M月D日的節日 *
'***************************************************
For aa = 0 To 30
If (Val(Mid(sFtv(aa), 1, 2)) = m) And (Val(Mid(sFtv(aa), 3, 2)) = D) Then
' If aa >= 10 And aa <= 25 Then
ssFtv = Mid(sFtv(aa), 5, LenB(sFtv(aa)) - 5)
' Else
' ssFtv = Mid(sFtv(aa), 5, LenB(sFtv(aa)) - 5)
' End If
End If
Next aa
End Function
Public Function yTGDZ(y As Integer)
'***************************************************
'* 返回農歷y年的天干、地支 *
'***************************************************
yTGDZ = Gan((y - 1894) Mod 10) + Zhi((y - 1901) Mod 12)
End Function
Public Function llFtv(m As Integer, D As Integer)
'***************************************************
'* 返回農歷M月D日的節日 *
'***************************************************
Dim aa As Integer
llFtv = ""
For aa = 0 To 30
If (Val(Mid(lFtv(aa), 1, 2)) = m) And (Val(Mid(lFtv(aa), 3, 2)) = D) Then
If aa >= 10 And aa <= 25 Then
llFtv = Mid(lFtv(aa), 5, LenB(lFtv(aa)) - 4) + "happy birthday"
Else
llFtv = Mid(lFtv(aa), 5, LenB(lFtv(aa)) - 4)
End If
End If
Next aa
End Function
Public Function sdayF_gzr(dY As Date)
'***************************************************
'* 返回農歷y年M月D日的天干、地支 *
'***************************************************
Dim dE As Date, dK As Long
dE = #2/15/1901#
dK = dY - dE
sdayF_gzr = Gan(dK Mod 10) + Zhi((dK - 1) Mod 12)
End Function
Public Function sdayF_gzm(dY As Integer, dM As Integer)
'***************************************************
'* 返回農歷y年M月的天干、地支 *
'***************************************************
Dim dK As Long
dK = (dY - 1901) * 12 + dM
sdayF_gzm = Gan((dK + 5) Mod 10) + Zhi((dK) Mod 12)
End Function
Public Function seaSonYxr(dY As Date)
'***************************************************
'* 返回dY年dM月dD日農歷的九九 伏 *
'***************************************************
Dim dE As Date, dK As Long, Val_1 As Integer
Dim D As String, D1 As String, D2 As String, DDD As Date
Dim i As Integer, DDD1 As Date, DDD2 As Date, Ddd3 As Date
dE = #2/15/1901#
i = 0
D = Trim(Str(Year(dY) - 1)) + ",12," + Trim(Str(15 + Val(Right(seaSonY(Year(dY) - 1900), 2))))
D1 = Trim(Str(Year(dY))) + ",6," + Trim(Str(15 + Val(Mid(seaSonY(Year(dY) - 1901), 23, 2))))
D2 = Trim(Str(Year(dY))) + ",12," + Trim(Str(15 + Val(Right(seaSonY(Year(dY) - 1901), 2))))
DDD = D
DDD1 = D1
Ddd3 = DDD1
DDD2 = D2
If ((dY >= DDD) And (dY < DDD1)) Then
If dY - DDD < 81 Then
seaSonYxr = nStr1(Int((dY - DDD) / 9) + 1) + "九第" + nStr1(((dY - DDD) Mod 9) + 1) + "天"
Else
seaSonYxr = "越來越暖和"
End If
ElseIf ((dY >= DDD1) And (dY < DDD2 - 30)) Then
While i < 3
dK = Ddd3 - dE
If Gan1(dK Mod 10) = "ge" Then i = i + 1
Ddd3 = Ddd3 + 1
Wend
Val_1 = Int((dY - Ddd3 + 1) / 10)
Select Case Val_1
Case 0
seaSonYxr = "初伏第" + nStr1(((dY - Ddd3 + 1) Mod 10) + 1) + "天"
Case 1
seaSonYxr = "中伏第" + nStr1(((dY - Ddd3 + 1) Mod 10) + 1) + "天"
Case 2
seaSonYxr = "中伏第十" + nStr1(((dY - Ddd3 + 1) Mod 10) + 1) + "天"
Case 3
seaSonYxr = "大伏第" + nStr1(((dY - Ddd3 + 1) Mod 10) + 1) + "天"
Case Else
If Val_1 < 4 Then
seaSonYxr = "快入伏天啦"
Else
seaSonYxr = "越來越涼爽"
End If
End Select
ElseIf ((dY >= (DDD2 - 30)) And (dY < DDD2 - 10)) Then
seaSonYxr = "越來越冷啦"
ElseIf ((dY >= (DDD2 - 10)) And (dY < DDD2)) Then
seaSonYxr = "快到數九寒天啦"
ElseIf (dY >= DDD2) Then
seaSonYxr = nStr1(Int((dY - DDD2) / 9) + 1) + "九第" + nStr1(((dY - DDD2) Mod 9) + 1) + "天"
End If
End Function
Public Sub sub_For(kKk As Integer, yL As Integer)
Dim i
For i = 1 To kKk
If i = Val(Mid(yearDate(yL), 14, 2)) + 1 Then
If (i - 1) < 10 Then
lmName(i) = "Y0" + Trim(Str(i - 1)) + "Month"
Else
lmName(i) = "Y" + Trim(Str(i - 1)) + "Month"
End If
Else
If i < Val(Mid(yearDate(yL), 14, 2)) + 1 Then
If i < 10 Then
lmName(i) = "00" + Trim(Str(i)) + "Month"
Else
lmName(i) = "0" + Trim(Str(i)) + "Month"
End If
Else
If (i - 1) < 10 Then
lmName(i) = "00" + Trim(Str(i - 1)) + "Month"
Else
lmName(i) = "0" + Trim(Str(i - 1)) + "Month"
End If
End If
End If
If Val(Mid(yearDate(yL), i, 1)) = "1" Then
lmName(i) = lmName(i) + "Big"
Else
lmName(i) = lmName(i) + "Sma"
End If
Next i
End Sub
Public Sub sub_For1(kKk As Integer, yL As Integer)
Dim i
For i = 1 To kKk
If i < 10 Then
lmName(i) = "00" + Trim(Str(i)) + "Month"
Else
lmName(i) = "0" + Trim(Str(i)) + "Month"
End If
If Val(Mid(yearDate(yL), i, 1)) = "1" Then
lmName(i) = lmName(i) + "Big"
Else
lmName(i) = lmName(i) + "Sma"
End If
Next i
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -