calendar.frm

餐饮茶馆管理系统

      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "星期四"
      Height          =   180
      Index           =   4
      Left            =   3105
      TabIndex        =   4
      Top             =   1005
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "星期日"
      ForeColor       =   &H00000000&
      Height          =   180
      Index           =   3
      Left            =   180
      TabIndex        =   3
      Top             =   1005
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "星期三"
      Height          =   180
      Index           =   2
      Left            =   2370
      TabIndex        =   2
      Top             =   1005
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "星期二"
      Height          =   180
      Index           =   1
      Left            =   1635
      TabIndex        =   1
      Top             =   1005
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "星期一"
      Height          =   180
      Index           =   0
      Left            =   915
      TabIndex        =   0
      Top             =   1005
      Width           =   540
   End
   Begin VB.Line Line4 
      BorderColor     =   &H00FFFFFF&
      Index           =   0
      X1              =   75
      X2              =   75
      Y1              =   870
      Y2              =   3785
   End
   Begin VB.Line Line3 
      Index           =   0
      X1              =   60
      X2              =   60
      Y1              =   840
      Y2              =   3785
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      Index           =   0
      X1              =   75
      X2              =   5190
      Y1              =   855
      Y2              =   855
   End
   Begin VB.Line Line1 
      Index           =   0
      X1              =   60
      X2              =   5220
      Y1              =   840
      Y2              =   840
   End
   Begin VB.Image ImagePress 
      Height          =   420
      Index           =   5
      Left            =   3720
      Picture         =   "Calendar.frx":2B792
      Top             =   1290
      Width           =   750
   End
   Begin VB.Menu Mnuoption 
      Caption         =   "选项(&O)"
      Visible         =   0   'False
      Begin VB.Menu MnuToday 
         Caption         =   "设置为今天日期"
      End
   End
End
Attribute VB_Name = "Calendar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Browser As String
Dim MyDate As String, WeekNo As Integer
Dim YNO As Integer, MNO As Integer
Dim i As Integer
Dim MyRq As Date
Dim StartX As Boolean

Private Sub DisplayLabel_Click(Index As Integer)

If DisplayLabel(Index) = "" Then Exit Sub
   Call ImagePress_Click(Index)
   
End Sub

Private Sub DisplayLabel_DblClick(Index As Integer)

  '调用ImagePress_DblClick过程
  Call ImagePress_DblClick(Index)
  
End Sub

Private Sub DisplayMonth_Click()

On Error Resume Next

If StartX = False Then Exit Sub
   ImagePress(Val(DisplayDay.Caption) + WeekNo - 2).Picture = LoadPicture(Browser + "calendar1.bmp")
   Display.Caption = DisplayYear.Text + " 年 " + DisplayMonth + "月"
'计算日期
  MyDate = DisplayMonth.Text + "/" + DisplayDay.Caption + "/" + DisplayYear.Text
  On Error GoTo Novalid
  MyRq = CDate(MyDate)
  GoTo NormalValid
Novalid:
    'MsgBox " 日期[ " & MyDate & " ]错误,请检查。   ", vbInformation
    DisplayDay.Caption = "01"
    MyDate = DisplayMonth.Text + "/" + "01" + "/" + DisplayYear.Text
    MyRq = CDate(MyDate)
NormalValid:
    MNO = Month(MyRq)
    Select Case MNO
        Case 2
          If Year(MyRq) / 400 = Int(Year(MyRq) / 400) Then
             YNO = 29
               Else
             YNO = 28
          End If
        Case 4, 6, 9, 11
          YNO = 30
        Case Else
          YNO = 31
    End Select
   MyDate = MNO & "/" & "1" & "/" & Year(MyRq)
   WeekNo = Weekday(CDate(MyDate))
For i = 0 To 41
    If i >= WeekNo - 1 And i <= YNO + WeekNo - 2 Then
       DisplayLabel(i).Caption = i - WeekNo + 2
       ImagePress(i).Enabled = True
        Else
       DisplayLabel(i).Caption = ""
       ImagePress(i).Enabled = False
    End If
     If i = 0 Or i = 7 Or _
      i = 14 Or i = 21 Or _
      i = 28 Or i = 35 Then
      DisplayLabel(i).ForeColor = &HFF
     Else
      DisplayLabel(i).ForeColor = &H0
     End If
Next
'计数今天的日期
DisplayLabel(WeekNo - 2 + Val(DisplayDay.Caption)).ForeColor = &HFFFFFF
ImagePress(WeekNo - 2 + Val(DisplayDay.Caption)).Picture = LoadPicture(Browser + "calendar0.bmp")
Exit Sub

End Sub

Private Sub DisplayYear_Click()
   
   On Error Resume Next

   ImagePress(Val(DisplayDay.Caption) + WeekNo - 2).Picture = LoadPicture(Browser + "calendar1.bmp")
   Display.Caption = DisplayYear.Text + " 年 " + DisplayMonth + "月"
'计算日期
MyDate = DisplayMonth.Text + "/" + DisplayDay.Caption + "/" + DisplayYear.Text
MyRq = CDate(MyDate)
    MNO = Month(MyRq)
    Select Case MNO
        Case 2
          If Year(MyRq) / 400 = Int(Year(MyRq) / 400) Then
             YNO = 29
               Else
             YNO = 28
          End If
        Case 4, 6, 9, 11
          YNO = 30
        Case Else
          YNO = 31
    End Select
   MyDate = MNO & "/" & "1" & "/" & Year(MyRq)
   WeekNo = Weekday(CDate(MyDate))
For i = 0 To 41
    If i >= WeekNo - 1 And i <= YNO + WeekNo - 2 Then
       DisplayLabel(i).Caption = i - WeekNo + 2
       ImagePress(i).Enabled = True
        Else
       DisplayLabel(i).Caption = ""
       ImagePress(i).Enabled = False
    End If
     If i = 0 Or i = 7 Or _
      i = 14 Or i = 21 Or _
      i = 28 Or i = 35 Then
      DisplayLabel(i).ForeColor = &HFF
     Else
      DisplayLabel(i).ForeColor = &H0
     End If
Next
'计数今天的日期
DisplayLabel(WeekNo - 2 + Val(DisplayDay.Caption)).ForeColor = &HFFFFFF
ImagePress(WeekNo - 2 + Val(DisplayDay.Caption)).Picture = LoadPicture(Browser + "calendar0.bmp")

End Sub

Private Sub Form_Load()

On Error Resume Next

StartX = False
   Browser = App.Path
If Right(Browser, 1) <> "\" Then
   Browser = Browser + "\"
End If
DisplayDay.Caption = Day(Date)
DisplayMonth.AddItem "01", 0
DisplayMonth.AddItem "02", 1
DisplayMonth.AddItem "03", 2
DisplayMonth.AddItem "04", 3
DisplayMonth.AddItem "05", 4
DisplayMonth.AddItem "06", 5
DisplayMonth.AddItem "07", 6
DisplayMonth.AddItem "08", 7
DisplayMonth.AddItem "09", 8
DisplayMonth.AddItem "10", 9
DisplayMonth.AddItem "11", 10
DisplayMonth.AddItem "12", 11
DisplayMonth.ListIndex = 0
For i = 1990 To 2990
   DisplayYear.AddItem i, i - 1990
Next
   DisplayYear.ListIndex = 0
DisplayMonth.ListIndex = Month(Date) - 1
DisplayYear.ListIndex = Year(Date) - 1990
    MNO = Month(Date)
    Select Case MNO
        Case 2
          If Year(Date) / 400 = Int(Year(Date) / 400) Then
             YNO = 29
               Else
             YNO = 28
          End If
        Case 4, 6, 9, 11
          YNO = 30
        Case Else
          YNO = 31
    End Select
   MyDate = MNO & "/" & "1" & "/" & Year(Date)
   WeekNo = Weekday(CDate(MyDate))
For i = 0 To 41
    If i >= WeekNo - 1 And i <= YNO + WeekNo - 2 Then
       DisplayLabel(i).Caption = i - WeekNo + 2
        Else
       DisplayLabel(i).Caption = ""
       ImagePress(i).Enabled = False
    End If
Next
'计数今天的日期
   Display.Caption = DisplayYear.Text + " 年 " + DisplayMonth + "月"
For i = 0 To 41
    ImagePress(i).Picture = LoadPicture(Browser + "calendar1.bmp")
Next
ImagePress(WeekNo - 2 + Day(Date)).Picture = LoadPicture(Browser + "calendar0.bmp")
StartX = True

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 If Button = 2 Then
    PopupMenu Mnuoption
 End If

End Sub

Private Sub ImagePress_Click(Index As Integer)

On Error Resume Next

ImagePress(Val(DisplayDay.Caption) + WeekNo - 2).Picture = LoadPicture(Browser + "calendar1.bmp")
 If Val(DisplayDay.Caption) + WeekNo - 2 = 0 Or Val(DisplayDay.Caption) + WeekNo - 2 = 7 Or _
    Val(DisplayDay.Caption) + WeekNo - 2 = 14 Or Val(DisplayDay.Caption) + WeekNo - 2 = 21 Or _
    Val(DisplayDay.Caption) + WeekNo - 2 = 28 Or Val(DisplayDay.Caption) + WeekNo - 2 = 35 Then
 DisplayLabel(Val(DisplayDay.Caption) + WeekNo - 2).ForeColor = &HFF
 Else
 DisplayLabel(Val(DisplayDay.Caption) + WeekNo - 2).ForeColor = &H0
 End If
ImagePress(Index).Picture = LoadPicture(Browser + "calendar0.bmp")
DisplayDay.Caption = DisplayLabel(Index).Caption
DisplayLabel(Index).ForeColor = &HFFFFFF

End Sub

Private Sub ImagePress_DblClick(Index As Integer)

 If Len(Trim(Str(DisplayLabel(Index).Caption))) = 1 Then
    DateStr = DisplayYear.Text & "-" & DisplayMonth.Text & "-0" & Trim(Str(DisplayLabel(Index).Caption))
 Else
    DateStr = DisplayYear.Text & "-" & DisplayMonth.Text & "-" & Trim(Str(DisplayLabel(Index).Caption))
 End If
 
    '御载日历程序
    Unload Me
    
End Sub

Private Sub MnuToday_Click()

On Error Resume Next

DisplayDay.Caption = Day(Date)
    MNO = Month(Date)
    DisplayMonth.ListIndex = MNO - 1
    DisplayYear.ListIndex = Year(Date) - 1990
    Select Case MNO
        Case 2
          If Year(Date) / 400 = Int(Year(Date) / 400) Then
             YNO = 29
               Else
             YNO = 28
          End If
        Case 4, 6, 9, 11
          YNO = 30
        Case Else
          YNO = 31
    End Select
   MyDate = MNO & "/" & "1" & "/" & Year(Date)
   WeekNo = Weekday(CDate(MyDate))
For i = 0 To 41
    If i >= WeekNo - 1 And i <= YNO + WeekNo - 2 Then
       DisplayLabel(i).Caption = i - WeekNo + 2
       ImagePress(i).Enabled = True
        Else
       DisplayLabel(i).Caption = ""
       ImagePress(i).Enabled = False
    End If
Next
'计数今天的日期
   Display.Caption = DisplayYear.Text + " 年 " + DisplayMonth + "月"
For i = 0 To 41
    ImagePress(i).Picture = LoadPicture(Browser + "calendar1.bmp")
     If i = 0 Or i = 7 Or _
      i = 14 Or i = 21 Or _
      i = 28 Or i = 35 Then
      DisplayLabel(i).ForeColor = &HFF
     Else
      DisplayLabel(i).ForeColor = &H0
     End If

Next
   DisplayLabel(WeekNo - 2 + Day(Date)).ForeColor = &HFFFFFF
   ImagePress(WeekNo - 2 + Day(Date)).Picture = LoadPicture(Browser + "calendar0.bmp")

End Sub