📄 form1.frm
字号:
TabIndex = 23
Top = 1320
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "13"
ForeColor = &H80000008&
Height = 285
Index = 12
Left = 2040
TabIndex = 22
Top = 1320
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "14"
ForeColor = &H80000008&
Height = 285
Index = 13
Left = 2400
TabIndex = 21
Top = 1320
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "8"
ForeColor = &H80000008&
Height = 285
Index = 7
Left = 240
TabIndex = 20
Top = 1320
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "2"
ForeColor = &H80000008&
Height = 285
Index = 1
Left = 600
TabIndex = 19
Top = 960
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "3"
ForeColor = &H80000008&
Height = 285
Index = 2
Left = 960
TabIndex = 18
Top = 960
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "4"
ForeColor = &H80000008&
Height = 285
Index = 3
Left = 1320
TabIndex = 17
Top = 960
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "5"
ForeColor = &H80000008&
Height = 285
Index = 4
Left = 1680
TabIndex = 16
Top = 960
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "6"
ForeColor = &H80000008&
Height = 285
Index = 5
Left = 2040
TabIndex = 15
Top = 960
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "7"
ForeColor = &H80000008&
Height = 285
Index = 6
Left = 2400
TabIndex = 14
Top = 960
Width = 300
End
Begin VB.Label lblnumber
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "1"
ForeColor = &H80000008&
Height = 285
Index = 0
Left = 240
TabIndex = 6
Top = 960
Width = 300
End
Begin VB.Shape Shape1
Height = 1935
Left = 120
Top = 840
Width = 2655
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "年份&Y"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 1680
TabIndex = 2
Top = 120
Width = 735
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "月份&M"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 120
TabIndex = 0
Top = 120
Width = 615
End
End
Attribute VB_Name = "frmcalendar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim selectedate%
Private Sub cbomonth_click()
Call setday
Call lblnumber_click(selectedate% - 1)
End Sub
Private Sub cboyear_Click()
Static once% ' 改变年度
If Not once Then
once = True
Exit Sub
End If
Call cbomonth_click
End Sub
Private Sub checkdate(month1%, year1%)
Dim i%, value%, date1$
For i% = 28 To 32
date1$ = (Str$(month1%) + "/" + Str$(i%) + "/" + Str$(year1%))
If IsDate(date1$) Then
value% = i%
Else
Call displaynumbers(value%)
Exit Sub
End If
Next i%
End Sub
Private Sub cmdcancel_Click()
Unload frmcalendar
End Sub
Private Sub cmdok_Click()
Dim month1%, day1%, year1%, date1$
day1% = selectedate%
month1% = cbomonth.ListIndex + 1
year1% = cboyear.ListIndex + 1960
date1$ = (Str$(month1%) + "/" + Str$(day1%) + "/" + Str$(year1%))
date1$ = Format$(date1$, "general date")
MsgBox Format$(date1$, "long date") '显示你选择的日期
End Sub
Private Function determinemonth%()
Dim i%
i% = cbomonth.ListIndex '选择的月份
determinemonth% = i% + 1
End Function
Private Function determineyear%()
Dim i%
i% = cboyear.ListIndex '选择的年度
If i% = -1 Then Exit Function
determineyear% = CInt(Trim(cboyear.List(i%)))
End Function
Private Sub displaynumbers(number%)
Dim i%
For i% = 28 To 30
lblnumber(i%).Visible = False
Next i%
For i% = 28 To number% - 1
lblnumber(i%).Visible = True
Next i%
End Sub
Private Sub fillcbomonth()
cbomonth.AddItem "一月"
cbomonth.AddItem "二月"
cbomonth.AddItem "三月"
cbomonth.AddItem "四月"
cbomonth.AddItem "五月"
cbomonth.AddItem "六月"
cbomonth.AddItem "七月"
cbomonth.AddItem "八月"
cbomonth.AddItem "九月"
cbomonth.AddItem "十月"
cbomonth.AddItem "十一月"
cbomonth.AddItem "十二月"
End Sub
Private Sub fillcboyear()
Dim i%
For i% = 1960 To 2060 '填充年度
cboyear.AddItem Str$(i%)
Next i%
End Sub
Private Sub Form_Load()
selectedate% = CInt(Format$(Now, "dd"))
'填充月份下拉框
Call fillcbomonth
'填充年份下拉框
Call fillcboyear
'设置当前时间
Call setdate
'显示当前是星期几
Dim caption1$
Dim r As Integer
r = WeekDay(Date)
If r = 1 Then
caption1$ = "星期天"
ElseIf r = 2 Then
caption1 = "星期一"
ElseIf r = 3 Then
caption1 = "星期二"
ElseIf r = 4 Then
caption1 = "星期三"
ElseIf r = 5 Then
caption1 = "星期四"
ElseIf r = 6 Then
caption1 = "星期五"
Else
caption1 = "星期六"
End If
lblday.Caption = caption1$
End Sub
Private Sub lblnumber_click(Index As Integer)
Dim i%
On Error GoTo err1
For i% = 0 To 30
lblnumber(i%).BorderStyle = 0
Next i%
If lblnumber(Index).BorderStyle = 1 Then
lblnumber(Index).BorderStyle = 0
Else
lblnumber(Index).BorderStyle = 1
End If
selectedate% = Index + 1
Dim month1%, day1%, year1%, date1$
day1% = selectedate%
month1% = cbomonth.ListIndex + 1
year1% = cboyear.ListIndex + 1960
date1$ = (Str$(month1%) + "/" + Str$(day1%) + "/" + Str$(year1%))
Dim r%
Dim caption1$
r% = WeekDay(date1$)
If r% = 1 Then
caption1$ = "星期天"
ElseIf r% = 2 Then
caption1 = "星期一"
ElseIf r% = 3 Then
caption1 = "星期二"
ElseIf r% = 4 Then
caption1 = "星期三"
ElseIf r% = 5 Then
caption1 = "星期四"
ElseIf r% = 6 Then
caption1 = "星期五"
Else
caption1 = "星期六"
End If
lblday.Caption = caption1$
lbldate.Caption = Format$(date1$, "long date")
err1:
If Err = 0 Then Exit Sub
If Err = 13 Then
selectedate% = selectedate% - 1
Exit Sub
End If
End Sub
Private Sub setdate()
'年份
Dim r%, i%
r% = CInt(Format$(Now, "yyyy"))
i% = r% - 1960
cboyear.ListIndex = i%
'月份
r% = CInt(Format$(Now, "mm"))
cbomonth.ListIndex = (r% - 1)
'日期
r% = CInt(Format$(Now, "dd"))
lblnumber(r% - 1).BorderStyle = 1
selectedate% = r%
End Sub
Private Sub setday()
Dim month1%, year1%
month1% = determinemonth()
year1% = determineyear()
Call checkdate(month1%, year1%)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -