📄 date.frm
字号:
BackColor = &H80000009&
Caption = "16"
Height = 255
Index = 21
Left = 3720
TabIndex = 23
Top = 1200
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "17"
Height = 255
Index = 22
Left = 120
TabIndex = 22
Top = 1440
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "18"
Height = 255
Index = 23
Left = 720
TabIndex = 21
Top = 1440
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "19"
Height = 255
Index = 24
Left = 1320
TabIndex = 20
Top = 1440
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "20"
Height = 255
Index = 25
Left = 1920
TabIndex = 19
Top = 1440
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "21"
Height = 255
Index = 26
Left = 2520
TabIndex = 18
Top = 1440
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "22"
Height = 255
Index = 27
Left = 3120
TabIndex = 17
Top = 1440
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "23"
Height = 255
Index = 28
Left = 3720
TabIndex = 16
Top = 1440
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "24"
Height = 255
Index = 29
Left = 120
TabIndex = 15
Top = 1680
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "25"
Height = 255
Index = 30
Left = 720
TabIndex = 14
Top = 1680
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "26"
Height = 255
Index = 31
Left = 1320
TabIndex = 13
Top = 1680
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "27"
Height = 255
Index = 32
Left = 1920
TabIndex = 12
Top = 1680
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "28"
Height = 255
Index = 33
Left = 2520
TabIndex = 11
Top = 1680
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "29"
Height = 255
Index = 34
Left = 3120
TabIndex = 10
Top = 1680
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H8000000B&
Caption = "30"
Height = 255
Index = 35
Left = 3720
TabIndex = 9
Top = 1680
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Height = 255
Index = 42
Left = 3720
TabIndex = 8
Top = 1920
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Caption = "31"
Height = 255
Index = 36
Left = 120
TabIndex = 7
Top = 1920
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Height = 255
Index = 37
Left = 720
TabIndex = 6
Top = 1920
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Height = 255
Index = 38
Left = 1320
TabIndex = 5
Top = 1920
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Height = 255
Index = 39
Left = 1920
TabIndex = 4
Top = 1920
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Height = 255
Index = 40
Left = 2520
TabIndex = 3
Top = 1920
Width = 540
End
Begin VB.Label labDay
Alignment = 2 'Center
BackColor = &H80000009&
Height = 255
Index = 41
Left = 3120
TabIndex = 2
Top = 1920
Width = 540
End
Begin VB.Line Line2
BorderColor = &H80000009&
X1 = 120
X2 = 120
Y1 = 0
Y2 = 2640
End
Begin VB.Line Line3
BorderColor = &H80000009&
X1 = 4320
X2 = 120
Y1 = 0
Y2 = 0
End
Begin VB.Line Line4
BorderColor = &H80000009&
X1 = 4320
X2 = 4320
Y1 = 2640
Y2 = 0
End
Begin VB.Line Line5
BorderColor = &H80000009&
X1 = 120
X2 = 4440
Y1 = 2640
Y2 = 2640
End
Begin VB.Label Label2
Height = 495
Left = 120
TabIndex = 53
Top = 0
Width = 4215
End
End
Attribute VB_Name = "frmDate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdNext_Click()
iMonth = iMonth + 1
If iMonth > 12 Then
iYear = iYear + 1
iMonth = iMonth - 12
End If
lblDate.Caption = iYear & "年" & iMonth & "月"
SetDay SetWeekStart(iYear & "-" & iMonth)
End Sub
Private Sub cmdPre_Click()
On Error GoTo Err_Trap
iMonth = iMonth - 1
If iMonth < 1 Then
iYear = iYear - 1
iMonth = 12
End If
lblDate.Caption = iYear & "年" & iMonth & "月"
SetDay SetWeekStart(iYear & "-" & iMonth)
Exit Sub
Err_Trap:
iMonth = iMonth
End Sub
Private Sub Command1_Click()
Dim str As String
Dim i As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\" & "05003104.txt", True)
str = ""
str = str & Space(5) & lblDate.Caption & vbCrLf
str = str & " 一 二 三 四 五 六 日" & vbCrLf
For i = 1 To 42
If labDay(i).Visible = True Then
If i Mod 7 = 0 Then
If Len(labDay(i).Caption) < 2 Then
str = str & " " & labDay(i).Caption & vbCrLf
Else
str = str & " " & labDay(i).Caption & vbCrLf
End If
Else
If Len(labDay(i).Caption) < 2 Then
str = str & " " & labDay(i).Caption
Else
str = str & " " & labDay(i).Caption
End If
End If
Else
str = str & Space(3)
End If
Next i
str = str & vbCrLf
str = str & lblNow.Caption & vbCrLf
str = str & lblTime.Caption
a.WriteLine (str)
a.Close
End Sub
Private Sub Form_Load()
Dim iWeekDay As Integer
Dim dTime As Date
On Error GoTo Err_Trap
iYear = Left(Date, 4)
iMonth = Mid(Date, 6, (InStr(6, Date, "-") - InStr(1, Date, "-") - 1))
iSet = Day(Date)
lblDate.Caption = iYear & "年" & iMonth & "月"
lblNow.Caption = "今天日期是：" & Left(Date, 4) & "年" & Mid(Date, 6, (InStr(6, Date, "-") - InStr(1, Date, "-") - 1)) & "月" & Day(Date) & "日"
dateSelect = Date
iWeekDay = SetWeekStart(Date)
SetDay iWeekDay
Exit Sub
Err_Trap:
End Sub
Private Sub labday_Click(Index As Integer)
Dim i As Integer
iSet = CInt(labDay(Index).Caption)
For i = 1 To 42
If i = Index Then
labDay(i).BackColor = &H8000000A
Else
labDay(i).BackColor = &H80000009
End If
Next i
sWeek = SelectWeekNow
End Sub
Private Sub SetDay(iDays As Integer)
Dim i As Integer
Dim IsetWeek As Integer
Dim bolSetBC As Boolean
bolSetBC = False
IsetWeek = CountDay(iYear, iMonth)
For i = 1 To 42
If i >= iDays And i < IsetWeek + iDays Then
labDay(i).Visible = True
labDay(i).Caption = i - iDays + 1
Else
labDay(i).Visible = False
End If
If (i - iDays + 1) = iSet And iSet <= IsetWeek Then
labDay(i).BackColor = &H8000000A
iSet = i - iDays + 1
bolSetBC = True
Else
labDay(i).BackColor = &H80000009
End If
Next i
If bolSetBC = False Then
labDay(IsetWeek + iDays - 1).BackColor = &H8000000A
iSet = IsetWeek
bolSetBC = True
End If
sWeek = SelectWeekNow
End Sub
Private Function SelectWeekNow() As String
Select Case Weekday(iYear & "-" & iMonth & "-" & iSet)
Case 1
SelectWeekNow = "星期日"
Case 2
SelectWeekNow = "星期一"
Case 3
SelectWeekNow = "星期二"
Case 4
SelectWeekNow = "星期三"
Case 5
SelectWeekNow = "星期四"
Case 6
SelectWeekNow = "星期五"
Case 7
SelectWeekNow = "星期六"
Case Else
SelectWeekNow = ""
End Select
End Function
Private Sub Timer1_Timer()
lblTime.Caption = "当前时间是：" & Time
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -