阳历转农历
Dim MonthAdd, MagicN(99)
Dim curTime, curYear, curMonth, curDay
Dim i, m, n, k, isEnd, bit, NDate
Private Sub Command1_Click()
Text2.Text = lunarDay(Text1.Text)
End Sub
Public Function lunarDay(inDay) As String
MonthAdd = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30)
For i = 1 To 11
MonthAdd(i) = MonthAdd(i - 1) + MonthAdd(i)
Next i
'
MagicN(0) = 2635
MagicN(1) = 333387
MagicN(2) = 1701
MagicN(3) = 1748
MagicN(4) = 267701
MagicN(5) = 694
MagicN(6) = 2391
MagicN(7) = 133423
MagicN(8) = 1175
MagicN(9) = 396438
MagicN(10) = 3402
MagicN(11) = 3749
MagicN(12) = 331177
MagicN(13) = 1453
MagicN(14) = 694
MagicN(15) = 201326
MagicN(16) = 2350
MagicN(17) = 465197
MagicN(18) = 3221
MagicN(19) = 3402
MagicN(20) = 400202
MagicN(21) = 2901
MagicN(22) = 1386
MagicN(23) = 267611
MagicN(24) = 605
MagicN(25) = 2349
MagicN(26) = 137515
MagicN(27) = 2709
MagicN(28) = 464533
MagicN(29) = 1738
MagicN(30) = 2901
MagicN(31) = 330421
MagicN(32) = 1242
MagicN(33) = 2651
MagicN(34) = 199255
MagicN(35) = 1323
MagicN(36) = 529706
MagicN(37) = 3733
MagicN(38) = 1706
MagicN(39) = 398762
MagicN(40) = 2741
MagicN(41) = 1206
MagicN(42) = 267438
MagicN(43) = 2647
MagicN(44) = 1318
MagicN(45) = 204070
MagicN(46) = 3477
MagicN(47) = 461653
MagicN(48) = 1386
MagicN(49) = 2413
MagicN(50) = 330077
MagicN(51) = 1197
MagicN(52) = 2637
MagicN(53) = 268877
MagicN(54) = 3365
MagicN(55) = 531109
MagicN(56) = 2900
MagicN(57) = 2922
MagicN(58) = 398042
MagicN(59) = 2395
MagicN(60) = 1179
MagicN(61) = 267415
MagicN(62) = 2635
MagicN(63) = 661067
MagicN(64) = 1701
MagicN(65) = 1748
MagicN(66) = 398772
MagicN(67) = 2742
MagicN(68) = 2391
MagicN(69) = 330031
MagicN(70) = 1175
MagicN(71) = 1611
MagicN(72) = 200010
MagicN(73) = 3749
MagicN(74) = 527717
MagicN(75) = 1452
MagicN(76) = 2742
MagicN(77) = 332397
MagicN(78) = 2350
MagicN(79) = 3222
MagicN(80) = 268949
MagicN(81) = 3402
MagicN(82) = 3493
MagicN(83) = 133973
MagicN(84) = 1386
MagicN(85) = 464219
MagicN(86) = 605
MagicN(87) = 2349
MagicN(88) = 334123
MagicN(89) = 2709
MagicN(90) = 2890
MagicN(91) = 267946
MagicN(92) = 2773
MagicN(93) = 592565
MagicN(94) = 1210
MagicN(95) = 2651
MagicN(96) = 395863
MagicN(97) = 1323
MagicN(98) = 2707
MagicN(99) = 265877
If inDay = "" Or Not IsDate(inDay) Then
curTime = Now()
Else
curTime = CDate(inDay)
End If
If DateDiff("d", curTime, CDate("1921-2-8")) > 0 Then Exit Function
curYear = Year(curTime)
curMonth = Month(curTime)
curDay = Day(curTime)
NDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
If (curYear Mod 4) = 0 And curMonth > 2 Then NDate = NDate + 1
isEnd = 0
m = 0
'------------------------------------
Do
k = IIf(MagicN(m) < 4095, 11, 12)
n = k
'------------------------------------
Do
If n < 0 Then Exit Do
bit = MagicN(m)
For i = 1 To n
bit = Int(bit / 2)
Next
bit = bit Mod 2
If NDate <= 29 + bit Then
isEnd = 1
Exit Do
End If
NDate = NDate - 29 - bit
n = n - 1
Loop
'------------------------------------
If isEnd = 1 Then Exit Do
m = m + 1
Loop
'------------------------------------
curYear = 1921 + m
curMonth = k - n + 1
curDay = NDate
If k = 12 Then
If curMonth = (Int(MagicN(m) / 65536) + 1) Then
curMonth = 1 - curMonth
ElseIf curMonth > (Int(MagicN(m) / 65536) + 1) Then
curMonth = curMonth - 1
End If
End If
lunarDay = curYear & "/" & curMonth & "/" & curDay
End Function
Private Sub Form_Load()
Text1 = "1962-01-01"
Text2 = ""
End Sub
一个非常简单的倒计时程序,使用一个Timer控件,二个Label控件即可,代码如下:
Dim W As Double, TI As Double, SI As Double, FE As Double, MI As Double
Private Sub Form_Load()
Timer1.Enabled = True
Timer1.Interval = 1000
Label1.Caption = ""
Label3.Caption = ""
W = DateDiff("s", Now, "2011-10-1 00:00:00")
End Sub
Private Sub Timer1_Timer()
Dim SI1 As String, FE1 As String, MI1 As String
W = W - 1
TI = Int(W / 24 / 60 / 60)
SI = Int((W - TI * 24 * 60 * 60) / 60 / 60)
FE = Int((W - TI * 24 * 60 * 60 - SI * 60 * 60) / 60)
MI = W - TI * 24 * 60 * 60 - SI * 60 * 60 - FE * 60
Label1.Caption = CStr(TI) & "天"
If SI < 10 Then
SI1 = "0" & CStr(SI)
Else
SI1 = CStr(SI)
End If
If FE < 10 Then
FE1 = "0" & CStr(FE)
Else
FE1 = CStr(FE)
End If
If MI < 10 Then
MI1 = "0" & CStr(MI)
Else
MI1 = CStr(MI)
End If
Label3.Caption = SI1 & "小时" & FE1 & "分" & MI1 & "秒"
End Sub
什么问题 。
要求是什么?
好的