Option Explicit
 
Dim Break As Boolean
Dim DestItem$
 
Private Sub Command1_Click()
 
Dim i#
Dim sDate, eDate, start, ENDE, Ziel, Temp, Newdate
Dim nHour&, nMin&, nSec&, nDauer, ntage&
Dim mHour$, mMin$, mSec$, mTage$
 
ANFANG:
Ziel = Text1.Text & " " & Text2.Text
Break = False
sDate = Now
eDate = CDate(Ziel)
start = Timer
i = DateDiff("s", sDate, eDate)
 
Do While Timer < start + i And Break = False
  nDauer = DateDiff("s", Now, eDate)
  nHour = Fix(nDauer / 3600)
  mHour = Format(CStr(nHour), "00")
  nMin = Fix((nDauer Mod 3600) / 60)
  mMin = Format(CStr(nMin), "00")
  nSec = nDauer - ((nHour * 3600) + (nMin * 60))
  mSec = Format(Str(nSec), "00")
 
    If nHour > 23 Then
      ntage = Fix(nHour / 24)
      nHour = nHour - (ntage * 24)
      mTage = Format(CStr(ntage), "00") & ". "
      mHour = Format(CStr(nHour), "00")
    End If
 
  Label1.Caption = mTage & mHour & ":" & mMin & ":" & mSec
  DoEvents
Loop
ENDE = Timer
If Break = False Then
Newdate = DateAdd(DestItem, Val(Text3.Text), Now)
Temp = Split(CStr(Newdate), " ")
Text1.Text = Temp(0)
Text2.Text = Temp(1)
GoTo ANFANG
End If
 
End Sub
Private Sub Command2_Click()
Break = True
End Sub
 
 
Private Sub Command3_Click()
Dim Newdate, Temp
Newdate = DateAdd("s", Val(Text3.Text), Now)
Temp = Split(CStr(Newdate), " ")
Text1.Text = Temp(0)
Text2.Text = Temp(1)
End Sub
 
Private Sub Form_Load()
Text3.Text = 30
Option1_Click 3
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
Unload Me
Set Form1 = Nothing
End Sub
 
Private Sub Option1_Click(Index As Integer)
Select Case Index
Case 0
DestItem = "s"
Case 1
DestItem = "n"
Case 2
DestItem = "h"
Case 3
DestItem = "d"
End Select
End Sub
 
Private Sub Text1_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub
Private Sub Text2_Click()
Text2.SelStart = 0
Text2.SelLength = Len(Text2)
End Sub
Private Sub Text3_Click()
Text3.SelStart = 0
Text3.SelLength = Len(Text3)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57
Case 8
Case 46
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57
Case 8
Case 58
Case Else
KeyAscii = 0
End Select
End Sub
 
Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
If Len(Text2) = 2 Or Len(Text2) = 5 Then SendKeys ":"
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If Len(Text1) = 2 Or Len(Text1) = 5 Then SendKeys "."
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 48 To 57
Case 8
Case Else
KeyAscii = 0
End Select
End Sub