none
Get the nearest time from multiple times in combo box and duration vb.net RRS feed

  • Question

  • i have a multiple times in combo box e.g 09:00 AM , 09:30 AM etc. 

    i try to get the nearest time to the current time ( e.g : 08:45 AM ) and the duration to time (e.g 0 hours and 15 min to the next appointment 09:00 AM ) 

    i try a multiple code all failed ): vb.net


    Monday, April 22, 2019 9:55 PM

All replies

  • Hello,

    Here are two extension methods which work off DateTime e.g. here I use the current time from Now. One rounds down the quarter hour while the other rounds up.

    Public Module DateTimeExtensions
        <Runtime.CompilerServices.Extension>
        Public Function RoundDown(dateTime As Date) As Date
            Return New Date(dateTime.Year, dateTime.Month, dateTime.Day, dateTime.Hour, (dateTime.Minute \ 15) * 15, 0)
        End Function
        <Runtime.CompilerServices.Extension>
        Public Function RoundUp(dateTime As Date) As Date
            Return (New Date(dateTime.Year, dateTime.Month, dateTime.Day, dateTime.Hour, dateTime.Minute, 0)).AddMinutes(If(dateTime.Minute Mod 15 = 0, 0, 15 - dateTime.Minute Mod 15))
        End Function
    End Module

    Usage

    Dim resultDown = Now.RoundDown().ToString("h:mm tt")
    Console.WriteLine(resultDown)
    Dim resultUp = Now.RoundUp().ToString("h:mm tt")
    Console.WriteLine(resultUp)

    Test run at 3:34 PM

    3:30 PM
    3:45 PM

    Dependent on how the ComboBox is loaded you can then say use FindString or FindStringExact for example, both return the index in the ComboBox so then if needed you can set SelectedIndex to the result of either or method.

    Here is a more flexible idea which rounds, rounds up or rounds down by interval e.g. 15, 30 etc.

    Public Enum RoundingDirection
        RoundUp
        RoundDown
        Round
    End Enum
    Public Module DateTimeExtensions
        ''' <summary>
        ''' Find closest to date/time input
        ''' </summary>
        ''' <param name="time">Time to work against</param>
        ''' <param name="minuteInterval">Interval to move to</param>
        ''' <param name="direction">Down, Up</param>
        ''' <returns></returns>
        <Runtime.CompilerServices.Extension>
        Public Function RoundDateToMinuteInterval(time As Date, minuteInterval As Integer, direction As RoundingDirection) As Date
            If minuteInterval = 0 Then
                Return time
            End If
    
            Dim interval = CDec(minuteInterval)
            Dim actMinute = CDec(time.Minute)
    
            If actMinute = 0.00D Then
                Return time
            End If
    
            Dim newMinutes As Integer = 0
    
            Select Case direction
                Case RoundingDirection.Round
                    newMinutes = CInt(Fix(Math.Round(actMinute / interval, 0) * interval))
                Case RoundingDirection.RoundDown
                    newMinutes = CInt(Fix(Math.Truncate(actMinute / interval) * interval))
                Case RoundingDirection.RoundUp
                    newMinutes = CInt(Fix(Math.Ceiling(actMinute / interval) * interval))
            End Select
    
            ' *** strip time 
            time = time.AddMinutes(time.Minute * -1)
            time = time.AddSeconds(time.Second * -1)
            time = time.AddMilliseconds(time.Millisecond * -1)
    
            ' *** add new minutes back on            
            Return time.AddMinutes(newMinutes)
        End Function
    End Module

    Usage

    Dim result = Now.RoundDateToMinuteInterval(30, RoundingDirection.RoundUp)
    Console.WriteLine(result.ToString("h:mm tt"))


    Please remember to mark the replies as answers if they help and unmarked them if they provide no help, this will help others who are looking for solutions to the same or similar problem. Contact via my Twitter (Karen Payne) or Facebook (Karen Payne) via my MSDN profile but will not answer coding question on either.

    NuGet BaseConnectionLibrary for database connections.

    StackOverFlow
    profile for Karen Payne on Stack Exchange



    Monday, April 22, 2019 10:36 PM
    Moderator
  • Hi

    Here is another way. This fills the ComboBox but otherwise it is unused. (don't know why you have that)

    Anyway, this version uses a timer and updates the next appointment in real time. You can set the appointment starttime, endtime and intervals at top of code.

    Here is an Image of the Form Designer

    Here is the code

    Option Strict On
    Option Explicit On
    Public Class Form1
        Dim starttime As New TimeSpan(9, 0, 0)
        Dim endtime As New TimeSpan(18, 0, 0)
        Dim appInterval As New TimeSpan(0, 15, 0)
        Dim apps As New List(Of TimeSpan)
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            ' set up some dummy contents, but what the
            ' combobox is for is unknown
            Dim ts As TimeSpan = starttime
            With apps
                Do
                    .Add(ts) 
                    ts = ts.Add(appInterval)
                Loop Until ts > endtime
            End With
            ComboBox1.DataSource = apps
            With Timer1
                .Interval = 100
                .Enabled = True
            End With
        End Sub
        Function GetFirstHit(ns As TimeSpan) As TimeSpan
    
            For Each ts As TimeSpan In apps
                While ns > ts
                    Continue For
                End While
                Return ts
            Next
            Return Nothing
        End Function
        Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
            Dim nowtime As TimeSpan = Now.TimeOfDay
            Dim NextApp As TimeSpan = GetFirstHit(nowtime)
            Label1.Text = NextApp.ToString("hh\:mm")
            Label2.Text = NextApp.Subtract(nowtime).ToString("hh\h\r\s\ mm\m\i\n")
            If nowtime.Seconds = 0 Then Timer1.Interval = 60 * 1000
        End Sub
    End Class


    Regards Les, Livingston, Scotland


    • Edited by leshay Monday, April 22, 2019 11:53 PM
    Monday, April 22, 2019 11:50 PM
  • Hi

    Here is the same code as above, but with provision for daily 'gaps' (where appointments cannot be set)

    Option Strict On
    Option Explicit On
    Public Class Form1
    #If DEBUG Then
        Private Debug As Boolean = True
    #Else
        Private Debug As Boolean = False
    #End If
    
        ' timespans (hr,min,sec)
        ' starttime - first app time (included)
        Dim starttime As New TimeSpan(9, 0, 0)
        ' endtime - end app time (excluded)
        Dim endtime As New TimeSpan(22, 0, 0)
        ' appinterval - app spacing
        Dim appInterval As New TimeSpan(0, 15, 0)
    
        Dim apps As New List(Of TimeSpan)
        Dim gaps As New List(Of gap)
        Dim dateBase As DateTime = New DateTime(2019, 1, 1)
    
        ' debug only! to enable test Time to
        ' override current actual Time
        ' these values will be added to current
        ' actual Time.
        Dim addh As Integer = 0
        Dim addm As Integer = 0
    
        Class gap
            Property StartTime As TimeSpan
            Property EndTime As TimeSpan
        End Class
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    
            If Not Debug Then
                addh = 0
                addm = 0
            End If
    
            gaps = SetGaps()
            apps = SetApps(starttime, endtime)
    
            With Timer1
                .Interval = 100
                .Enabled = True
            End With
    
        End Sub
        Function SetGaps() As List(Of gap)
            Dim gaps As New List(Of gap)
            gaps.Add(SetGap("11:00", "11:15"))
            gaps.Add(SetGap("13:00", "14:00"))
            gaps.Add(SetGap("15:00", "15:30"))
            Return gaps
        End Function
        Function SetGap(st As String, et As String) As gap
            Return New gap With {.StartTime = CDate(st).TimeOfDay, .EndTime = CDate(et).TimeOfDay}
        End Function
        Function SetApps(st As TimeSpan, en As TimeSpan) As List(Of TimeSpan)
            Dim app As New List(Of TimeSpan)
            Dim ts As TimeSpan = starttime
            With app
                Do
                    If Not Intersects(ts) Then .Add(ts)
                    ts = ts.Add(appInterval)
                Loop Until ts >= endtime
            End With
            Return app
        End Function
        Function Intersects(ts As TimeSpan) As Boolean
            For Each gap As gap In gaps
                If gap.StartTime <= ts AndAlso gap.EndTime > ts Then Return True
            Next
            Return False
        End Function
        Function GetFirstHit(ns As TimeSpan) As TimeSpan
            For Each ts As TimeSpan In apps
                While ns > ts
                    Continue For
                End While
                Return ts
            Next
            Return apps.Min
        End Function
        Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
            Dim nowtime As TimeSpan = Now.AddHours(addh).AddMinutes(addm).TimeOfDay
            Dim NextApp As TimeSpan = GetFirstHit(nowtime)
            Dim dur As TimeSpan = NextApp.Subtract(nowtime)
            If dur < TimeSpan.Zero Then dur = dur.Add(New TimeSpan(24, 0, 0))
            If dur.Minutes = 0 Then Timer1.Interval = 1000
    
            Label1.Text = NextApp.ToString("hh\:mm")
            Label2.Text = dur.ToString("hh\h\ mm\m")
            Label3.Text = nowtime.ToString("hh\:mm")
    
            If nowtime.Seconds = 0 Then Timer1.Interval = 60 * 1000
        End Sub
    End Class



    Regards Les, Livingston, Scotland






    • Edited by leshay Tuesday, April 30, 2019 9:21 PM updated code and added image
    Tuesday, April 23, 2019 2:28 PM
  • Hi,

    Do you solve the issue?I think you can try my code:

      Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    
    
            Dim timer1 As New Timer With {.Enabled = True, .Interval = 100}
            AddHandler timer1.Tick, Sub()
                                        ComboBox1.SelectedIndex = 0
                                        Dim t = Math.Abs((DateTime.Now - Convert.ToDateTime(ComboBox1.SelectedItem.ToString)).Minutes)
                                        For i = 1 To ComboBox1.Items.Count - 1
    
                                            Dim timespan As Integer = Math.Abs((DateTime.Now - Convert.ToDateTime(ComboBox1.Items(i).ToString)).Minutes)
    
                                            If timespan < t Then
                                                ComboBox1.SelectedIndex = i
                                                t = timespan
                                            Else
    
    
                                            End If
                                            Label1.Text = t & " MINUTES"
                                        Next
                                    End Sub
    
        End Sub

    Best Regards,

    Alex


    MSDN Community Support Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, April 26, 2019 6:35 AM