📄 leli_frm.frm
字号:
Top = 2760
Width = 495
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "10"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 9
Left = 1800
TabIndex = 16
Top = 2760
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "9"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 8
Left = 1320
TabIndex = 15
Top = 2760
Width = 255
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "8"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 7
Left = 720
TabIndex = 14
Top = 2760
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "7"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 6
Left = 4680
TabIndex = 13
Top = 2040
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "6"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 5
Left = 4080
TabIndex = 12
Top = 2040
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "5"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 4
Left = 3360
TabIndex = 11
Top = 2040
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "4"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 3
Left = 2520
TabIndex = 10
Top = 2040
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "3"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 2
Left = 1920
TabIndex = 9
Top = 2040
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "2"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 375
Index = 1
Left = 1320
TabIndex = 8
Top = 2040
Width = 375
End
Begin VB.Label lblnumber
BackStyle = 0 'Transparent
Caption = "1"
BeginProperty Font
Name = "华文彩云"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFC0C0&
Height = 495
Index = 0
Left = 720
TabIndex = 7
Top = 2040
Width = 375
End
Begin VB.Shape Shape1
BackColor = &H00FFC0C0&
DrawMode = 6 'Mask Pen Not
FillColor = &H00FFC0C0&
Height = 3375
Left = 360
Top = 1800
Width = 4935
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Year"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Index = 1
Left = 480
TabIndex = 4
Top = 1200
Width = 1215
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Month"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Index = 0
Left = 2880
TabIndex = 3
Top = 1200
Width = 1215
End
Begin VB.Label lblday
BackStyle = 0 'Transparent
ForeColor = &H000000FF&
Height = 495
Left = 3960
TabIndex = 2
Top = 480
Width = 1455
End
Begin VB.Label lbldate
BackStyle = 0 'Transparent
ForeColor = &H000000FF&
Height = 495
Left = 2040
TabIndex = 1
Top = 480
Width = 1575
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "今天的日期是："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 360
TabIndex = 0
Top = 480
Width = 1695
End
End
Attribute VB_Name = "leli_frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim selectedate%
Private Sub cbomonth_click()
Call setday
Call lblnumber_click(selectedate% - 1)
End Sub
Private Sub cboyear_Click()
Static once% ' get rid of first click event
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 leli_frm
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 "January"
cbomonth.AddItem "February"
cbomonth.AddItem "March"
cbomonth.AddItem "April"
cbomonth.AddItem "May"
cbomonth.AddItem "June"
cbomonth.AddItem "July"
cbomonth.AddItem "August"
cbomonth.AddItem "September"
cbomonth.AddItem "October"
cbomonth.AddItem "November"
cbomonth.AddItem "December"
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 r%, caption1$
r% = Weekday(Format$(Now, "general date"))
If r% = 1 Then
caption1$ = "Sunday"
ElseIf r% = 2 Then
caption1 = "Monday"
ElseIf r% = 3 Then
caption1 = "Tuesday"
ElseIf r% = 4 Then
caption1 = "Wednesday"
ElseIf r% = 5 Then
caption1 = "Thursday"
ElseIf r% = 6 Then
caption1 = "Friday"
Else
caption1 = "Saturday"
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$ = "Sunday"
ElseIf r% = 2 Then
caption1 = "Monday"
ElseIf r% = 3 Then
caption1 = "Tuesday"
ElseIf r% = 4 Then
caption1 = "Wednesday"
ElseIf r% = 5 Then
caption1 = "Thursday"
ElseIf r% = 6 Then
caption1 = "Friday"
Else
caption1 = "Saturday"
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()
'由于预置时间开始于1960, 对应的Index为0he first year
'年
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 + -