form1.frm

用VB编写自制小闹钟程序

      Height          =   285
      Index           =   2
      Left            =   4800
      TabIndex        =   17
      Top             =   1200
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Caption         =   "4"
      Height          =   285
      Index           =   3
      Left            =   5160
      TabIndex        =   16
      Top             =   1200
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Caption         =   "5"
      Height          =   285
      Index           =   4
      Left            =   5520
      TabIndex        =   15
      Top             =   1200
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Caption         =   "6"
      Height          =   285
      Index           =   5
      Left            =   5880
      TabIndex        =   14
      Top             =   1200
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Caption         =   "7"
      Height          =   285
      Index           =   6
      Left            =   6240
      TabIndex        =   13
      Top             =   1200
      Width           =   300
   End
   Begin VB.Label lblnumber 
      Alignment       =   2  'Center
      Caption         =   "1"
      Height          =   285
      Index           =   0
      Left            =   4080
      TabIndex        =   12
      Top             =   1200
      Width           =   300
   End
   Begin VB.Shape Shape1 
      Height          =   1935
      Left            =   3960
      Top             =   1080
      Width           =   2655
   End
   Begin VB.Label Label1 
      Caption         =   "年"
      Height          =   255
      Index           =   1
      Left            =   6720
      TabIndex        =   11
      Top             =   360
      Width           =   495
   End
   Begin VB.Label Label1 
      Caption         =   "月份"
      Height          =   255
      Index           =   0
      Left            =   3960
      TabIndex        =   10
      Top             =   360
      Width           =   615
   End
   Begin VB.Label Label4 
      Caption         =   "事件"
      Height          =   255
      Left            =   5760
      TabIndex        =   5
      Top             =   3360
      Width           =   375
   End
   Begin VB.Label Label3 
      Caption         =   "时间"
      Height          =   255
      Left            =   4560
      TabIndex        =   4
      Top             =   3360
      Width           =   375
   End
   Begin VB.Image Image1 
      Height          =   3255
      Left            =   0
      Picture         =   "Form1.frx":C91A
      Top             =   0
      Width           =   3255
   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 X0, Y0 As Integer
    Dim selectedate%
    Dim AlarmTime
    Dim result As Integer
    Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrcommand As String) As Long '使用mmcontrol控件
   

Private Sub cmdadd_Click()   '添加提醒
  AlarmTime = Text2
 
  If Not IsDate(AlarmTime) Or AlarmTime = "" Then
    Exit Sub
  Else
    AlarmTime = CDate(AlarmTime)
  End If
    '判断输入的是否可转换成time格式
    'isdate函数是判断输入的是否可转换成date格式
  Dim int1 As Integer
  If ListView1.ListItems.Count <> 0 Then   '防止出现同一时间设置两次提醒
    For int1 = 1 To ListView1.ListItems.Count
      If AlarmTime = CDate(ListView1.ListItems(int1)) Then
        Exit Sub
      End If
    Next
  End If
  ListView1.ListItems.Add ListView1.ListItems.Count + 1, , CStr(AlarmTime)
  ListView1.ListItems(ListView1.ListItems.Count).ListSubItems.Add , , CStr(Text1)
  Text1 = "": Text2 = ""     '添加完成后输入框置空
End Sub
Private Sub Data1_Validate(Action As Integer, Save As Integer)

End Sub

Private Sub Drive1_Change()

End Sub


Private Sub cmdclear_Click()
 ListView1.ListItems.Clear
End Sub

Private Sub Command1_Click()
  If ListView1.ListItems.Count = 0 Then Exit Sub
  Dim int1 As Integer
  int1 = 1
  Do Until int1 > ListView1.ListItems.Count
    If ListView1.ListItems(int1).Selected = True Then
      ListView1.ListItems.Remove int1
    Else: int1 = int1 + 1
    End If
  Loop
End Sub

   
    
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub timClock_Timer()
lblTime.Caption = Format(Now, "hh:mm:ss")
Dim int1 As Integer
For int1 = 1 To ListView1.ListItems.Count
  If Time = CDate(ListView1.ListItems(int1)) Then
   Form2.Show
    End If
    Next
End Sub


    Private Sub Timer1_Timer()
        Dim Angle
        Static LastSecond
        
        '如果当前时间与表针显示时间相同，则不需要重绘表针
        If Second(Now) = LastSecond Then Exit Sub
        LastSecond = Second(Now)
        '定位时针,分针，秒针
        Line1.BorderWidth = 1 '表针的粗细
        Line2.BorderWidth = 3
        Line3.BorderWidth = 4
        
        Angle = -0.5236 * (15 - (Hour(Now) + Minute(Now) / 60))
        Line3.X2 = 0.5 * Cos(Angle) * 1000 + X0
        Line3.Y2 = 0.5 * Sin(Angle) * 1000 + Y0
        Angle = -0.1047 * (75 - (Minute(Now) + Second(Now) / 60))
        Line2.X2 = 0.7 * Cos(Angle) * 1000 + X0
        Line2.Y2 = 0.7 * Sin(Angle) * 1000 + Y0
        Angle = -0.1047 * (75 - Second(Now))
        Line1.X2 = 0.8 * Cos(Angle) * 1000 + X0
        Line1.Y2 = 0.8 * Sin(Angle) * 1000 + Y0
       End Sub
       

Private Sub Timer2_Timer()
Dim int1 As Integer
For int1 = 1 To ListView1.ListItems.Count
  If Time = CDate(ListView1.ListItems(int1)) Then
   Form2.Show
    End If
Next
    End Sub
      
    


    
    Sub Form_Load()
        
        ' 设置表的中心位置
        Let X0 = 1560
        Let Y0 = 1580
                 
        ' 初始化Timer1控件
        Timer1.Enabled = True
        Timer1.Interval = 100
        ' 设置表针的一端位置
        Line1.X1 = X0
        Line1.Y1 = Y0
        Line2.Y1 = Y0
        Line2.X1 = X0
        Line3.X1 = X0
        Line3.Y1 = Y0
        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 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()
If MsgBox("你确定要关闭应用程序吗？", vbQuestion + vbOKCancel + vbDefaultButton2, "提示信息") = vbCancel Then
Else
Unload Me
End If
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 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()
'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