Dim KeyCode As Keys
  Dim oldTime As DateTime
 
  Private Sub DateTimePicker1_PreviewKeyDown(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.PreviewKeyDownEventArgs) _
    Handles DateTimePicker1.PreviewKeyDown
 
    KeyCode = e.KeyCode
    oldTime = DateTimePicker1.Value
  End Sub
 
  Private Sub DateTimePicker1_ValueChanged(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles DateTimePicker1.ValueChanged
 
    Static bWorking As Boolean = False
 
    If bWorking Then Exit Sub
    bWorking = True
    With DateTimePicker1
      If KeyCode = Keys.Down Then
        If Hour(oldTime) = 0 And Minute(oldTime) = 0 Then
          .Value = CDate(.MinDate & " 23:45")
        ElseIf Minute(oldTime) = 0 Then
          .Value = CDate(.MinDate) & " " & CStr(Hour(.Value) - 1 & ":45")
        Else
          If Minute(.Value) > 45 Then
            .Value = CDate(.MinDate & " " & CStr(Hour(.Value) & ":45"))
          ElseIf Minute(.Value) > 30 And Minute(.Value) < 45 Then
            .Value = CDate(.MinDate & " " & CStr(Hour(.Value) & ":30"))
          ElseIf Minute(.Value) > 15 And Minute(.Value) < 30 Then
            .Value = CDate(.MinDate & " " & CStr(Hour(.Value) & ":15"))
          ElseIf Minute(.Value) > 0 And Minute(.Value) < 15 Then
            .Value = CDate(.MinDate & " " & CStr(Hour(.Value) & ":00"))
          End If
        End If
 
      ElseIf KeyCode = Keys.Up Then
        If Hour(oldTime) = 23 And Minute(oldTime) >= 45 Then
          .Value = CDate(.MinDate & " 00:00")
        ElseIf Minute(oldTime) > 45 Then
          .Value = CDate(.MinDate) & " " & CStr(Hour(.Value) + 1 & ":00")
        Else
          If Minute(.Value) > 0 And Minute(.Value) < 15 Then
            .Value = CDate(.MinDate & " " & CStr(Hour(.Value) & ":15"))
          ElseIf Minute(.Value) > 15 And Minute(.Value) < 30 Then
            .Value = CDate(.MinDate & " " & CStr(Hour(.Value) & ":30"))
          ElseIf Minute(.Value) > 30 And Minute(.Value) < 45 Then
            .Value = CDate(.MinDate & " " & CStr(Hour(.Value) & ":45"))
          End If
        End If
      End If
    End With
    bWorking = False
  End Sub

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de