|
ption Explicit
Dim setHour As Integer, setMinute As Integer
Dim cHour, cMin, cSec
Dim cTime As String, wavName As String
Dim getTime As Date
Dim Sound As Boolean
Private Sub chkSound_Click()
If chkSound.Value = 0 Then
Sound = False
Else
Sound = True
End If
End Sub
Private Sub cmdSet_Click()
'Eingabe prüfen
If Not txtHour.Text = "" And Not txtMinute.Text = "" _
And Not txtSekunde.Text = "" Then
If Not Len(txtHour.Text) < 2 And Not Len(txtMinute.Text) < 2 _
And Not Len(txtSekunde.Text) < 2 Then
'Wenn SetTime
If optSetTime = True Then
getTime = Format(Time, "hh:mm:ss")
setHour = Format(txtHour.Text, "00")
setMinute = Format(txtMinute.Text, "00")
'Berechnen der Stunden
cHour = setHour
If setHour < Mid$(getTime, 1, 2) Then
cHour = 24 - (Mid$(getTime, 1, 2) - setHour)
ElseIf setHour = Mid$(getTime, 1, 2) Then
If setMinute < Mid$(getTime, 4, 2) Then
cHour = 23
ElseIf setMinute > Mid$(getTime, 4, 2) Then
cHour = 0
cHour = Format(cHour, "00")
ElseIf setMinute = Mid$(getTime, 4, 2) Then
cHour = 23
End If
Else
cHour = setHour - Mid$(getTime, 1, 2)
cHour = Format(cHour, "00")
End If
'Berechnen der Minuten
cMin = setMinute
If setMinute < Mid$(getTime, 4, 2) Then
cMin = 60 - (Mid$(getTime, 4, 2) - setMinute)
If Not setHour = Mid$(getTime, 1, 2) Then
cHour = Format(cHour - 1, "00")
cMin = Format(cMin - 1, "00")
Else
cMin = Format(cMin - 1, "00")
End If
ElseIf setMinute = Mid$(getTime, 4, 2) Then
If setHour = Mid$(getTime, 1, 2) Then
cMin = 59
Else
cMin = 0
cMin = Format(cMin, "00")
End If
Else
cMin = setMinute - Mid$(getTime, 4, 2)
cMin = Format(cMin - 1, "00")
End If
'Sekunden festlegen im SetTime-Modus
cSec = 60 - Format(Now, "ss")
'Wenn SetCount
ElseIf optSetCount = True Then
cHour = Format(txtHour.Text, "00")
cMin = Format(txtMinute.Text, "00")
cSec = Format(txtSekunde.Text, "00")
End If
'Voreinstellung
tmrCountDown.Enabled = True: cmdSet.Enabled = False
txtHour.Locked = True: txtMinute.Locked = True: _
txtSekunde.Locked = True
wavName = App.Path & "\tick.wav"
'Wenn fehler bei Eingabe
Else
MsgBox "Bitte geben Sie auch die führenden Nullen mit an !" _
& vbCrLf & vbCrLf & vbCrLf & " Beispiel :" & vbCrLf _
& vbCrLf & " Richtig = 08 : 15, Falsch = 8 : 15", _
vbExclamation, "Falsche Eingabe"
End If
'Wenn Eingabefeld leer
Else
MsgBox "Bitte füllen Sie alle Felder aus !", vbExclamation, _
"Fehlende Eingabe"
End If
End Sub
Private Sub cmdStop_Click()
cHour = 0: cMin = 0: cSec = 0: cTime = "": setHour = 0: _
setMinute = 0
txtHour.Locked = False: txtMinute.Locked = False: _
txtSekunde.Locked = False
tmrCountDown.Enabled = False: cmdSet.Enabled = True
End Sub
Private Sub Form_load()
lblDate.Caption = Format(Date, "dd.mm.yyyy"): Sound = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessagelong Me.hWnd, WM_NClBUTTONDOWN, HTCAPTION, 0
End If
End Sub
Private Sub optSetCount_Click()
txtSekunde.Enabled = True
End Sub
Private Sub optSetTime_Click()
txtSekunde.Enabled = False
End Sub
Private Sub tmrTime_Timer()
lblCurrentTimeShow.Caption = Format$(Now, "hh:mm:ss")
End Sub
Private Sub tmrCountDown_Timer()
'Wenn Sound an
If Sound = True Then
MMC1.FileName = wavName
MMC1.Wait = False
MMC1.Command = "Sound"
End If
'Countdown anzeigen
cTime = Format$(cHour, "00:"): cTime = cTime & _
Format$(cMin, "00:"): cTime = cTime & Format$(cSec, "00")
lblHaveTime.Caption = cTime
'Anpassen der Sekunden alle 20 Sekunden wenn SetTime = True
If optSetTime = True Then
If cSec / 5 = 2 Xor cSec / 10 = 3 Xor cSec / 10 = 5 Then
cSec = 60 - Format(Now, "ss")
End If
End If
'Countdown runterzählen
cSec = cSec - 1
If cSec = -1 Then
cSec = 59
cMin = cMin - 1
If cMin = -1 Then
If Not cHour = 0 Then
cMin = 59
cHour = cHour - 1
End If
End If
End If
'Auswerten der Countdownzeit
If lblHaveTime.Caption = "00:00:00" Then
MMC1.FileName = App.Path & "\thx.wav"
MMC1.Wait = False
MMC1.Command = "Sound"
tmrCountDown.Enabled = False: cmdSet.Enabled = True
txtHour.Locked = False: txtMinute.Locked = False: _
txtSekunde.Locked = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
MMC1.Command = "Close"
End Sub
Private Sub txtHour_KeyPress(KeyAscii As Integer)
Call crtlKey(KeyAscii)
End Sub
Private Sub txtMinute_KeyPress(KeyAscii As Integer)
Call crtlKey(KeyAscii)
End Sub
Private Sub txtSekunde_KeyPress(KeyAscii As Integer)
Call crtlKey(KeyAscii)
End Sub
Private Function crtlKey(cKey As Integer)
Select Case cKey
Case 48 To 57
Case 8
Case Else
cKey = 0
End Select
End Function
Private Sub cmdExit_Click()
tmrTime.Enabled = False: tmrCountDown.Enabled = False: _
Unload Me
End Sub
|
|