📄 form1.frm
字号:
TabIndex = 17
Top = 1680
Width = 975
End
Begin VB.Label LblDay
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
ForeColor = &H00FF00FF&
Height = 975
Index = 6
Left = 6600
TabIndex = 16
Top = 600
Width = 975
End
Begin VB.Label LblDay
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 975
Index = 5
Left = 5520
TabIndex = 15
Top = 600
Width = 975
End
Begin VB.Label LblDay
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 975
Index = 4
Left = 4440
TabIndex = 14
Top = 600
Width = 975
End
Begin VB.Label LblDay
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 975
Index = 3
Left = 3360
TabIndex = 13
Top = 600
Width = 975
End
Begin VB.Label LblDay
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 975
Index = 2
Left = 2280
TabIndex = 12
Top = 600
Width = 975
End
Begin VB.Label LblDay
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 975
Index = 1
Left = 1200
TabIndex = 11
Top = 600
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "星期六"
BeginProperty Font
Name = "汉仪长宋简"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 240
Index = 6
Left = 6720
TabIndex = 10
Top = 120
Width = 720
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "星期五"
BeginProperty Font
Name = "汉仪长宋简"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Index = 5
Left = 5640
TabIndex = 9
Top = 120
Width = 720
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "星期四"
BeginProperty Font
Name = "汉仪长宋简"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Index = 4
Left = 4560
TabIndex = 8
Top = 120
Width = 720
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "星期三"
BeginProperty Font
Name = "汉仪长宋简"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Index = 3
Left = 3480
TabIndex = 7
Top = 120
Width = 720
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "星期二"
BeginProperty Font
Name = "汉仪长宋简"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Index = 2
Left = 2400
TabIndex = 6
Top = 120
Width = 720
End
Begin VB.Label Label1
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "星期一"
BeginProperty Font
Name = "汉仪长宋简"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 240
Index = 1
Left = 1320
TabIndex = 5
Top = 120
Width = 720
End
Begin VB.Label LblWeek
Alignment = 2 'Center
AutoSize = -1 'True
Caption = "星期天"
BeginProperty Font
Name = "汉仪长宋简"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 240
Index = 0
Left = 240
TabIndex = 2
Top = 120
Width = 720
End
Begin VB.Label LblDay
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
ForeColor = &H000000FF&
Height = 975
Index = 0
Left = 120
TabIndex = 1
Top = 600
Width = 975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'判断第一天是星期几的变量
Dim NowWeekDay As Integer
Dim NowDate As String
'显示年,月,日的变量
Dim YearNow As Integer
Dim MonthNow As Integer
Dim DayNow As Integer
Dim Index As Integer
'判断月份是大月,小月,二月的变量
Dim DaYue As Boolean
Dim XiaoYue As Boolean
Dim ErYue As Boolean
Dim RunErYue As Boolean
'显示农历的变量
Dim ChineseDate As String
Dim ChineseGanZhi As String
Dim ChineseAnimal As String
Dim ChineseSolarTerm As String
'点击天数列表框后,右边显示相应的国、农历
Private Sub ComDay_Click()
Call UserClick
End Sub
'点击月份列表框后,天数标签显示相应年份和的天数,右边显示相应的国、农历
Private Sub ComMonth_Click()
'先清空天数列表,在重新添加新月份的天数
ComDay.Clear
ComDay.Text = Day(Date)
'清空所有显示和颜色,重新显示新月份的天数和位置,以及号数的颜色
For Index = 0 To 41
LblDay(Index) = ""
LblDay(Index).BackStyle = 0
LblDay(Index).BackColor = &H8000000F
Next Index
Call ClickErYue
Call JianChaYueFen
Call UserClick
End Sub
'点击年份列表框后,天数标签显示相应年份和的天数,右边显示相应的国、农历
Private Sub ComYear_Click()
For Index = 0 To 41
LblDay(Index) = ""
LblDay(Index).BackStyle = 0
LblDay(Index).BackColor = &H8000000F
Next Index
Call JianChaYueFen
Call UserClick
End Sub
Private Sub Form_Load()
Me.Show
LblTime.Caption = "当前时间:" & Time
ComDay.SetFocus
ComYear.Text = Year(Date)
ComMonth.Text = Month(Date)
ComDay.Text = Day(Date)
'标准时间
LblDate(0).Left = (FrDate(0).Width - LblDate(0).Width) / 2
LblDate(0).Caption = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日"
LblDate(1).Left = (FrDate(1).Width - LblDate(1).Width) / 2
ChinaDate.DateNow = CDate(Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日")
ChineseDate = ChinaDate.ChineseDate
ChineseGanZhi = ChinaDate.ChineseGanZhi
ChineseSolarTerm = ChinaDate.ChineseSolarTerm
ChineseAnimal = ChinaDate.ChineseAnimal
LblDate(1).Caption = ChineseDate & vbCrLf & ChineseGanZhi & vbCrLf & "(" & ChineseAnimal & ")" & vbCrLf & ChineseSolarTerm
'用户选择的时间
LblDate(2).Left = (FrDate(2).Width - LblDate(2).Width) / 2
LblDate(2).Caption = ""
LblDate(3).Left = (FrDate(3).Width - LblDate(3).Width) / 2
LblDate(3).Caption = ""
'在年份列表中显示1920-2031年的年份
For YearNow = 1920 To 2031
ComYear.AddItem YearNow
Next YearNow
'在月份列表中显示1-12月的月份
For MonthNow = 1 To 12
ComMonth.AddItem MonthNow
Next MonthNow
Call JianChaYueFen
End Sub
'大月显示的天数,先判断第一天是星期几,再在相应的星期中显示第一天
Sub YueFenDaYue()
NowDate = ComYear.Text & "-" & ComMonth.Text & "-1"
NowWeekDay = Weekday(NowDate)
Select Case NowWeekDay
Case vbSunday
For DayNow = 0 To 30
Call SundayNow
Next DayNow
Case vbMonday
For DayNow = 1 To 31
Call MondayNow
Next DayNow
Case vbTuesday
For DayNow = 2 To 32
Call TuesdayNow
Next DayNow
Case vbWednesday
For DayNow = 3 To 33
Call WednesdayNow
Next DayNow
Case vbThursday
For DayNow = 4 To 34
Call ThursdayNow
Next DayNow
Case vbFriday
For DayNow = 5 To 35
Call FridayNow
Next DayNow
Case vbSaturday
For DayNow = 6 To 36
Call SaturdayNow
Next DayNow
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -