form1.frm

一个自已做的日历,很好用,如果谁能把它再完善一点就再感谢不过了,谢谢谢谢.

      TabIndex        =   21
      Top             =   1320
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "8"
      Height          =   285
      Index           =   7
      Left            =   240
      TabIndex        =   20
      Top             =   1320
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "2"
      Height          =   285
      Index           =   1
      Left            =   600
      TabIndex        =   19
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "3"
      Height          =   285
      Index           =   2
      Left            =   960
      TabIndex        =   18
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "4"
      Height          =   285
      Index           =   3
      Left            =   1320
      TabIndex        =   17
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "5"
      Height          =   285
      Index           =   4
      Left            =   1680
      TabIndex        =   16
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "6"
      Height          =   285
      Index           =   5
      Left            =   2040
      TabIndex        =   15
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "7"
      Height          =   285
      Index           =   6
      Left            =   2400
      TabIndex        =   14
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      BackColor       =   &H008080FF&
      Caption         =   "1"
      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 
      BackColor       =   &H008080FF&
      Caption         =   "年："
      Height          =   255
      Index           =   1
      Left            =   2880
      TabIndex        =   2
      Top             =   120
      Width           =   495
   End
   Begin VB.Label Label1 
      BackColor       =   &H008080FF&
      Caption         =   "月："
      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


Option Explicit
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") '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 "一月"
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 'put whatever years tyou want here,
    cboyear.AddItem Str$(i%) 'but don't forget to also change the code in setdate
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$ = "星期日"
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%))
'date1$ = Format$(date1$, "general date")
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%

'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