frmcalborn.frm

学院MIS管理系统,适合大部分毕业生,请大家支持

      Height          =   285
      Index           =   16
      Left            =   960
      TabIndex        =   11
      Top             =   1560
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "16"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   15
      Left            =   600
      TabIndex        =   10
      Top             =   1560
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "31"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   30
      Left            =   960
      TabIndex        =   9
      Top             =   2280
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "30"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   29
      Left            =   600
      TabIndex        =   8
      Top             =   2280
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      Caption         =   "29"
      ForeColor       =   &H80000008&
      Height          =   285
      Index           =   28
      Left            =   240
      TabIndex        =   7
      Top             =   2280
      Width           =   300
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H0080C0FF&
      BackStyle       =   1  'Opaque
      Height          =   1935
      Left            =   120
      Top             =   720
      Width           =   2775
   End
   Begin VB.Label lblday 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   495
      Left            =   3000
      TabIndex        =   6
      Top             =   1320
      Width           =   735
   End
   Begin VB.Label lbldate 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H00C0E0FF&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   615
      Left            =   3000
      TabIndex        =   5
      Top             =   720
      Width           =   735
   End
   Begin VB.Label Label2 
      BackColor       =   &H0080C0FF&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   0
      TabIndex        =   4
      Top             =   2880
      Width           =   3975
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H0080C0FF&
      Caption         =   "月份"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   0
      Left            =   1920
      TabIndex        =   3
      Top             =   120
      Width           =   1935
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      BackColor       =   &H0080C0FF&
      Caption         =   " 年份"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Index           =   1
      Left            =   0
      TabIndex        =   2
      Top             =   120
      Width           =   1935
   End
End
Attribute VB_Name = "Frmcalborn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim selectedate%
Dim usedate As Date
Dim usedategong As Date
Dim use As Boolean



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 "一月"
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% = 1905 To 2060 '填充年度
    cboyear.AddItem Str$(i%)
Next i%

End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()

selectedate% = CInt(Format$(Now, "dd"))

'填充月份下拉框
Call fillcbomonth

'填充年份下拉框
Call fillcboyear

'设置当前时间
Call setdate

'显示当前是星期几
Dim caption1$
Dim r As Integer
r = Weekday(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$
Label2.Caption = "今天的日期为:" & Date
use = False
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 + 1905
date1$ = (Str$(month1%) + "/" + Str$(day1%) + "/" + Str$(year1%))
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")
usedate = lbldate.Caption

use = True
Call GetDate(usedate)
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% - 1905
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
Public Function GetDate(UserDate As Date) As Boolean
If use Then
 UserDate = Format$(usedate, "yyyy-mm-dd")

 FrmRenadd.TxtBorndate = UserDate

End If
End Function