form1.frm

这里有很多很实用的VB编程案例,方便大家学习VB.

      Left            =   2040
      TabIndex        =   20
      Top             =   1320
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "14"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   13
      Left            =   2400
      TabIndex        =   19
      Top             =   1320
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "8"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   7
      Left            =   240
      TabIndex        =   18
      Top             =   1320
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "2"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   1
      Left            =   600
      TabIndex        =   17
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "3"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   2
      Left            =   960
      TabIndex        =   16
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "4"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   3
      Left            =   1320
      TabIndex        =   15
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "5"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   4
      Left            =   1680
      TabIndex        =   14
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "6"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   5
      Left            =   2040
      TabIndex        =   13
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "7"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   6
      Left            =   2400
      TabIndex        =   12
      Top             =   960
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Caption         =   "1"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   0
      Left            =   240
      TabIndex        =   4
      Top             =   960
      Width           =   300
   End
   Begin VB.Shape Shape1 
      Height          =   1935
      Left            =   120
      Top             =   840
      Width           =   2655
   End
   Begin VB.Label Label1 
      Caption         =   "&Year"
      Height          =   255
      Index           =   1
      Left            =   2880
      TabIndex        =   2
      Top             =   120
      Width           =   495
   End
   Begin VB.Label Label1 
      Caption         =   "&Month"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim selectedate%
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
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 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()
    Dim r%, caption1$
    selectedate% = CInt(Format$(Now, "dd"))
    Call fillcbomonth
    Call fillcboyear
    Call setdate

    r% = Weekday(Format$(Now, "general date"))
    Select Case r%
    Case 1
        caption1$ = "Sunday"
    Case 2
        caption1 = "Monday"
    Case 3
        caption1 = "Tuesday"
    Case 4
        caption1 = "Wednesday"
    Case 5
        caption1 = "Thursday"
    Case 6
        caption1 = "Friday"
    Case Else
        caption1 = "Saturday"
    End Select
    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$)
Select Case r%
Case 1
    caption1$ = "Sunday"
Case 2
    caption1 = "Monday"
Case 3
    caption1 = "Tuesday"
Case 4
    caption1 = "Wednesday"
Case 5
    caption1 = "Thursday"
Case 6
    caption1 = "Friday"
Case Else
    caption1 = "Saturday"
End Select
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