VERSION 5.00
Begin VB.Form Form2
Caption = "万年历"
ClientHeight = 7035
ClientLeft = 4485
ClientTop = 3675
ClientWidth = 8025
LinkTopic = "Form2"
MaxButton = 0 'False
ScaleHeight = 7035
ScaleWidth = 8025
Begin VB.Frame Frame1
Caption = "检索"
Height = 735
Left = 1200
TabIndex = 23
Top = 4920
Width = 5055
Begin VB.CommandButton Command5
Caption = "确定"
Height = 375
Left = 4320
TabIndex = 25
Top = 240
Width = 615
End
Begin VB.TextBox Text4
Height = 375
Left = 120
TabIndex = 24
Top = 240
Width = 4095
End
End
Begin VB.PictureBox Picture1
Height = 3735
Left = 1200
ScaleHeight = 3675
ScaleWidth = 4995
TabIndex = 11
Top = 1080
Width = 5055
Begin VB.Label Label16
AutoSize = -1 'True
Caption = " "
ForeColor = &H8000000D&
Height = 180
Index = 0
Left = 350
TabIndex = 26
Top = 1000
Width = 90
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = " "
ForeColor = &H000000C0&
Height = 255
Index = 0
Left = 480
TabIndex = 21
Top = 740
Width = 90
End
Begin VB.Label Label12
Caption = "六"
Height = 255
Left = 4560
TabIndex = 19
Top = 240
Width = 255
End
Begin VB.Label Label11
Caption = "五"
Height = 255
Left = 3840
TabIndex = 18
Top = 240
Width = 255
End
Begin VB.Label Label9
Caption = "四"
Height = 255
Left = 3120
TabIndex = 17
Top = 240
Width = 255
End
Begin VB.Label Label10
Caption = "Label10"
Height = 15
Left = 2520
TabIndex = 16
Top = 600
Width = 375
End
Begin VB.Label Label8
Caption = "三"
Height = 255
Left = 2400
TabIndex = 15
Top = 240
Width = 255
End
Begin VB.Label Label7
Caption = "二"
Height = 255
Left = 1680
TabIndex = 14
Top = 240
Width = 255
End
Begin VB.Label Label6
Caption = "一"
Height = 255
Left = 960
TabIndex = 13
Top = 240
Width = 255
End
Begin VB.Label Label5
Caption = "日"
Height = 255
Left = 240
TabIndex = 12
Top = 240
Width = 255
End
Begin VB.Line Line1
X1 = 7440
X2 = 7440
Y1 = 3000
Y2 = 0
End
Begin VB.Line Line2
X1 = 0
X2 = 7440
Y1 = 0
Y2 = 0
End
Begin VB.Line Line3
X1 = 0
X2 = 5160
Y1 = 720
Y2 = 720
End
Begin VB.Line Line4
X1 = 0
X2 = 5160
Y1 = 1200
Y2 = 1200
End
Begin VB.Line Line5
X1 = 0
X2 = 5160
Y1 = 1680
Y2 = 1680
End
Begin VB.Line Line6
X1 = 0
X2 = 5160
Y1 = 2160
Y2 = 2160
End
Begin VB.Line Line7
X1 = 0
X2 = 5160
Y1 = 2640
Y2 = 2640
End
Begin VB.Line Line8
X1 = 0
X2 = 5160
Y1 = 3120
Y2 = 3120
End
Begin VB.Line Line9
X1 = 0
X2 = 5160
Y1 = 3600
Y2 = 3600
End
Begin VB.Line Line10
X1 = 720
X2 = 720
Y1 = 0
Y2 = 3600
End
Begin VB.Line Line11
X1 = 1440
X2 = 1440
Y1 = 0
Y2 = 3600
End
Begin VB.Line Line12
X1 = 2160
X2 = 2160
Y1 = 0
Y2 = 3600
End
Begin VB.Line Line13
X1 = 2880
X2 = 2880
Y1 = 0
Y2 = 3600
End
Begin VB.Line Line14
X1 = 3600
X2 = 3600
Y1 = 0
Y2 = 3600
End
Begin VB.Line Line15
X1 = 4320
X2 = 4320
Y1 = 0
Y2 = 3600
End
Begin VB.Label Label13
Height = 255
Index = 0
Left = 120
TabIndex = 20
Top = 720
Width = 255
End
Begin VB.Label Label15
AutoSize = -1 'True
Height = 180
Index = 0
Left = 0
TabIndex = 22
Top = 1020
Width = 90
End
End
Begin VB.Timer Timer1
Interval = 1000
Left = 7440
Top = 480
End
Begin VB.CommandButton Command4
Caption = "退出"
Height = 735
Left = 6360
TabIndex = 10
Top = 6120
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "今天"
Height = 495
Left = 120
TabIndex = 9
Top = 240
Width = 615
End
Begin VB.CommandButton Command2
Caption = ">"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5760
TabIndex = 7
Top = 240
Width = 495
End
Begin VB.CommandButton Command1
Caption = "<"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 960
TabIndex = 6
Top = 240
Width = 495
End
Begin VB.TextBox Text3
Enabled = 0 'False
Height = 375
Left = 4560
TabIndex = 2
Top = 360
Width = 495
End
Begin VB.TextBox Text2
Enabled = 0 'False
Height = 375
Left = 3240
TabIndex = 1
Top = 360
Width = 495
End
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 375
Left = 2040
TabIndex = 0
Top = 360
Width = 615
End
Begin VB.Label Label4
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 240
TabIndex = 8
Top = 6120
Width = 3375
End
Begin VB.Label Label3
Caption = "日"
Height = 375
Left = 5280
TabIndex = 5
Top = 480
Width = 375
End
Begin VB.Label Label2
Caption = "月"
Height = 375
Left = 4080
TabIndex = 4
Top = 480
Width = 375
End
Begin VB.Label Label1
Caption = "年"
Height = 375
Left = 2760
TabIndex = 3
Top = 480
Width = 375
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim datey As Date, m As Date
Dim i As Integer, j As Integer, x As Integer, k As Integer
Dim Li19000101 As Long
j = 1
Text2.Text = Right("0" & Val(Text2.Text - 1), 2)
If Text2.Text = 0 Then
Text2.Text = 12
Text1.Text = Text1.Text - 1
End If
datey = DateSerial(Val(Text1.Text), Val(Text2.Text), 1)
k = Weekday(datey) - 1 'k
m = DateAdd("m", 1, datey)
x = DateDiff("d", datey, m) 'X
Li19000101 = DateDiff("d", 1900 - 1 - 1#, datey) Mod 6
Now1 = DateAdd("h", 8, Now)
If Val(Text1.Text) = Year(Now1) And Val(Text2.Text) = Month(Now1) Then
For i = 0 To 41
Label15(i).Caption = " "
Label16(i).Caption = " "
If i >= k And j <= x Then
Label13(i).Caption = j
Label14(i).Caption = "休"
Label14(i).ForeColor = &HC000&
If Li19000101 = 0 Or Li19000101 = 5 Then
Label14(i).Caption = "全"
Label14(i).ForeColor = &HC0&
End If
Label15(i).Caption = "●"
Label15(i).ForeColor = &HC0C0C0
If Trim(读日志(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label15(i).ForeColor = &HC0C0&
Label15(i).ToolTipText = Trim(读日志(Text1 & Text2, Str(i)))
End If
If Trim(读农历(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label16(i).Caption = Trim(读农历(Text1 & Text2, Str(i)))
End If
If j = Day(Now1) Then
Label13(i).Font.Underline = True
End If
j = j + 1
Li19000101 = (Li19000101 + 1) Mod 6
Else
Label13(i).Caption = " "
Label14(i).Caption = " "
Label15(i).Caption = " "
Label16(i).Caption = " "
End If
Next i
Else
For i = 0 To 41
Label14(i).Caption = ""
Label15(i).Caption = " "
Label16(i).Caption = " "
If i >= k And j <= x Then
If Trim(读日志(Text1 & Text2, "偏移")) = "" Then
写日志 Text1 & Text2, "偏移", Str(i - 1)
End If
Label13(i).Caption = j
Label14(i).Caption = "休"
Label14(i).ForeColor = &HC000&
If Li19000101 = 0 Or Li19000101 = 5 Then
Label14(i).Caption = "全"
Label14(i).ForeColor = &HC0&
End If
Label15(i).Caption = "●"
Label15(i).ForeColor = &HC0C0C0
If Trim(读日志(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label15(i).ForeColor = &HC0C0&
Label15(i).ToolTipText = Trim(读日志(Text1 & Text2, Str(i)))
End If
If Trim(读农历(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label16(i).Caption = Trim(读农历(Text1 & Text2, Str(i)))
End If
Label13(i).Font.Underline = False
j = j + 1
Li19000101 = (Li19000101 + 1) Mod 6
Else
Label13(i).Caption = " "
Label14(i).Caption = " "
Label15(i).Caption = " "
Label16(i).Caption = " "
End If
Next i
End If
End Sub
Private Sub Command2_Click()
Dim datey As Date, m As Date
Dim i As Integer, j As Integer, x As Integer, k As Integer
Dim Li19000101 As Long
j = 1
Text2.Text = Right("0" & Val(Text2.Text + 1), 2)
If Text2.Text = 12 Then
Text2.Text = 0 + 1
Text1.Text = Text1.Text + 1
End If
If Len(Text2.Text) = 1 Then Text2 = "0" & Text2
datey = DateSerial(Val(Text1.Text), Val(Text2.Text), 1)
k = Weekday(datey) - 1 'k
m = DateAdd("m", 1, datey)
x = DateDiff("d", datey, m) 'X
Li19000101 = DateDiff("d", 1900 - 1 - 1#, datey) Mod 6
Now1 = DateAdd("h", 8, Now)
If Val(Text1.Text) = Year(Now1) And Val(Text2.Text) = Month(Now1) Then
For i = 0 To 41
Label15(i).Caption = " "
Label16(i).Caption = " "
If i >= k And j <= x Then
Label13(i).Caption = j
Label14(i).Caption = "休"
Label14(i).ForeColor = &HC000&
If Li19000101 = 0 Or Li19000101 = 5 Then
Label14(i).Caption = "全"
Label14(i).ForeColor = &HC0&
End If
Label15(i).Caption = "●"
Label15(i).ForeColor = &HC0C0C0
If Trim(读日志(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label15(i).ForeColor = &HC0C0&
Label15(i).ToolTipText = Trim(读日志(Text1 & Text2, Str(i)))
End If
If Trim(读农历(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label16(i).Caption = Trim(读农历(Text1 & Text2, Str(i)))
End If
If j = Day(Now1) Then
Label13(i).Font.Underline = True
End If
j = j + 1
Li19000101 = (Li19000101 + 1) Mod 6
Else
Label13(i).Caption = " "
Label14(i).Caption = " "
Label15(i).Caption = " "
Label16(i).Caption = " "
End If
Next i
Else
For i = 0 To 41
Label14(i).Caption = ""
Label15(i).Caption = " "
Label16(i).Caption = " "
If i >= k And j <= x Then
If Trim(读日志(Text1 & Text2, "偏移")) = "" Then
写日志 Text1 & Text2, "偏移", Str(i - 1)
End If
Label13(i).Caption = j
Label14(i).Caption = "休"
Label14(i).ForeColor = &HC000&
If Li19000101 = 0 Or Li19000101 = 5 Then
Label14(i).Caption = "全"
Label14(i).ForeColor = &HC0&
End If
Label15(i).Caption = "●"
Label15(i).ForeColor = &HC0C0C0
If Trim(读日志(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label15(i).ForeColor = &HC0C0&
Label15(i).ToolTipText = Trim(读日志(Text1 & Text2, Str(i)))
End If
If Trim(读农历(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label16(i).Caption = Trim(读农历(Text1 & Text2, Str(i)))
End If
Label13(i).Font.Underline = False
j = j + 1
Li19000101 = (Li19000101 + 1) Mod 6
Else
Label13(i).Caption = " "
Label14(i).Caption = " "
Label15(i).Caption = " "
Label16(i).Caption = " "
End If
Next i
End If
End Sub
Private Sub Command3_Click()
Dim datey As Date, m As Date
Dim i As Integer, j As Integer, x As Integer, k As Integer
j = 1
Now1 = DateAdd("h", 8, Now)
Label4.Caption = Now1
Text1.Text = Year(Now1)
Text2.Text = Month(Now1)
If Len(Text2) = 1 Then Text2 = "0" & Text2
Text3.Text = Day(Now1)
If Len(Text3) = 1 Then Text3 = "0" & Text3
datey = DateSerial(Val(Text1.Text), Val(Text2.Text), 1)
k = Weekday(datey) - 1 'k
m = DateAdd("m", 1, datey)
x = DateDiff("d", datey, m) 'X
For i = 0 To 41
If i >= k And j <= x Then
Label13(i).Caption = j
j = j + 1
Else
Label13(i).Caption = " "
End If
Next i
End Sub
Private Sub Command4_Click()
End
End Sub
Private Sub Command5_Click()
'对1900年至2100年之间所有日期的项取值，
'对取到的值与文本框4比较，如果包括则给出日期
Dim y As Integer
Dim m As Integer
Dim d As Integer
Dim i As Integer
Dim ss As String
If Len(Trim(Text4)) = 0 Then
MsgBox "检索内容为空，无法查找"
Exit Sub
End If
For y = 2020 To 2025
For m = 1 To 12
Dim mm As String
If m < 10 Then
mm = "0" & m
Else
mm = m
End If
If Trim(读日志(Trim(Str(y)) & mm, "偏移")) = "" Then
'如果没有偏移信息则什么也不做
Else
i = Val(Trim(读日志(Trim(Str(y)) & mm, "偏移")))
For d = 0 To 41
Dim s As String
Dim c As Integer
s = Trim(读日志(Str(y) & mm, Trim(Str(d))))
c = InStr(s, Trim(Text4))
If c > 0 Then
ss = ss & y & "年" & (mm) & "月" & (d - i) & "日:" & s & vbCrLf
End If
Next
End If
Next
Next
If ss <> "" Then MsgBox ss, , "结果" Else MsgBox "没有符合的内容", , "结果"
Text4 = ""
End Sub
Private Sub Form_Load()
Dim m As String
Dim datex As Date
Dim i As Integer, j As Integer, x As Integer
Dim Li19000101 As Long
j = 1
Me.Show
Now1 = DateAdd("h", 8, Now)
Label4.Caption = Now1
Text1.Text = Year(Now1)
Text2.Text = Right("0" & Month(Now1), 2)
Text3.Text = Right("0" & Day(Now1), 2)
datex = Date - Day(Now1) + 1
k = Weekday(datex) - 1 'k
m = DateAdd("m", 1, datex)
x = DateDiff("d", datex, m) 'X 算出当前月有多少天
Li19000101 = DateDiff("d", 1900 - 1 - 1#, datex) Mod 6
For i = 1 To 41
'13标签
Load Label13(i)
Label13(i).Left = (i Mod 7) * 720 + 40
Label13(i).Top = (i \ 7) * 480 + 750
Label13(i).Caption = ""
Label13(i).Visible = True
'14标签
Load Label14(i)
Label14(i).Left = (i Mod 7) * 720 + 440
Label14(i).Top = (i \ 7) * 480 + 750
Label14(i).Caption = ""
Label14(i).Visible = True
'15标签
Load Label15(i)
Label15(i).Left = (i Mod 7) * 720 + 40
Label15(i).Top = (i \ 7) * 480 + 1000
Label15(i).Caption = ""
Label15(i).Visible = True
'16标签
Load Label16(i)
Label16(i).Left = (i Mod 7) * 720 + 320
Label16(i).Top = (i \ 7) * 480 + 1000
Label16(i).Caption = " "
Label16(i).Visible = True
Next i
y = Day(Now1)
For i = 0 To 41
If i >= k And j <= x Then
If Trim(读日志(Text1 & Text2, "偏移")) = "" Then
写日志 Text1 & Text2, "偏移", Str(i - 1)
End If
Label13(i).Caption = j
Label14(i).Caption = "休"
Label14(i).ForeColor = &HC000&
If Li19000101 = 0 Or Li19000101 = 5 Then
Label14(i).Caption = "全"
Label14(i).ForeColor = &HC0&
End If
Label15(i).Caption = "●"
Label15(i).ForeColor = &HC0C0C0
If Trim(读日志(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label15(i).ForeColor = &HC0C0&
Label15(i).ToolTipText = Trim(读日志(Text1 & Text2, Str(i)))
End If
If Trim(读农历(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label16(i).Caption = Trim(读农历(Text1 & Text2, Str(i)))
End If
If j = Day(Now1) Then
Label13(i).Font.Underline = True
End If
j = j + 1
Li19000101 = (Li19000101 + 1) Mod 6
End If
Next i
End Sub
Private Sub Label15_Click(Index As Integer)
Dim 年月 As String, 值 As String, s As String
年月 = Text1 & Text2
If Trim(读日志(年月, Str(Index))) <> "" Then '说明有内容
s = Trim(读日志(年月, Str(Index)))
值 = InputBox("请输入日志内容", "日志信息", s)
Else
值 = InputBox("请输入日志内容", "", "")
End If
If 值 = "" Then Exit Sub
If 值 = " " Then
值 = ""
Label15(Index).ToolTipText = ""
End If
写日志 年月, Str(Index), 值
刷新
End Sub
Private Sub Label16_dblClick(Index As Integer)
Dim 年月 As String, 值 As String, s As String
年月 = Text1 & Text2
If Trim(读农历(年月, Str(Index))) <> "" Then '说明有内容
s = Trim(读农历(年月, Str(Index)))
值 = InputBox("请输入农历内容", "农历信息", s)
Else
值 = InputBox("请输入农历内容", "", "")
End If
If 值 = "" Then Exit Sub
If 值 = " " Then
值 = ""
End If
写农历 年月, Str(Index), 值
刷新
End Sub
Private Sub Timer1_Timer()
Now1 = DateAdd("h", 8, Now)
Label4.Caption = Now1
End Sub
Private Sub 刷新()
Dim datey As Date, m As Date
Dim i As Integer, j As Integer, x As Integer, k As Integer
Dim Li19000101 As Long
j = 1
If Len(Text2.Text) = 1 Then Text2 = "0" & Text2
datey = DateSerial(Val(Text1.Text), Val(Text2.Text), 1)
k = Weekday(datey) - 1 'k
m = DateAdd("m", 1, datey)
x = DateDiff("d", datey, m) 'X
Li19000101 = DateDiff("d", 1900 - 1 - 1#, datey) Mod 6
Now1 = DateAdd("h", 8, Now)
If Val(Text1.Text) = Year(Now1) And Val(Text2.Text) = Month(Now1) Then
For i = 0 To 41
If i >= k And j <= x Then
Label13(i).Caption = j
Label14(i).Caption = "休"
Label14(i).ForeColor = &HC000&
If Li19000101 = 0 Or Li19000101 = 5 Then
Label14(i).Caption = "全"
Label14(i).ForeColor = &HC0&
End If
Label15(i).Caption = "●"
Label15(i).ForeColor = &HC0C0C0
If Trim(读日志(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label15(i).ForeColor = &HC0C0&
Label15(i).ToolTipText = Trim(读日志(Text1 & Text2, Str(i)))
End If
If Trim(读农历(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label16(i).Caption = Trim(读农历(Text1 & Text2, Str(i)))
End If
If j = Day(Now1) Then
Label13(i).Font.Underline = True
End If
j = j + 1
Li19000101 = (Li19000101 + 1) Mod 6
Else
Label13(i).Caption = " "
Label14(i).Caption = " "
End If
Next i
Else
For i = 0 To 41
Label14(i).Caption = ""
If i >= k And j <= x Then
Label13(i).Caption = j
Label14(i).Caption = "休"
Label14(i).ForeColor = &HC000&
If Li19000101 = 0 Or Li19000101 = 5 Then
Label14(i).Caption = "全"
Label14(i).ForeColor = &HC0&
End If
Label15(i).Caption = "●"
Label15(i).ForeColor = &HC0C0C0
If Trim(读日志(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label15(i).ForeColor = &HC0C0&
Label15(i).ToolTipText = Trim(读日志(Text1 & Text2, Str(i)))
End If
If Trim(读农历(Text1 & Text2, Str(i))) <> "" Then '说明有内容
Label16(i).Caption = Trim(读农历(Text1 & Text2, Str(i)))
End If
Label13(i).Font.Underline = False
j = j + 1
Li19000101 = (Li19000101 + 1) Mod 6
Else
Label13(i).Caption = " "
Label14(i).Caption = " "
Label15(i).Caption = " "
End If
Next i
End If
End Sub
vb 万年历 代码
猜你喜欢
转载自blog.csdn.net/laocooon/article/details/120177132
今日推荐
周排行