VB 版 (精华区)

发信人: student (earth), 信区: VB
标  题: 一个小的日历程序
发信站: 哈工大紫丁香 (2001年10月22日17:06:13 星期一), 站内信件

'This code has been developed for EVERYONE'S use
' don't re-distribute this without ALL original files!!
'Phil Jones 1994
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 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") 'do whatever here to pass the date where

                                    'you need it!
End Sub
Private Function determinemonth%()
Dim i%
i% = cbomonth.ListIndex 'which month is selected?
determinemonth% = i% + 1
End Function
Private Function determineyear%()
Dim i%
i% = cboyear.ListIndex 'which year was selected?
If i% = -1 Then Exit Function 'problem!!
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 'put whatever years tyou want here,
    cboyear.AddItem Str$(i%) 'but don't forget to also change the code in se
tdate
Next i%
End Sub
Private Sub Form_Load()
selectedate% = CInt(Format$(Now, "dd"))
'fill month combo box
Call fillcbomonth
'fill year combo box
Call fillcboyear
'put current date and year im combo box
Call setdate
'set current name for day
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%))
'date1$ = Format$(date1$, "general date")
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()
'since the list starts at 1960, this is 0, so we're going
' to get the date, and subtract 1960 from it, and use this
'as our starting listindex
'put whatever value you need to for the first year
'year
Dim r%, i%
r% = CInt(Format$(Now, "yyyy"))
i% = r% - 1960
cboyear.ListIndex = i%
'month
r% = CInt(Format$(Now, "mm"))
cbomonth.ListIndex = (r% - 1)
'day
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

--
※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: student.pact.hit.edu]