alarm.frm

一个闹钟程序

Attribute VB_Exposed = False
Option Explicit
Dim AlarmTime, AlarmSounded, i, CurTime
Dim Playing As Boolean
Const conMinimized = 1

Private Sub chkAlarmBox_Click()
AlarmTime = txtAlarmTime.Text
    If AlarmTime = "" Then Exit Sub
    If Not IsDate(AlarmTime) Then
        chkAlarmBox.Value = False
        MsgBox "The time you entered was not valid."
    Else
        AlarmTime = CDate(AlarmTime)
    End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
    If AlarmSounded Then
        If (KeyAscii = vbKeySpace) Or (KeyAscii = vbKeyEscape) Then
            Snooze_Click
            KeyAscii = 0
        End If
    End If
End Sub

Private Sub cmdExit_Click()
MMCtrlCD.Command = "Stop"
MMCtrlCD.Command = "Close"
mpMP3WAV.Stop
mpMP3WAV.SelectionEnd = True
End
End Sub

Private Sub Form_Load()
    AlarmTime = ""
    mpMP3WAV.Visible = False
    cmdOpen = False

cbotrack.Visible = False
lblTrack.Visible = False
    CDPresent
End Sub
Public Function CDPresent() As Boolean
    Dim i As Integer
    
    cbotrack.Clear
    CDPresent = False
    
    MMCtrlCD.FileName = ""
    MMCtrlCD.DeviceType = "CDAudio"
    MMCtrlCD.Notify = False
    MMCtrlCD.Command = "open"
    If MMCtrlCD.Error <> 0 Then Exit Function
    If MMCtrlCD.Tracks > 0 Then
        MMCtrlCD.From = 1
        MMCtrlCD.To = 1
        MMCtrlCD.Command = "seek"
        If MMCtrlCD.Error = 0 Then
            For i = 1 To MMCtrlCD.Tracks
                cbotrack.AddItem Format$(i), i - 1
            Next i
            cbotrack.ListIndex = 0
            CDPresent = True
        End If
    End If
    MMCtrlCD.Command = "stop"
    If MMCtrlCD.Error <> 0 Then MsgBox "CD Audio will be disabled", 0, "CD Not Present"
    MMCtrlCD.Visible = False
End Function
Private Sub CDPlayTrack(TrackNo As Integer)
    MMCtrlCD.DeviceType = "CDAudio"
    MMCtrlCD.Silent = False
    MMCtrlCD.Command = "open"
    MMCtrlCD.TimeFormat = mciFormatTmsf
    MMCtrlCD.From = TrackNo
    'MMCtrlCD.To = cbotrack.ListCount
    MMCtrlCD.Notify = True
    MMCtrlCD.Wait = False
    MMCtrlCD.Command = "play"
    DoEvents
    If MMCtrlCD.Error <> 0 Then MMCtrlCD.Command = "play" ' retry
    If MMCtrlCD.Error <> 0 Then
        MsgBox MMCtrlCD.ErrorMessage, vbOKOnly Or vbCritical Or vbMsgBoxSetForeground, "Error Playing CD"
        Beep
    Else
        Playing = True
        MMCtrlCD.Visible = True
    End If
End Sub
Private Sub Form_Resize()
    If WindowState = conMinimized And txtAlarmTime.Text = "Enter alarm time" Then      ' If form is minimized, display the time in a caption.
        SetCaptionTime
    ElseIf WindowState = conMinimized And chkAlarmBox.Value = 1 And (mpMP3WAV.FileName <> "" Or MMCtrlCD.Visible = True) Then
        Caption = "Alarm has been set!"
    Else
        Caption = "Alarm Clock"
    End If
End Sub

Private Sub SetCaptionTime()
    Caption = Format(Time, "Medium Time")   ' Display time using medium time format.
End Sub

Private Sub OpenFiles()
    CommonDialog1.CancelError = True
    'User hits Cancel
    On Error GoTo ErrHandler
    CommonDialog1.Flags = cdlOFNHideReadOnly
    'Specifies what kind of files to open
    CommonDialog1.Filter = "MP3 Files (*.mp3)|*.mp3|MP3 Playlists (*.m3u)|*.m3u|WAV Files (*.wav)|*.wav"
    'Default file to open
    CommonDialog1.FilterIndex = 1
    CommonDialog1.ShowOpen
    mpMP3WAV.FileName = CommonDialog1.FileName
    Playwhat.Caption = mpMP3WAV.FileName
    If chkAlarmBox.Value = 1 Then
        mpMP3WAV.Stop
    End If

    Exit Sub
    'User has hit Cancel
ErrHandler:
    If mpMP3WAV.FileName = "" Then
       cboAlarmSound = "Pick one of the following"
    End If

    Exit Sub
End Sub

Private Sub lblTime_Click()

End Sub

Private Sub MMCtrlCD_PlayClick(Cancel As Integer)
CDPlayTrack (cbotrack.Text)
End Sub
Private Sub MMCtrlCD_NextClick(Cancel As Integer)
If chkAlarmBox.Value = 0 Or AlarmSounded = True Then
If cbotrack.Text = 1 Then
   CDPlayTrack (1)
   cbotrack.Text = cbotrack.Text + 1
ElseIf cbotrack.Text = cbotrack.ListCount Then
    cbotrack.Text = 1
    CDPlayTrack (cbotrack.Text)
Else
    cbotrack.Text = cbotrack.Text + 1
    CDPlayTrack (cbotrack.Text)
End If
Else
    cbotrack.Text = cbotrack.Text + 1
End If
End Sub
Private Sub MMCtrlCD_PrevClick(Cancel As Integer)
If chkAlarmBox.Value = 0 Or AlarmSounded = True Then
  If cbotrack.Text = 1 Then
   MsgBox "You can't go back anymore", vbOKOnly, "Hold on..."
  Else
    cbotrack.Text = cbotrack.Text - 1
    CDPlayTrack (cbotrack.Text)
  End If
  Else
    cbotrack.Text = cbotrack.Text - 1
End If
End Sub
Private Sub cmdOpen_Click()
  OpenFiles
End Sub

Private Sub Playwhat_Click()

End Sub

Private Sub Snooze_Click()
Dim PauseTime, Start
    PauseTime = 600  ' Set duration.
    Start = Timer   ' Set start time.
If AlarmSounded And chkAlarmBox.Value = 1 Then
    Do While Timer < Start + PauseTime
      If cboAlarmSound = "MP3 or WAV file" Then
        mpMP3WAV.Pause
      ElseIf cboAlarmSound = "CD-Player" Then
        MMCtrlCD.Command = "Pause"
      End If
      DoEvents
    Loop
    mpMP3WAV.Play
    MMCtrlCD.Command = "Play"
End If
End Sub
Private Sub cbotrack_click()
If chkAlarmBox.Value = 0 Or AlarmSounded = True Then
  CDPlayTrack (cbotrack.Text)
End If
End Sub
Private Sub CallAgent()
    Dim frmTest As New frmAlert
    
    Load frmTest
    frmTest.ThisIsATest = True
    frmTest.Repeat = True
    
        frmTest.AgentName = AgentFrm.cboAgent.Text
        frmTest.SpeakText = AgentFrm.txtSpeak.Text
        frmTest.Repeat = True
        frmTest.AgentShow
        frmTest.AgentPlay "Wave"
        frmTest.AgentSpeak
End Sub

Private Sub Timer1_Timer()
    
    'CurTime = TimeValue(Time)
    'If lblTime.Caption <> CStr(Time) Then

        
    If AlarmTime >= Time Then
       
        If Time >= AlarmTime And Not AlarmSounded And cboAlarmSound = "CD-Player" Then
           CDPlayTrack (cbotrack.Text)
            AlarmSounded = True
        ElseIf Time < AlarmTime Then
            AlarmSounded = False
        End If
        
        If Time >= AlarmTime And Not AlarmSounded And cboAlarmSound = "MP3 or WAV file" Then
            mpMP3WAV.Play
            AlarmSounded = True
        ElseIf Time < AlarmTime Then
            AlarmSounded = False
        End If
        
        If Time >= AlarmTime And Not AlarmSounded And cboAlarmSound = "MS-Agent" Then
            CallAgent
            AlarmSounded = True
        ElseIf Time < AlarmTime Then
            AlarmSounded = False
        End If
    End If
    
        If WindowState = conMinimized And txtAlarmTime.Text = "Enter alarm time" Then
            If Minute(CDate(Caption)) <> Minute(Time) Then SetCaptionTime
        Else
            lblTime.Caption = Format$(Time, "h:mm am/pm")
            'lblTime.Caption = Format$(Time, "Long Time")
        End If
End Sub

Private Sub cboAlarmSound_click()
 If cboAlarmSound = "CD-Player" Then
        MMCtrlCD.Visible = True
        cbotrack.Visible = True
        lblTrack.Visible = True
    Else
        MMCtrlCD.Visible = False
        cbotrack.Visible = False
        lblTrack.Visible = False
        MMCtrlCD.Command = "Stop"
    End If
  
    If cboAlarmSound = "MP3 or WAV file" Then
        mpMP3WAV.Visible = True
        Playwhat.ForeColor = &HC000&
        cmdOpen.Visible = True
    Else
        mpMP3WAV.Visible = False
        mpMP3WAV.Stop
        Playwhat.ForeColor = &H0&
        cmdOpen.Visible = False
    End If
    
    If (cboAlarmSound = "MS-Agent") Then
        AgentFrm.Show
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
MMCtrlCD.Command = "Stop"
MMCtrlCD.Command = "Close"
mpMP3WAV.Stop
mpMP3WAV.SelectionEnd = True
End Sub